packages feed

singletons 2.2 → 3.0.4

raw patch · 155 files changed

Files

CHANGES.md view
@@ -1,5 +1,628 @@-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+-----+* Restore the `TyCon1`, `TyCon2`, etc. types. It turns out that the new+`TyCon` doesn't work with kind-polymorphic tycons.++2.4+---+* Require GHC 8.4.++* `Demote Nat` is now `Natural` (from `Numeric.Natural`) instead of `Integer`.+  In accordance with this change, `Data.Singletons.TypeLits` now exposes+  `GHC.TypeNats.natVal` (which returns a `Natural`) instead of+  `GHC.TypeLits.natVal` (which returns an `Integer`).++* The naming conventions for infix identifiers (e.g., `(&*)`) have been overhauled.+  * Infix functions (that are not constructors) are no longer prepended with a+    colon when promoted to type families. For instance, the promoted version of+    `(&*)` is now called `(&*)` as well, instead of `(:&*)` as before.++    There is one exception to this rule: the `(.)` function, which is promoted+    as `(:.)`. The reason is that one cannot write `(.)` at the type level.+  * Singletons for infix functions are now always prepended with `%` instead of `%:`.+  * Singletons for infix classes are now always prepended with `%` instead of `:%`.+  * Singletons for infix datatypes are now always prepended with a `%`.++    (Before, there was an unspoken requirement that singling an infix datatype+    required that name to begin with a colon, and the singleton type would begin+    with `:%`. But now that infix datatype names can be things like `(+)`, this+    requirement became obsolete.)++  The upshot is that most infix names can now be promoted using the same name, and+  singled by simply prepending the name with `%`.++* The suffix for defunctionalized names of symbolic functions (e.g., `(+)`) has+  changed. Before, the promoted type name would be suffixed with some number of+  dollar signs (e.g., `(+$)` and `(+$$)`) to indicate defunctionalization+  symbols. Now, the promoted type name is first suffixed with `@#@` and+  _then_ followed by dollar signs (e.g., `(+@#@$)` and `(+@#@$$)`).+  Adopting this conventional eliminates naming conflicts that could arise for+  functions that consisted of solely `$` symbols.++* The treatment of `undefined` is less magical. Before, all uses of `undefined`+  would be promoted to `GHC.Exts.Any` and singled to `undefined`. Now, there is+  a proper `Undefined` type family and `sUndefined` singleton function.++* As a consequence of not promoting `undefined` to `Any`, there is no need to+  have a special `any_` function to distinguish the function on lists. The+  corresponding promoted type, singleton function, and defunctionalization+  symbols are now named `Any`, `sAny`, and `AnySym{0,1,2}`.++* Rework the treatment of empty data types:+  * Generated `SingKind` instances for empty data types now use `EmptyCase`+    instead of simply `error`ing.+  * Derived `PEq` instances for empty data types now return `True` instead of+    `False`. Derived `SEq` instances now return `True` instead of `error`ing.+  * Derived `SDecide` instances for empty data types now return `Proved bottom`,+    where `bottom` is a divergent computation, instead of `error`ing.++* Add `Data.Singletons.Prelude.IsString` and `Data.Promotion.Prelude.IsString`+  modules. `IsString.fromString` is now used when promoting or singling+  string literals when the `-XOverloadedStrings` extension is enabled+  (similarly to how `Num.fromInteger` is currently used when promoting or+  singling numeric literals).++* Add `Data.Singletons.Prelude.Void`.++* Add promoted and singled versions of `div`, `mod`, `divMod`, `quot`, `rem`,+  and `quotRem` to `Data.Singletons.TypeLits` that utilize the efficient `Div`+  and `Mod` type families from `GHC.TypeNats`. Also add `sLog2` and+  defunctionalization symbols for `Log2` from `GHC.TypeNats`.++* Add `(<>)` and `(%<>)`, the promoted and singled versions of `AppendSymbol`+  from `GHC.TypeLits`.++* Add `(%^)`, the singleton version of `GHC.TypeLits.^`.++* Add `unlines` and `unwords` to `Data.Singletons.Prelude.List`.++* Add promoted and singled versions of `Show`, including `deriving` support.++* Add a `ShowSing` class, which facilitates the ability to write `Show` instances+  for `Sing` instances.++* Permit derived `Ord` instances for empty datatypes.++* Permit standalone `deriving` declarations.++* Permit `DeriveAnyClass` (through the `anyclass` keyword of `DerivingStrategies`)++* Add a value-level `(@@)`, which is a synonym for `applySing`.++* Add `Eq`, `Ord`, `Num`, `Enum`, and `Bounded` instances for `SomeSing`, which+  leverage the `SEq`, `SOrd`, `SNum`, `SEnum`, and `SBounded` instances,+  respectively, for the underlying `Sing`.++* Rework the `Sing (a :: *)` instance in `Data.Singletons.TypeRepStar` such+  that it now uses type-indexed `Typeable`. The new `Sing` instance is now:++  ```haskell+  newtype instance Sing :: Type -> Type where+    STypeRep :: TypeRep a -> Sing a+  ```++  Accordingly, the `SingKind` instance has also been changed:++  ```haskell+  instance SingKind Type where+    type Demote Type = SomeTypeRepStar+    ...++  data SomeTypeRepStar where+    SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStar+  ```++  Aside from cleaning up some implementation details, this change assures+  that `toSing` can only be called on `TypeRep`s whose kind is of kind `*`.+  The previous implementation did not enforce this, which could lead to+  segfaults if used carelessly.++* Instead of `error`ing, the `toSing` implementation in the `SingKind (k1 ~> k2)`+  instance now works as one would expect (provided the user adheres to some+  common-sense `SingKind` laws, which are now documented).++* Add a `demote` function, which is a convenient shorthand for `fromSing sing`.++* Add a `Data.Singletons.Sigma` module with a `Sigma` (dependent pair) data type.++* Export defunctionalization symbols for `Demote`, `SameKind, `KindOf`, `(~>)`,+  `Apply`, and `(@@)` from `Data.Singletons`.++* Add an explicitly bidirectional pattern synonym `Sing`. Pattern+  matching on `Sing` brings a `SingI ty` constraint into scope from a+  singleton `Sing ty`.++* Add an explicitly bidirectional pattern synonym `FromSing`. Pattern+  matching on any demoted (base) type gives us the corresponding+  singleton.++* Add explicitly bidirectional pattern synonyms+  `SLambda{2..8}`. Pattern matching on any defunctionalized singleton+  yields a term-level Haskell function on singletons.++* Remove the family of `TyCon1`, `TyCon2`, ..., in favor of just `TyCon`.+  GHC 8.4's type system is powerful enough to allow this nice simplification.++2.3+---+* Documentation clarifiation in `Data.Singletons.TypeLits`, thanks to @ivan-m.++* `Demote` was no longer a convenient way of calling `DemoteRep` and has been+removed. `DemoteRep` has been renamed `Demote`.++* `DemoteRep` is now injective.++* Demoting a `Symbol` now gives `Text`. This is motivated by making `DemoteRep`+  injective. (If `Symbol` demoted to `String`, then there would be a conflict+  between demoting `[Char]` and `Symbol`.)++* Generating singletons also now generates fixity declarations for the singletonized+  definitions, thanks to @int-index.++* Though more an implementation detail: singletons no longer uses kind-level proxies anywhere,+  thanks again to @int-index.++* Support for promoting higher-kinded type variables, thanks for @int-index.++* `Data.Singletons.TypeLits` now exports defunctionalization symbols for `KnownNat`+and `KnownSymbol`.++* Better type inference support around constraints, as tracked in Issue #176.++* Type synonym definitions are now ignored, as they should be.++* `Show` instances for `SNat` and `SSymbol`, thanks to @cumber.++* The `singFun` and `unSingFun` functions no longer use proxies, preferring+  `TypeApplications`.  2.2 ---
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,575 +1,24 @@-singletons 2.2-==============--[![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, eir@cis.upenn.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](http://www.cis.upenn.edu/~eir/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](http://www.cis.upenn.edu/~eir/papers/2014/promotion/promotion.pdf)-and will be referenced in this documentation as the-"promotion paper".--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.0.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:--* `ScopedTypeVariables`-* `TemplateHaskell`-* `TypeFamilies`-* `GADTs`-* `KindSignatures`-* `TypeOperators`-* `FlexibleContexts`-* `RankNTypes`-* `UndecidableInstances`-* `FlexibleInstances`-* `InstanceSigs`-* `DefaultSignatures`-* `TypeInType`--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` and `GHC.Base`. We also-provide singletonized `Eq` and `Ord` typeclasses--`Data.Singletons.Decide` exports type classes for propositional equality.--`Data.Singletons.TypeLits` exports definitions for working with `GHC.TypeLits`.--`Data.Singletons.Void` exports a `Void` type, shamelessly copied from-Edward Kmett's `void` package, but without the great many package dependencies-in `void`.--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:--    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.--    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.--    class SingI (a :: k) where-      sing :: Sing a--A class used to pass singleton values implicitly. The `sing` method produces-an explicit singleton value.--    data SomeSing (kproxy :: KProxy k) where-      SomeSing :: Sing (a :: k) -> SomeSing ('KProxy :: KProxy 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 ('KProxy :: KProxy Thing)` is isomorphic to `Thing`.--    class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where-      type DemoteRep kparam :: *-      fromSing :: Sing (a :: k) -> DemoteRep kparam-      toSing   :: DemoteRep kparam -> SomeSing kparam--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 `DemoteRep` associated-kind-indexed type family maps a proxy of the kind `Nat`-back to the type `Nat`.--    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`.---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 (kproxy ~ 'KProxy, PEq kproxy) => POrd (kproxy :: KProxy 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 (kproxy ~ 'KProxy, SEq kproxy) => SOrd (kproxy :: KProxy 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 ('KProxy :: KProxy Bool) where-  type Compare 'False 'False = 'EQ-  type Compare 'False 'True  = 'LT-  type Compare 'True  'False = 'GT-  type Compare 'True  'True  = 'EQ--instance SOrd ('KProxy :: KProxy 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:--1. original datatype: `[]`--   singleton type: `SList`---2.  original constructor: `[]`--    promoted type: `'[]`--    singleton constructor: `SNil`--    symbols: `NilSym0`---3. original constructor: `:`--   promoted type: `':`--   singleton constructr: `SCons`--   symbols: `ConsSym0`, `ConsSym1`---4. original datatype: `(,)`--   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: `undefined`--   promoted type: `Any`--   singleton value: `undefined`---Supported Haskell constructs-------------------------------The following constructs are fully supported:--* variables-* tuples-* constructors-* if statements-* infix expressions-* `_` patterns-* aliased patterns-* lists-* sections-* undefined-* error-* deriving `Eq`, `Ord`, `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-* functional dependencies (with limitations -- see below)--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, that is always true and this-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? First two depend on monads, which mention a-higher-kinded type variable. GHC does not support higher-sorted kind variables,-which would be necessary to promote/singletonize monads. There are other tricks-possible, too, but none are likely to work. See the bug report-[here](https://github.com/goldfirere/singletons/issues/37) for more info.-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--    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:+`singletons`+============ -    data instance Sing (a :: *) where-      STypeRep :: Typeable a => Sing a+[![Hackage](https://img.shields.io/hackage/v/singletons.svg)](http://hackage.haskell.org/package/singletons) -Thus, an implicit `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-* In obscure scenarios, GHC "forgets" constraints on functions. This should-  happen only with certain uses where the constraint is needed inside of a-  `case` or lambda-expression. Having type inference on result types nearby-  makes this more likely to bite.-* 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,124 +1,82 @@ name:           singletons-version:        2.2-                -- 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 <eir@cis.upenn.edu>, Jan Stolarek <jan.stolarek@p.lodz.pl>-maintainer:     Richard Eisenberg <eir@cis.upenn.edu>, Jan Stolarek <jan.stolarek@p.lodz.pl>+author:         Richard Eisenberg <rae@cs.brynmawr.edu>, Jan Stolarek <jan.stolarek@p.lodz.pl>+maintainer:     Ryan Scott <ryan.gl.scott@gmail.com> bug-reports:    https://github.com/goldfirere/singletons/issues stability:      experimental-tested-with:    GHC == 8.0.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/*.ghc80.template,-                    tests/compile-and-dump/InsertionSort/*.ghc80.template,-                    tests/compile-and-dump/Promote/*.ghc80.template,-                    tests/compile-and-dump/Singletons/*.ghc80.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.-    (<http://www.cis.upenn.edu/~eir/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:-    <http://www.cis.upenn.edu/~eir/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.2+  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.9 && < 5,-                      mtl >= 2.1.2,-                      template-haskell,-                      containers >= 0.5,-                      th-desugar >= 1.6 && < 1.7,-                      syb >= 0.4+  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.Ord,-                      Data.Singletons.Prelude.List,-                      Data.Singletons.Prelude.Maybe,-                      Data.Singletons.Prelude.Num-                      Data.Singletons.Prelude.Tuple,-                      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.Ord,-                      Data.Promotion.Prelude.Enum,-                      Data.Promotion.Prelude.List,-                      Data.Promotion.Prelude.Maybe,-                      Data.Promotion.Prelude.Num,-                      Data.Promotion.Prelude.Tuple,-                      Data.Singletons.TypeLits,-                      Data.Singletons.Decide,-                      Data.Singletons.SuppressUnusedWarnings--  other-modules:      Data.Singletons.Deriving.Infer,-                      Data.Singletons.Deriving.Bounded,-                      Data.Singletons.Deriving.Enum,-                      Data.Singletons.Deriving.Ord,-                      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,-                      Data.Singletons.TypeLits.Internal,-                      Data.Singletons.Syntax--  ghc-options:        -Wall -Wno-redundant-constraints+  exposed-modules:    Data.Singletons+                      Data.Singletons.Decide+                      Data.Singletons.ShowSing+                      Data.Singletons.Sigma+  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.9 && < 5,-                      filepath >= 1.3,-                      process >= 1.1,-                      tasty >= 0.6,-                      tasty-golden >= 2.2,-                      Cabal >= 1.16,-                      directory >= 1+  build-depends:      base >= 4.9 && < 4.22,+                      singletons
− src/Data/Promotion/Prelude.hs 
@@ -1,168 +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, (:&&), (:||), Otherwise,--  maybe_, Maybe_, either_, Either_,--  Symbol,--  Fst, Snd, Curry, Uncurry,--  -- * Error reporting-  Error, ErrorSym0,--  -- * 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,--  -- ** Miscellaneous functions-  Id, Const, (:.), type ($), type ($!), Flip, AsTypeOf, Until, Seq,--  -- * List operations-  Map, (:++), Filter,-  Head, Last, Tail, Init, Null, Length, (:!!),-  Reverse,-  -- ** Reducing lists (folds)-  Foldl, Foldl1, Foldr, Foldr1,-  -- *** Special folds-  And, Or, any_, 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,--  -- * Other datatypes-  Proxy(..),--  -- * Defunctionalization symbols-  FalseSym0, TrueSym0,-  NotSym0, NotSym1, (:&&$), (:&&$$), (:&&$$$), (:||$), (:||$$), (:||$$$),-  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,--  (:^$), (:^$$),--  IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2,-  (:.$), (:.$$), (:.$$$),-  type ($$), type ($$$), type ($$$$),-  type ($!$), type ($!$$), type ($!$$$),-  FlipSym0, FlipSym1, FlipSym2,-  AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2,--  (:$), (:$$), (:$$$), NilSym0,-  MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1,-  (:++$$), (:++$), 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,-  Any_Sym0, Any_Sym1, Any_Sym2,-  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,--  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,-  (:!!$), (:!!$$), (:!!$$$),-  ) where--import Data.Proxy ( Proxy(..) )-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.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, (:++), Otherwise, Id, Const, (:.), type ($), type ($!),-  Flip, Until, AsTypeOf, Seq,--  -- * Defunctionalization symbols-  FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,-  MapSym0, MapSym1, MapSym2,-  (:++$), (:++$$), (:++$$$),-  OtherwiseSym0,-  IdSym0, IdSym1,-  ConstSym0, ConstSym1, ConstSym2,-  (:.$), (:.$$), (:.$$$), (:.$$$$),-  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,42 +0,0 @@--------------------------------------------------------------------------------- |--- 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, (:&&), (:||), Otherwise,--  -- * Defunctionalization symbols-  TrueSym0, FalseSym0,--  NotSym0, NotSym1,-  (:&&$), (:&&$$), (:&&$$$),-  (:||$), (:||$$), (:||$$$),-  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,36 +0,0 @@-{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies,-             UndecidableInstances, GADTs #-}---- Suppress orphan instance warning for PEnum KProxy. This will go away once #25--- is fixed and instance declaration for Enum Nat is moved to--- Data.Singletons.Prelude.Enum module.-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- 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,19 +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(..), (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$)-  ) where--import Data.Singletons.Prelude.Eq
− src/Data/Promotion/Prelude/List.hs 
@@ -1,303 +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-  (:++), 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,-  any_, -- equivalent of Data.List `any`. Avoids name clash with Any type--  -- * 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-  (:!!), 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--  -- ** \"Set\" operations-  Nub, Delete, (:\\), 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,-  (:$), (:$$), (:$$$),--  (:++$$$), (:++$$), (:++$), 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,-  Any_Sym0, Any_Sym1, Any_Sym2,-  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,-  (:\\$), (:\\$$), (:\\$$$),-  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,--  (:!!$), (:!!$$), (:!!$$$),--  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,--  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/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,30 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Num--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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-  (:+$), (:+$$), (:+$$$),-  (:-$), (:-$$), (:-$$$),-  (:*$), (:*$$), (:*$$$),-  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,26 +0,0 @@--------------------------------------------------------------------------------- |--- 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(..),-  LTSym0, EQSym0, GTSym0,-  CompareSym0, CompareSym1, CompareSym2,-  (:<$), (:<$$), (:<$$$),-  (:<=$), (:<=$$), (:<=$$$),-  (:>$), (:>$$), (:>$$$),-  (:>=$), (:>=$$), (:>=$$$),-  MaxSym0, MaxSym1, MaxSym2,-  MinSym0, MinSym1, MinSym2-  ) where--import Data.Singletons.Prelude.Ord
− 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/TH.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.TH--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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,--  -- ** 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, (:&&),-  POrd(..),-  Any,-  Proxy(..), ThenCmp, Foldl,--  Error, ErrorSym0,-  TrueSym0, FalseSym0,-  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,-  ThenCmpSym0, FoldlSym0,--  SuppressUnusedWarnings(..)-- ) where--import Data.Singletons-import Data.Singletons.Promote-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.TypeLits-import Data.Singletons.SuppressUnusedWarnings-import GHC.Exts
src/Data/Singletons.hs view
@@ -1,315 +1,1363 @@-{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds,-             FlexibleContexts, FlexibleInstances,-             TypeFamilies, TypeOperators,-             UndecidableInstances, TypeInType #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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--- <http://www.cis.upenn.edu/~eir/packages/singletons/README.html> and the--- original paper presenting this library, available at--- <http://www.cis.upenn.edu/~eir/papers/2012/singletons/paper.pdf>.----------------------------------------------------------------------------------module Data.Singletons (-  -- * Main singleton definitions--  Sing(SLambda, applySing),-  -- | See also 'Data.Singletons.Prelude.Sing' for exported constructors--  SingI(..), SingKind(..),--  -- * Working with singletons-  KindOf, Demote,-  SingInstance(..), SomeSing(..),-  singInstance, withSingI, withSomeSing, singByProxy,--  singByProxy#,-  withSing, singThat,--  -- ** Defunctionalization-  TyFun, type (~>),-  TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8,-  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,--  -- | 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(..)-  ) where--import Data.Kind-import Unsafe.Coerce-import Data.Proxy ( Proxy(..) )-import GHC.Exts ( Proxy# )---- | Convenient synonym to refer to the kind of a type variable:--- @type KindOf (a :: k) = ('Proxy :: Proxy k)@-type KindOf (a :: k) = ('Proxy :: Proxy k)----------------------------------------------------------------------------- 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'.-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---- | 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.-class SingKind k where-  -- | Get a base type from a proxy for the promoted kind. For example,-  -- @DemoteRep Bool@ will be the type @Bool@.-  type DemoteRep k :: *--  -- | Convert a singleton to its unrefined version.-  fromSing :: Sing (a :: k) -> DemoteRep k--  -- | Convert an unrefined type to an existentially-quantified singleton type.-  toSing   :: DemoteRep k -> SomeSing k---- | Convenient abbreviation for 'DemoteRep':--- @type Demote (a :: k) = DemoteRep k@-type Demote (a :: k) = DemoteRep 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----------------------------------------------------------------------------- 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 ~>---- | 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 level function application-type family Apply (f :: k1 ~> k2) (x :: k1) :: k2-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)---- | An infix synonym for `Apply`-type a @@ b = Apply a b-infixl 9 @@----------------------------------------------------------------------------- Defunctionalized Sing instance and utilities ---------------------------------------------------------------------------------------------newtype instance Sing (f :: k1 ~> k2) =-  SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) }--instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where-  type DemoteRep (k1 ~> k2) = DemoteRep k1 -> DemoteRep k2-  fromSing sFun x = withSomeSing x (fromSing . applySing sFun)-  toSing _ = error "Cannot create existentially-quantified singleton functions."--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 often need an explicit type--- annotation to get this to work. For example:------ > falses = sMap (singFun1 (Proxy :: Proxy NotSym0) sNot)--- >               (STrue `SCons` STrue `SCons` SNil)------ There are a family of @singFun...@ functions, keyed by the number--- of parameters of the function.-singFun1 :: Proxy f -> SingFunction1 f -> Sing f-singFun1 _ f = SLambda f--type SingFunction2 f = forall t. Sing t -> SingFunction1 (f @@ t)-singFun2 :: Proxy f -> SingFunction2 f -> Sing f-singFun2 _ f = SLambda (\x -> singFun1 Proxy (f x))--type SingFunction3 f = forall t. Sing t -> SingFunction2 (f @@ t)-singFun3 :: Proxy f -> SingFunction3 f -> Sing f-singFun3 _ f = SLambda (\x -> singFun2 Proxy (f x))--type SingFunction4 f = forall t. Sing t -> SingFunction3 (f @@ t)-singFun4 :: Proxy f -> SingFunction4 f -> Sing f-singFun4 _ f = SLambda (\x -> singFun3 Proxy (f x))--type SingFunction5 f = forall t. Sing t -> SingFunction4 (f @@ t)-singFun5 :: Proxy f -> SingFunction5 f -> Sing f-singFun5 _ f = SLambda (\x -> singFun4 Proxy (f x))--type SingFunction6 f = forall t. Sing t -> SingFunction5 (f @@ t)-singFun6 :: Proxy f -> SingFunction6 f -> Sing f-singFun6 _ f = SLambda (\x -> singFun5 Proxy (f x))--type SingFunction7 f = forall t. Sing t -> SingFunction6 (f @@ t)-singFun7 :: Proxy f -> SingFunction7 f -> Sing f-singFun7 _ f = SLambda (\x -> singFun6 Proxy (f x))--type SingFunction8 f = forall t. Sing t -> SingFunction7 (f @@ t)-singFun8 :: Proxy f -> SingFunction8 f -> Sing f-singFun8 _ f = SLambda (\x -> singFun7 Proxy (f x))---- | This is the inverse of 'singFun1', and likewise for the other--- @unSingFun...@ functions.-unSingFun1 :: Proxy f -> Sing f -> SingFunction1 f-unSingFun1 _ sf = applySing sf--unSingFun2 :: Proxy f -> Sing f -> SingFunction2 f-unSingFun2 _ sf x = unSingFun1 Proxy (sf `applySing` x)--unSingFun3 :: Proxy f -> Sing f -> SingFunction3 f-unSingFun3 _ sf x = unSingFun2 Proxy (sf `applySing` x)--unSingFun4 :: Proxy f -> Sing f -> SingFunction4 f-unSingFun4 _ sf x = unSingFun3 Proxy (sf `applySing` x)--unSingFun5 :: Proxy f -> Sing f -> SingFunction5 f-unSingFun5 _ sf x = unSingFun4 Proxy (sf `applySing` x)--unSingFun6 :: Proxy f -> Sing f -> SingFunction6 f-unSingFun6 _ sf x = unSingFun5 Proxy (sf `applySing` x)--unSingFun7 :: Proxy f -> Sing f -> SingFunction7 f-unSingFun7 _ sf x = unSingFun6 Proxy (sf `applySing` x)--unSingFun8 :: Proxy f -> Sing f -> SingFunction8 f-unSingFun8 _ sf x = unSingFun7 Proxy (sf `applySing` x)----------------------------------------------------------------------------- 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 :: SingKind k-             => DemoteRep 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 a -> 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+{-# 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'+'SLambda2' :: 'SingFunction2' f -> 'Sing' f+>>> :t 'SLambda2' \@TakeSym0+'SLambda2' :: 'SingFunction2' TakeSym0 -> 'Sing' TakeSym0+>>> :t 'SLambda2' \@TakeSym0 sTake+'SLambda2' :: 'Sing' TakeSym0+@++This is useful for functions on singletons that expect a defunctionalized+singleton as an argument, such as @sZipWith :: 'SingFunction3' ZipWithSym0@:++@+sZipWith :: Sing (f :: a '~>' b '~>' c) -> Sing (xs :: [a]) -> Sing (ys :: [b]) -> Sing (ZipWith f xs ys :: [c])+sZipWith ('SLambda2' \@TakeSym0 sTake) :: Sing (xs :: [Nat]) -> Sing (ys :: [[a]]) -> Sing (ZipWith TakeSym0 xs ys :: [[a]])+@++As __patterns__: Same as @unSingFun{2..8}@. Gets a binary term-level+Haskell function on singletons+@'Sing' (x :: k) -> 'Sing' (y :: k') -> 'Sing' (f \@\@ x \@\@ y)@+from a defunctionalised @'Sing' f@. Alternatively, as a record field accessor:++@+applySing2 :: 'Sing' (f :: k '~>' k' '~>' k'') -> 'SingFunction2' f+@+-}
− src/Data/Singletons/CustomStar.hs 
@@ -1,133 +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 (eir@cis.upenn.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-  ) where--import Language.Haskell.TH-import Data.Singletons.Util-import Data.Singletons.Deriving.Ord-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 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, Show, Read)------ 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 :: SingRep a => 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-                       [DConPr ''Eq, DConPr ''Show, DConPr ''Read]-  fakeCtors <- zipWithM (mkCtor False) names kinds-  let dataDecl = DataDecl Data repName [] fakeCtors-                          [DConPr ''Show, DConPr ''Read , DConPr ''Eq]-  ordInst <- mkOrdInstance (DConT repName) fakeCtors-  (pOrdInst, promDecls) <- promoteM [] $ do promoteDataDec dataDecl-                                            promoteInstanceDec mempty ordInst-  singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl-                                      dec2  <- singInstD pOrdInst-                                      return (dec2 : decs1)-  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 (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 #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# 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 (eir@cis.upenn.edu)+-- Maintainer  :  Ryan Scott -- Stability   :  experimental -- Portability :  non-portable --@@ -20,11 +29,13 @@   SDecide(..),    -- * Supporting definitions-  (:~:)(..), Void, Refuted, Decision(..)+  (:~:)(..), Void, Refuted, Decision(..),+  decideEquality, decideCoercion   ) where  import Data.Kind import Data.Singletons+import Data.Type.Coercion import Data.Type.Equality import Data.Void @@ -35,22 +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 => 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 (eir@cis.upenn.edu--- Stability   :  experimental--- Portability :  non-portable------ Implements deriving of Bounded instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Bounded where--import Language.Haskell.TH.Syntax-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 :: Quasi q => DType -> [DCon] -> q UInstDecl-mkBoundedInstance 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]-  return $ InstDecl { id_cxt = inferConstraints (DConPr boundedName) cons-                    , 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 (eir@cis.upenn.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 => DType -> [DCon] -> q UInstDecl-mkEnumInstance 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     = []-                   , 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,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Infer--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu--- Stability   :  experimental--- Portability :  non-portable------ Infers constraints for a `deriving` class----------------------------------------------------------------------------------module Data.Singletons.Deriving.Infer ( inferConstraints ) where--import Language.Haskell.TH.Desugar-import Data.Singletons.Util-import Data.List-import Data.Generics.Twins--inferConstraints :: DPred -> [DCon] -> DCxt-inferConstraints pr = nubBy geq . concatMap infer_ct-  where-    infer_ct (DCon _ _ _ fields _) = map (pr `DAppPr`) (tysOfConFields fields)
− src/Data/Singletons/Deriving/Ord.hs 
@@ -1,65 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Ord--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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 :: Quasi q => DType -> [DCon] -> q UInstDecl-mkOrdInstance ty cons = do-  let constraints = inferConstraints (DConPr ordName) 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) ]-  return (InstDecl { id_cxt = constraints-                   , id_name = ordName-                   , id_arg_tys = [ty]-                   , id_meths = [( compareName-                                 , UFunction (compare_eq_clauses ++-                                              compare_noneq_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))
− src/Data/Singletons/Names.hs 
@@ -1,257 +0,0 @@-{- Data/Singletons/Names.hs--(c) Richard Eisenberg 2014-eir@cis.upenn.edu--Defining names and manipulations on names for use in promotion and singling.--}--{-# LANGUAGE TemplateHaskell #-}--module Data.Singletons.Names where--import Data.Singletons-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 ( Any )-import Data.Typeable ( TypeRep )-import Data.Singletons.Util-import Data.Proxy ( Proxy(..) )-import Control.Monad--anyTypeName, boolName, andName, tyEqName, compareName, minBoundName,-  maxBoundName, repName,-  nilName, consName, listName, tyFunName,-  applyName, natName, symbolName, undefinedName, typeRepName, stringName,-  eqName, ordName, boundedName, orderingName,-  singFamilyName, singIName, singMethName, demoteRepName,-  singKindClassName, sEqClassName, sEqMethName, sconsName, snilName,-  sIfName, proxyTypeName, proxyDataName,-  someSingTypeName, someSingDataName,-  sListName, sDecideClassName, sDecideMethName,-  provedName, disprovedName, reflName, toSingName, fromSingName,-  equalityName, applySingName, suppressClassName, suppressMethodName,-  thenCmpName,-  kindOfName, tyFromIntegerName, tyNegateName, sFromIntegerName,-  sNegateName, errorName, foldlName, cmpEQName, cmpLTName, cmpGTName,-  singletonsToEnumName, singletonsFromEnumName, enumName, singletonsEnumName,-  equalsName :: Name-anyTypeName = ''Any-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-undefinedName = 'undefined-typeRepName = ''TypeRep-stringName = ''String-eqName = ''Eq-ordName = ''Ord-boundedName = ''Bounded-orderingName = ''Ordering-singFamilyName = ''Sing-singIName = ''SingI-singMethName = 'sing-toSingName = 'toSing-fromSingName = 'fromSing-demoteRepName = ''DemoteRep-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"-someSingTypeName = ''SomeSing-someSingDataName = 'SomeSing-proxyTypeName = ''Proxy-proxyDataName = 'Proxy-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"-kindOfName = ''KindOf-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 = '(==)--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 = upcase---- like promoteValNameLhs, but adds a prefix to the promoted name-promoteValNameLhsPrefix :: (String, String) -> Name -> Name-promoteValNameLhsPrefix pres n = 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-    | name == undefinedName-    = anyTypeName--    | 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-    = let capped = toUpcaseStr noPrefix name in-      if isHsLetter (head capped)-      then mkName (capped ++ "Sym" ++ (show sat))-      else mkName (capped ++ (replicate (sat + 1) '$'))--promoteClassName :: Name -> Name-promoteClassName = prefixUCName "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                                      = prefixUCName "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                                        = prefixUCName "S" ":%" name--singClassName :: Name -> Name-singClassName = singTyConName--singValName :: Name -> Name-singValName n-  | n == undefinedName       = undefinedName-     -- avoid unused variable warnings-  | head (nameBase n) == '_' = (prefixLCName "_s" "%") $ n-  | otherwise                = (prefixLCName "s" "%") $ upcase n--kindParam :: DKind -> DType-kindParam k = DSigT (DConT proxyDataName) (DConT proxyTypeName `DAppT` k)--proxyFor :: DType -> DExp-proxyFor ty = DSigE (DConE proxyDataName) (DAppT (DConT proxyTypeName) ty)--singFamily :: DType-singFamily = DConT singFamilyName--singKindConstraint :: DKind -> DPred-singKindConstraint = DAppPr (DConPr singKindClassName)--demote :: DType-demote = DConT demoteRepName--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]---- create a bunch of kproxy vars, and constrain them all to be 'KProxy-mkKProxies :: Quasi q-           => [Name]   -- for the kinds of the kproxies-           -> q ([DTyVarBndr], DCxt)-mkKProxies ns = do-  kproxies <- mapM (const $ qNewName "kproxy") ns-  return ( zipWith (\kp kv -> DKindedTV kp (DConT proxyTypeName `DAppT` DVarT kv))-                   kproxies ns-         , map (\kp -> mkEqPred (DVarT kp) (DConT proxyDataName)) kproxies )
− src/Data/Singletons/Partition.hs 
@@ -1,111 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Partition--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu--- Stability   :  experimental--- Portability :  non-portable------ Partitions a list of declarations into its bits----------------------------------------------------------------------------------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.Names-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Ppr-import Language.Haskell.TH.Desugar-import Data.Singletons.Util--import Data.Monoid-import Control.Monad-import Data.Maybe--data PartitionedDecs =-  PDecs { pd_let_decs :: [DLetDec]-        , pd_class_decs :: [UClassDecl]-        , pd_instance_decs :: [UInstDecl]-        , pd_data_decs :: [DataDecl]-        }--instance Monoid PartitionedDecs where-  mempty = PDecs [] [] [] []-  mappend (PDecs a1 b1 c1 d1) (PDecs a2 b2 c2 d2) =-    PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2)---- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances--- from deriving clauses-partitionDecs :: Quasi m => [DDec] -> m PartitionedDecs-partitionDecs = concatMapM partitionDec--partitionDec :: Quasi m => DDec -> m PartitionedDecs-partitionDec (DLetDec letdec) = return $ mempty { pd_let_decs = [letdec] }--partitionDec (DDataD nd _cxt name tvbs cons derivings) = do-  (derivings', derived_instances) <- partitionWithM part_derivings derivings-  return $ mempty { pd_data_decs = [DataDecl nd name tvbs cons derivings']-                  , pd_instance_decs = derived_instances }-  where-    ty = foldType (DConT name) (map tvbToType tvbs)-    part_derivings :: Quasi m => DPred -> m (Either DPred UInstDecl)-    part_derivings deriv = case deriv of-      DConPr deriv_name-         | deriv_name == ordName-        -> Right <$> mkOrdInstance ty cons-         | deriv_name == boundedName-        -> Right <$> mkBoundedInstance ty cons-         | deriv_name == enumName-        -> Right <$> mkEnumInstance ty cons-      _ -> return (Left deriv)--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 (DPragmaD {}) = 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 (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 (DPragmaD {}) = return Nothing-partitionInstanceDec _ =-  fail "Only method bodies can be promoted within an instance."
− src/Data/Singletons/Prelude.hs 
@@ -1,163 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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, (:&&), (:||), (%:&&), (%:||), Otherwise, sOtherwise,--  -- * Error reporting-  Error, ErrorSym0, sError,--  -- * 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,--  -- ** Miscellaneous functions-  Id, sId, Const, sConst, (:.), (%:.), type ($), (%$), type ($!), (%$!),-  Flip, sFlip, AsTypeOf, sAsTypeOf,-  Seq, sSeq,--  -- * List operations-  Map, sMap, (:++), (%:++), 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,-  -- ** Searching lists-  Elem, sElem, NotElem, sNotElem, Lookup, sLookup,-  -- ** Zipping and unzipping lists-  Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3,-  Unzip, sUnzip, Unzip3, sUnzip3,--  -- * 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_,-  any_,--  -- * Defunctionalization symbols-  FalseSym0, TrueSym0,-  NotSym0, NotSym1, (:&&$), (:&&$$), (:&&$$$), (:||$), (:||$$), (:||$$$),-  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,--  IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2,-  (:.$), (:.$$), (:.$$$),-  type ($$), type ($$$), type ($$$$),-  type ($!$), type ($!$$), type ($!$$$),-  FlipSym0, FlipSym1, FlipSym2,-  AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2,--  (:$), (:$$), (:$$$), NilSym0,-  MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1,-  (:++$$), (:++$), 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,-  Any_Sym0, Any_Sym1, Any_Sym2,-  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-  ) 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.TypeLits
− src/Data/Singletons/Prelude/Base.hs 
@@ -1,128 +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, (:++), (%:++), Otherwise, sOtherwise,-  Id, sId, Const, sConst, (:.), (%:.), type ($), type ($!), (%$), (%$!),-  Flip, sFlip, AsTypeOf, sAsTypeOf,-  Seq, sSeq,--  -- * Defunctionalization symbols-  FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,-  MapSym0, MapSym1, MapSym2,-  (:++$), (:++$$), (:++$$$),-  OtherwiseSym0,-  IdSym0, IdSym1,-  ConstSym0, ConstSym1, ConstSym2,-  (:.$), (:.$$), (:.$$$), (:.$$$$),-  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-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--  -- 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`- |])---- ($) is a special case, because its kind-inference data constructors--- clash with (:). See #29.-type family (f :: TyFun a b -> *) $ (x :: a) :: b-type instance f $ x = f @@ x-infixr 0 $--data ($$) :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> *-type instance Apply ($$) arg = ($$$) arg--data ($$$) :: (TyFun a b -> *) -> TyFun a b -> *-type instance Apply (($$$) f) arg = ($$$$) f arg--type ($$$$) a b = ($) a b--(%$) :: forall (f :: TyFun a b -> *) (x :: a).-        Sing f -> Sing x -> Sing (($$) @@ f @@ x)-f %$ x = applySing f x-infixr 0 %$--type family (f :: TyFun a b -> *) $! (x :: a) :: b-type instance f $! x = f @@ x-infixr 0 $!--data ($!$) :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> *-type instance Apply ($!$) arg = ($!$$) arg--data ($!$$) :: (TyFun a b -> *) -> TyFun a b -> *-type instance Apply (($!$$) f) arg = ($!$$$) f arg--type ($!$$$) a b = ($!) a b--(%$!) :: forall (f :: TyFun a b -> *) (x :: a).-        Sing f -> Sing x -> Sing (($!$) @@ f @@ x)-f %$! x = applySing f x-infixr 0 %$!
− src/Data/Singletons/Prelude/Bool.hs 
@@ -1,90 +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 (eir@cis.upenn.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, (:&&), (:||), (%:&&), (%:||),--  -- | 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,-  (:&&$), (:&&$$), (:&&$$$),-  (:||$), (:||$$), (:||$$$),-  Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3,-  OtherwiseSym0-  ) where--import Data.Singletons-import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Type.Bool ( If )--$(singletons [d|-  bool_ :: a -> a -> Bool -> a-  bool_ fls _tru False = fls-  bool_ _fls tru True  = tru- |])--$(singletonsOnly [d|-  (&&) :: Bool -> Bool -> Bool-  False && _ = False-  True  && x = x-  infixr 3 &&--  (||) :: Bool -> Bool -> Bool-  False || x = x-  True  || _ = True-  infixr 2 ||--  not :: Bool -> Bool-  not False = True-  not True = False--  otherwise               :: Bool-  otherwise               =  True-  |])---- | 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 (eir@cis.upenn.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 (eir@cis.upenn.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines the SEq singleton version of the Eq type class.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Eq (-  PEq(..), SEq(..),-  (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$)-  ) where--import Data.Singletons.Prelude.Bool-import Data.Singletons-import Data.Singletons.Single-import Data.Singletons.Prelude.Instances-import Data.Singletons.Util-import Data.Singletons.Promote-import Data.Type.Equality---- 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 '(==)', from @Data.Type.Equality@.-class kproxy ~ 'Proxy => PEq (kproxy :: Proxy a) where-  type (:==) (x :: a) (y :: a) :: Bool-  type (:/=) (x :: a) (y :: a) :: Bool--  type (x :: a) :== (y :: a) = x == 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/Instances.hs 
@@ -1,34 +0,0 @@-{- Data/Singletons/Instances.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.edu--This (internal) module contains the main class definitions for singletons,-re-exported from various places.---}--{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies,-             FlexibleContexts, TemplateHaskell, ScopedTypeVariables,-             UndecidableInstances, TypeOperators, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-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/List.hs 
@@ -1,800 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TypeInType,-             TemplateHaskell, GADTs, UndecidableInstances, RankNTypes,-             ScopedTypeVariables, FlexibleContexts #-}-{-# OPTIONS_GHC -O0 #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.List--- Copyright   :  (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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-  (:++), (%:++), 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,-  any_, -- equivalent of Data.List `any`. Avoids name clash with Any type--  -- * 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-  (:!!), (%:!!),-  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--  -- ** \"Set\" operations-  Nub, sNub, Delete, sDelete, (:\\), (%:\\),-  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,-  (:$), (:$$), (:$$$),--  (:++$$$), (:++$$), (:++$), 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,-  Any_Sym0, Any_Sym1, Any_Sym2,-  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,--  (:!!$), (:!!$$), (:!!$$$),-  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,--  NubSym0, NubSym1,-  DeleteSym0, DeleteSym1, DeleteSym2,-  (:\\$), (:\\$$), (:\\$$$),-  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-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--$(singletons [d|-  any_                     :: (a -> Bool) -> [a] -> Bool-  any_ _ []                = False-  any_ p (x:xs)            = p x || any_ p xs- |])--$(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            :: [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-              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--  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--  notElem                 :: (Eq a) => a -> [a] -> Bool-  notElem _ []            =  True-  notElem x (y:ys)        =  x /= y && notElem x ys--  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------  unlines                 :: [String] -> String---  unlines                 =  concatMap (++ "\n")------  words                   :: String -> [String]---  words s                 =  case dropWhile isSpace s of---                                  "" -> []---                                  s' -> w : words s''---                                        where (w, s'') =---                                               break isSpace s'------  unwords                 :: [String] -> String---  unwords []              =  ""---  unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws--  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)--  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/Maybe.hs 
@@ -1,130 +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 (eir@cis.upenn.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-import Data.Singletons.TH-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,129 +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 (eir@cis.upenn.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines and exports promoted and singleton versions of definitions from--- GHC.Num.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Num (-  PNum(..), SNum(..), Subtract, sSubtract,--  -- ** Defunctionalization symbols-  (:+$), (:+$$), (:+$$$),-  (:-$), (:-$$), (:-$$$),-  (:*$), (:*$$), (:*$$$),-  NegateSym0, NegateSym1,-  AbsSym0, AbsSym1,-  SignumSym0, SignumSym1,-  FromIntegerSym0, FromIntegerSym1,-  SubtractSym0, SubtractSym1, SubtractSym2-  ) where--import Data.Singletons.Single-import Data.Singletons-import Data.Singletons.TypeLits.Internal-import Data.Singletons.Decide-import GHC.TypeLits-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 ('Proxy :: Proxy Nat) where-  type a :+ b = a + b-  type a :- b = a - b-  type a :* b = a * 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-      Just (SomeNat (_ :: Proxy ab)) -> unsafeCoerce (SNat :: Sing ab)-      Nothing                        -> error "Two naturals added to a negative?"--  sa %:- sb =-    let a = fromSing sa-        b = fromSing sb-        ex = someNatVal (a - b)-    in-    case ex of-      Just (SomeNat (_ :: Proxy ab)) -> unsafeCoerce (SNat :: Sing ab)-      Nothing                        ->-        error "Negative natural-number singletons are naturally not allowed."--  sa %:* sb =-    let a = fromSing sa-        b = fromSing sb-        ex = someNatVal (a * b)-    in-    case ex of-      Just (SomeNat (_ :: Proxy ab)) -> unsafeCoerce (SNat :: Sing ab)-      Nothing                        ->-        error "Two naturals multiplied to a negative?"--  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,82 +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 (eir@cis.upenn.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(..),--  -- | '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,-  (:<$), (:<$$), (:<$$$),-  (:<=$), (:<=$$), (:<=$$$),-  (:>$), (:>$$), (:>$$$),-  (:>=$), (:>=$$), (:>=$$$),-  MaxSym0, MaxSym1, MaxSym2,-  MinSym0, MinSym1, MinSym2-  ) 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 | (<=) #-}--  |])--$(singletons [d|-  thenCmp :: Ordering -> Ordering -> Ordering-  thenCmp EQ x = x-  thenCmp LT _ = LT-  thenCmp GT _ = GT-  |])--$(singOrdInstances basicTypes)
− 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 (eir@cis.upenn.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.TH--$(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/Promote.hs 
@@ -1,618 +0,0 @@-{- Data/Singletons/Promote.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.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.Partition-import Data.Singletons.Util-import Data.Singletons.Syntax-import Prelude hiding (exp)-import Control.Monad-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-import Data.Maybe---- | 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 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-  vars <- replicateM (length _tvbs) (qNewName "k")-  kind <- promoteType (foldType (DConT name) (map DVarT vars))-  inst_decs <- mkEqTypeInstance kind cons'-  return $ decsToTH inst_decs--promoteInstance :: DsMonad q => (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 (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"---- 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 }    <- 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-  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-      concatMapM (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 "Ginving 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-  -- deriving Eq instance-  kvs <- replicateM (length tvbs) (qNewName "k")-  kind <- promoteType (foldType (DConT name) (map DVarT kvs))-  when (any (\case DConPr n -> n == eqName-                   _        -> False) derivings) $ do-    eq_decs <- mkEqTypeInstance kind ctors-    emitDecs eq_decs--  ctorSyms <- buildDefunSymsDataD name tvbs ctors-  emitDecs ctorSyms--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 pClsName = promoteClassName cls_name-  (ptvbs, proxyCxt) <- mkKProxies (map extractTvbName tvbs)-  pCxt <- mapM promote_superclass_pred cxt-  let cxt'  = pCxt ++ proxyCxt-  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 cxt' pClsName ptvbs 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 <*> fmap kindParam (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)-                                    (map kindParam 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-      mb_info <- dsReify pClsName-      case mb_info of-        Just (DTyConI (DClassD _ _ tvbs _ _) _) -> return (map extract_kv_name tvbs)-        _ -> do-          mb_info' <- dsReify cls_name-          case mb_info' of-            Just (DTyConI (DClassD _ _ tvbs _ _) _) -> return (map extractTvbName tvbs)-            _ -> fail $ "Cannot find class declaration annotation for " ++ show cls_name--    extract_kv_name :: DTyVarBndr -> Name-    extract_kv_name (DKindedTV _ (DConT _kproxy `DAppT` DVarT kv_name)) = kv_name-    extract_kv_name tvb = error $ "Internal error: extract_kv_name\n" ++ show tvb---- promoteMethod needs to substitute in a method's kind because GHC does not do--- enough kind checking of associated types. See GHC#9063. When that bug is fixed,--- the substitution code can be removed.--- Bug is fixed, but only in HEAD, naturally. When we stop supporting 7.8,--- this can be rewritten more cleanly, I imagine.--- UPDATE: GHC 7.10.2 didn't fully solve GHC#9063. Urgh.--promoteMethod :: Maybe (Map Name DKind)-                    -- ^ instantiations for class tyvars (Nothing for default decls)-              -> 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 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-    -- GHC 8 requires bare tyvars to the left of a type family default-        | Nothing <- m_subst-        = map DVarT meth_arg_tvs-        | otherwise-        = zipWith (DSigT . DVarT) meth_arg_tvs meth_arg_kis'-  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 <- dsReify proName-        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--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- | isUpcase name = Nothing   -- no need to promote the decl- | 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, pats'), new_vars) <- evalForPair $ mapAndUnzipM 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 :: DType -> DMatch -> PrM (DTySynEqn, ADMatch)-promoteMatch prom_case (DMatch pat exp) = do-  -- promoting the patterns creates variable bindings. These are passed-  -- to the function promoted the RHS-  ((ty, pat'), 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 prom_case pat' ann_exp)---- promotes a term pattern into a type pattern, accumulating bound variable names--- See Note [No wildcards in singletons]-promotePat :: DPat -> QWithAux VarPromotions PrM (DType, DPat)-promotePat (DLitPa lit) = do-  lit' <- promoteLitPat lit-  return (lit', DLitPa lit)-promotePat (DVarPa name) = do-      -- term vars can be symbols... type vars can't!-  tyName <- mkTyName name-  addElement (name, tyName)-  return (DVarT tyName, DVarPa name)-promotePat (DConPa name pats) = do-  (types, pats') <- mapAndUnzipM promotePat pats-  let name' = unboxed_tuple_to_tuple name-  return (foldType (DConT name') types, DConPa name pats')-  where-    unboxed_tuple_to_tuple n-      | Just deg <- unboxedTupleNameDegree_maybe n = tupleDataName deg-      | otherwise                                  = n-promotePat (DTildePa pat) = do-  qReportWarning "Lazy pattern converted into regular pattern in promotion"-  (ty, pat') <- promotePat pat-  return (ty, DTildePa pat')-promotePat (DBangPa pat) = do-  qReportWarning "Strict pattern converted into regular pattern in promotion"-  (ty, pat') <- promotePat pat-  return (ty, DBangPa pat')-promotePat DWildPa = do-  name <- newUniqueName "_z"-  tyName <- mkTyName name-  addElement (name, tyName)-  return (DVarT tyName, DVarPa name)--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)-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 var_proms 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 prom_case) 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 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 :: Monad m => Lit -> m 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) = return $ DLitT (StrTyLit str)-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)
− src/Data/Singletons/Promote/Defun.hs 
@@ -1,191 +0,0 @@-{- Data/Singletons/Promote/Defun.hs--(c) Richard Eisenberg, Jan Stolarek 2014-eir@cis.upenn.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"--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 _ = 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 :: KindOf (Apply (FooSym2 a b) arg)---                          ~ KindOf (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 :: KindOf (Apply (FooSym1 a) arg)---                           ~ KindOf (FooSym2 a arg)---                        => FooSym1 a f--- type instance Apply (FooSym1 a) b = FooSym2 a b--- data FooSym0 f where---  FooSym0KindInference :: KindOf (Apply FooSym0 arg)---                          ~ KindOf (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.Hidden 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 sat_dec = DTySynD sat_name (zipWith mk_tvb tvbNames m_arg_kinds)-                        (foldType (DConT name) (map DVarT tvbNames))-  other_decs <- go (num_args - 1) (reverse m_arg_kinds) m_res_kind-  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 -> PrM [DDec]-    go _ [] _ = return []-    go n (m_arg : m_args) m_result = do-      decls <- go (n - 1) m_args (addStar_maybe (buildTyFun_maybe m_arg m_result))-      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    = 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   = mkEqPred-                          (DConT kindOfName `DAppT`-                            (foldType (DConT data_name) (map DVarT arg_names)-                             `apply`-                             (DVarT extra_name)))-                          (DConT kindOfName `DAppT`-                           foldType (DConT next_name) (map DVarT (arg_names ++ [extra_name])))-          con_decl    = DCon [DPlainTV extra_name]-                             [con_eq_ct]-                             con_name-                             (DNormalC [])-                             Nothing-          data_decl   = DDataD Data [] data_name params [con_decl] []-          app_eqn     = DTySynEqn [ foldType (DConT data_name)-                                             (map DVarT rest_names)-                                  , DVarT fst_name ]-                                  (foldType (DConT (promoteTySym name (n+1)))-                                            (map DVarT (rest_names ++ [fst_name])))-          app_decl    = DTySynInstD applyName app_eqn-          suppress    = DInstanceD Nothing []-                          (DConT suppressClassName `DAppT` DConT data_name)-                          [DLetDec $ DFunD suppressMethodName-                                           [DClause [DWildPa]-                                                    ((DVarE 'snd) `DAppE`-                                                     mkTupleDExp [DConE con_name,-                                                                  mkTupleDExp []])]]-      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,66 +0,0 @@-{- Data/Singletons/Promote/Eq.hs--(c) Richard Eisenberg 2014-eir@cis.upenn.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-  false_branch  <- false_case-  let closedFam = DClosedTypeFamilyD (DTypeFamilyHead helperName-                                                      [ DKindedTV aName kind-                                                      , DKindedTV bName kind ]-                                                      (DKindSig boolKi)-                                                      Nothing)-                                     (true_branches ++ [false_branch])-      eqInst = DTySynInstD tyEqName (DTySynEqn [ DSigT (DVarT aName) kind-                                               , DSigT (DVarT bName) kind ]-                                             (foldType (DConT helperName)-                                                       [DVarT aName, DVarT bName]))-      inst = DInstanceD Nothing [] ((DConT $ promoteClassName eqName) `DAppT`-                                    kindParam 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--        false_case :: Quasi q => q DTySynEqn-        false_case = do-          lvar <- qNewName "a"-          rvar <- qNewName "b"-          return $ DTySynEqn [DSigT (DVarT lvar) kind, DSigT (DVarT rvar) kind]-                             (promoteValRhs falseName)--        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-eir@cis.upenn.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 )--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,58 +0,0 @@-{- Data/Singletons/Type.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.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-    go args     (DSigT ty _) = go args ty  -- just ignore signatures-    go []       (DVarT name) = return $ DVarT name-    go _        (DVarT name) = fail $ "Cannot promote an applied type variable " ++-                                      show name ++ "."-    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
@@ -0,0 +1,319 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# 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  :  Ryan Scott+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Defines the class 'ShowSing' which is useful for defining 'Show' instances+-- for singleton types. Because 'ShowSing' crucially relies on+-- @QuantifiedConstraints@, it is only defined if this library is built with+-- GHC 8.6 or later.+--+----------------------------------------------------------------------------++module Data.Singletons.ShowSing (+#if __GLASGOW_HASKELL__ >= 806+  -- * The 'ShowSing' type+  ShowSing,++  -- * Internal utilities+  ShowSing'+#endif+  ) where++#if __GLASGOW_HASKELL__ >= 806+import Data.Kind+import Data.Singletons+import Text.Show++-- | In addition to the promoted and singled versions of the 'Show' class that+-- @singletons-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.+--+-- As an example, let's consider the singleton type for lists. We want to write+-- an instance with the following shape:+--+-- @+-- 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 (forall a. 'Show' ('Sing' (a :: k))) => 'SList' ('Sing' (z :: [k])) where ...+-- @+--+-- The 'ShowSing' class is a thin wrapper around+-- @(forall a. 'Show' ('Sing' (a :: k)))@. With 'ShowSing', our final instance+-- declaration becomes this:+--+-- @+-- 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 'Show' instance for the singleton type+--+-- What a bargain!++-- One might wonder we we simply don't define ShowSing as+-- @type ShowSing k = (forall (z :: k). ShowSing' z)@ instead of going the+-- extra mile to define it as a class.+-- See Note [Define ShowSing as a class, not a type synonym] for an explanation.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing :: Type -> Constraint+#endif+class    (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)+instance (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)++-- | The workhorse that powers 'ShowSing'. The only reason that `ShowSing'`+-- exists is to work around GHC's inability to put type families in the head+-- of a quantified constraint (see+-- <https://gitlab.haskell.org/ghc/ghc/issues/14860 this GHC issue> for more+-- details on this point). In other words, GHC will not let you define+-- 'ShowSing' like so:+--+-- @+-- class (forall (z :: k). 'Show' ('Sing' z)) => 'ShowSing' k+-- @+--+-- By replacing @'Show' ('Sing' z)@ with @ShowSing' z@, we are able to avoid+-- this restriction for the most part.+--+-- The superclass of `ShowSing'` is a bit peculiar:+--+-- @+-- class (forall (sing :: k -> Type). sing ~ 'Sing' => 'Show' (sing z)) => `ShowSing'` (z :: k)+-- @+--+-- One might wonder why this superclass is used instead of this seemingly more+-- direct equivalent:+--+-- @+-- class 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- Actually, these aren't equivalent! The latter's superclass mentions a type+-- family in its head, and this gives GHC's constraint solver trouble when+-- trying to match this superclass against other constraints. (See the+-- discussion beginning at+-- https://gitlab.haskell.org/ghc/ghc/-/issues/16365#note_189057 for more on+-- this point). The former's superclass, on the other hand, does /not/ mention+-- a type family in its head, which allows it to match other constraints more+-- easily. It may sound like a small difference, but it's the only reason that+-- 'ShowSing' is able to work at all without a significant amount of additional+-- workarounds.+--+-- The quantified superclass has one major downside. Although the head of the+-- quantified superclass is more eager to match, which is usually a good thing,+-- it can bite under certain circumstances. Because @'Show' (sing z)@ will+-- match a 'Show' instance for /any/ types @sing :: k -> Type@ and @z :: k@,+-- (where @k@ is a kind variable), it is possible for GHC's constraint solver+-- to get into a situation where multiple instances match @'Show' (sing z)@,+-- and GHC will get confused as a result. Consider this example:+--+-- @+-- -- As in "Data.Singletons"+-- newtype 'WrappedSing' :: forall k. k -> Type where+--   'WrapSing' :: forall k (a :: k). { 'unwrapSing' :: 'Sing' a } -> 'WrappedSing' a+--+-- instance 'ShowSing' k => 'Show' ('WrappedSing' (a :: k)) where+--   'showsPrec' _ s = 'showString' "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}'+-- @+--+-- When typechecking the 'Show' instance for 'WrappedSing', GHC must fill in a+-- default definition @'show' = defaultShow@, where+-- @defaultShow :: 'Show' ('WrappedSing' a) => 'WrappedSing' a -> 'String'@.+-- GHC's constraint solver has two possible ways to satisfy the+-- @'Show' ('WrappedSing' a)@ constraint for @defaultShow@:+--+-- 1. The top-level instance declaration for @'Show' ('WrappedSing' (a :: k))@+--    itself, and+--+-- 2. @'Show' (sing (z :: k))@ from the head of the quantified constraint arising+--    from @'ShowSing' k@.+--+-- In practice, GHC will choose (2), as local quantified constraints shadow+-- global constraints. This confuses GHC greatly, causing it to error out with+-- an error akin to @Couldn't match type Sing with WrappedSing@. See+-- https://gitlab.haskell.org/ghc/ghc/-/issues/17934 for a full diagnosis of+-- the issue.+--+-- The bad news is that because of GHC#17934, we have to manually define 'show'+-- (and 'showList') in the 'Show' instance for 'WrappedSing' in order to avoid+-- confusing GHC's constraint solver. In other words, @deriving 'Show'@ is a+-- no-go for 'WrappedSing'. The good news is that situations like 'WrappedSing'+-- are quite rare in the world of @singletons@—most of the time, 'Show'+-- instances for singleton types do /not/ have the shape+-- @'Show' (sing (z :: k))@, where @k@ is a polymorphic kind variable. Rather,+-- most such instances instantiate @k@ to a specific kind (e.g., @Bool@, or+-- @[a]@), which means that they will not overlap the head of the quantified+-- superclass in `ShowSing'` as observed above.+--+-- Note that we define the single instance for `ShowSing'` without the use of a+-- quantified constraint in the instance context:+--+-- @+-- instance 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- We /could/ define this instance with a quantified constraint in the instance+-- context, and it would be equally as expressive. But it doesn't provide any+-- additional functionality that the non-quantified version gives, so we opt+-- for the non-quantified version, which is easier to read.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing' :: k -> Constraint+#endif+class    (forall (sing :: k -> Type). sing ~ Sing => Show (sing z))+                       => ShowSing' (z :: k)+instance Show (Sing z) => ShowSing' (z :: k)++{-+Note [Define ShowSing as a class, not a type synonym]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In an ideal world, we would simply define ShowSing like this:++  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.+-}++------------------------------------------------------------+-- (S)WrappedSing instances+------------------------------------------------------------++-- 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
@@ -0,0 +1,248 @@+{-# 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  :  Ryan Scott+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Defines 'Sigma', a dependent pair data type, and related functions.+--+----------------------------------------------------------------------------++module Data.Singletons.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+#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'.+#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.+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.+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++-- | Map across a 'Sigma' value in a dependent fashion.+mapSigma :: Sing (f :: a ~> b) -> (forall (x :: a). p @@ x -> q @@ (f @@ x))+         -> Sigma a p -> Sigma b q+mapSigma f g ((x :: Sing (fst :: a)) :&: y) = (f @@ x) :&: (g @fst y)++-- | Zip two 'Sigma' values together in a dependent fashion.+zipSigma :: Sing (f :: a ~> b ~> c)+         -> (forall (x :: a) (y :: b). p @@ x -> q @@ y -> r @@ (f @@ x @@ y))+         -> Sigma a p -> Sigma b q -> Sigma c r+zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) =+  (f @@ a @@ b) :&: (g @fstA @fstB p q)++-- | 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,602 +0,0 @@-{- Data/Singletons/Single.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.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.Ord-import Data.Singletons.Deriving.Bounded-import Data.Singletons.Deriving.Enum-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.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--{--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 <http://www.cis.upenn.edu/~eir/packages/singletons/README.html> 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-  aName <- qNewName "a"-  let aVar = DVarT aName-  (scons, _) <- singM [] $ mapM (singCtor aVar) dcons-  eqInstance <- mkEqualityInstance kind 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"--singInstance :: DsMonad q-             => (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 (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"--singTopLevelDecs :: DsMonad q => [Dec] -> [DDec] -> q [DDec]-singTopLevelDecs locals raw_decls = do-  decls <- withLocalDeclarations locals $ expand raw_decls     -- expand type synonyms-  PDecs { pd_let_decs              = letDecls-        , pd_class_decs            = classes-        , pd_instance_decs         = insts-        , pd_data_decs             = datas }    <- 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-    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'-                                 return (newDataDecls ++ newClassDecls ++ newInstDecls)-    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 $ zipWith mk_default_sig meth_names sing_sigs-      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)-  let fixities' = map (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) =-      DDefaultSigD s_name <$> add_constraints meth_name sty-    mk_default_sig _ _ = error "Internal error: a singled signature isn't a signature."--    add_constraints meth_name sty = do  -- Maybe monad-      prom_dflt <- Map.lookup meth_name promoted_defaults-      let default_pred = foldl DAppPr (DConPr equalityName)-                               [ foldApply (promoteValRhs meth_name) tvs-                               , 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_kproxy_tvbs _cls_pred s_ty) _) -> do-             -- GHC 8 quantifies over the kind vars explicitly-          let class_kvs = [ class_kv | DKindedTV class_kv DStarT <- cls_kproxy_tvbs ]-              (sing_tvbs, _pred, _args, res_ty) = unravel s_ty--          inst_kis <- mapM promoteType inst_tys-          let subst    = Map.fromList (zip class_kvs 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)-              (s_ty, _num_args, tyvar_names, res_ki) <- singType (promoteValRhs name)-                                                                 (substType subst inner_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-  let infix_decls' = map (uncurry singInfixDecl) infix_decls-      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)--singInfixDecl :: Fixity -> Name -> DLetDec-singInfixDecl fixity name-  | isUpcase name =-    -- is it a tycon name or a datacon name??-    -- it *must* be a datacon name, because symbolic tycons-    -- can't be promoted. This is terrible.-    DInfixD fixity (singDataConName name)-  | otherwise = DInfixD fixity (singValName name)--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-  (sPats, prom_pats)-    <- mapAndUnzipM (singPat (Map.fromList var_proms) Parameter) pats-  let bound_name_tys = map DVarT bound_names-      equalities     = zip bound_name_tys prom_pats-      -- This res_ki stuff is necessary when we need to propagate result--      -- based type-inference. It was inspired by toEnum. (If you remove-      -- this, that should fail to compile.)-      applied_ty = foldl apply prom_fun bound_name_tys `maybeSigT` res_ki-         -- We used to use prom_pats as the arguments above, but bound_name_tys-         -- is better, because the type variables have kinds. When the pattern-         -- is, say, [], then we get a kind ambiguity. See #136.-  sBody <- bindTyVarsEq var_proms applied_ty equalities $ singExp exp res_ki-    -- when calling unSingFun, the prom_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'---- we need to know where a pattern is to anticipate when--- GHC's brain might explode-data PatternContext = LetBinding-                    | CaseStatement-                    | Parameter-                    deriving Eq--checkIfBrainWillExplode :: Monad m => PatternContext -> m ()-checkIfBrainWillExplode CaseStatement = return ()-checkIfBrainWillExplode Parameter = return ()-checkIfBrainWillExplode _ =-  fail $ "Can't use a singleton pattern outside of a case-statement or\n" ++-         "do expression: GHC's brain will explode if you try. (Do try it!)"---- Note [No wildcards in singletons]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ We forbid patterns with wildcards during singletonization. Why? Because--- singletonizing a pattern also must produce a type expression equivalent--- to the pattern, for use in bindTyVars. Wildcards get in the way of this.--- Thus, we de-wild patterns during promotion, and put the de-wilded patterns--- in the ADExp AST.--singPat :: Map Name Name   -- from term-level names to type-level names-        -> PatternContext-        -> DPat-        -> SgM (DPat, DType) -- the type form of the pat-singPat _var_proms _patCxt (DLitPa _lit) =-  fail "Singling of literal patterns not yet supported"-singPat var_proms _patCxt (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), DVarT tyname)-singPat var_proms patCxt (DConPa name pats) = do-  checkIfBrainWillExplode patCxt-  (pats', tys) <- mapAndUnzipM (singPat var_proms patCxt) pats-  return ( DConPa (singDataConName name) pats'-         , foldl apply (promoteValRhs name) tys )-singPat var_proms patCxt (DTildePa pat) = do-  qReportWarning-    "Lazy pattern converted into regular pattern during singleton generation."-  singPat var_proms patCxt pat-singPat var_proms patCxt (DBangPa pat) = do-  (pat', ty) <- singPat var_proms patCxt pat-  return (DBangPa pat', ty)-singPat _var_proms _patCxt DWildPa =-  -- See Note [No wildcards in singletons]-  fail "Internal error: wildcard seen during singleton generation"---- 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 that code.-  if isException e1'-  then return e1'-  else return $ (DVarE applySingName) `DAppE` e1' `DAppE` e2'-singExp (ADLamE var_proms prom_lam names exp) _res_ki = do-  let sNames = map singValName names-  exp' <- bindTyVars var_proms (foldl apply prom_lam (map (DVarT . snd) var_proms)) $-          singExp exp Nothing-  return $ wrapSingFun (length names) prom_lam $ DLamE sNames exp'-singExp (ADCaseE exp prom_exp matches ret_ty) res_ki =-    -- See Note [Annotate case return type]-  DSigE <$> (DCaseE <$> singExp exp Nothing <*> mapM (singMatch prom_exp 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."--isException :: DExp -> Bool-isException (DVarE n)             = n == undefinedName-isException (DConE {})            = False-isException (DLitE {})            = False-isException (DAppE (DVarE fun) _) | nameBase fun == "sError" = True-isException (DAppE fun _)         = isException fun-isException (DLamE _ _)           = False-isException (DCaseE e _)          = isException e-isException (DLetE _ e)           = isException e-isException (DSigE e _)           = isException e-isException (DStaticE e)          = isException e--singMatch :: DType        -- ^ the promoted scrutinee-          -> Maybe DKind  -- ^ the result kind, if known-          -> ADMatch -> SgM DMatch-singMatch prom_scrut res_ki (ADMatch var_proms prom_match pat exp) = do-  (sPat, prom_pat)-    <- singPat (Map.fromList var_proms) CaseStatement pat-        -- why DAppT below? See comment near decl of ADMatch in LetDecEnv.-  let equality-        | DVarPa _ <- pat-        , (ADVarE err) `ADAppE` _ <- exp-        , err == errorName   -- See Note [Why error is so special]-        = [] -- no equality from impossible case.-        | otherwise      = [(prom_pat, prom_scrut)]-  sExp <- bindTyVarsEq var_proms (prom_match `DAppT` prom_pat `maybeSigT` res_ki) equality $-          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 lit = do-  prom_lit <- promoteLitExp lit-  return $ DVarE singMethName `DSigE` (singFamily `DAppT` prom_lit)--maybeSigT :: DType -> Maybe DKind -> DType-maybeSigT ty Nothing   = ty-maybeSigT ty (Just ki) = ty `DSigT` ki
− src/Data/Singletons/Single/Data.hs 
@@ -1,158 +0,0 @@-{- Data/Singletons/Single/Data.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.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.Promote.Type-import Data.Singletons.Single.Eq-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 a = DVarT aName-  let tvbNames = map extractTvbName tvbs-  k <- promoteType (foldType (DConT name) (map DVarT tvbNames))-  ctors' <- mapM (singCtor a) ctors--  -- instance for SingKind-  fromSingClauses <- mapM mkFromSingClause ctors-  toSingClauses   <- mapM mkToSingClause ctors-  let singKindInst =-        DInstanceD Nothing-                   (map (singKindConstraint . DVarT) tvbNames)-                   (DAppT (DConT singKindClassName) k)-                   [ DTySynInstD demoteRepName $ DTySynEqn-                      [k]-                      (foldType (DConT name)-                        (map (DAppT demote . DVarT) tvbNames))-                   , DLetDec $ DFunD fromSingName (fromSingClauses `orIfEmpty` emptyMethod aName)-                   , DLetDec $ DFunD toSingName   (toSingClauses   `orIfEmpty` emptyMethod aName) ]--  -- SEq instance-  sEqInsts <- if any (\case DConPr n -> n == eqName; _ -> False) derivings-              then mapM (mkEqualityInstance k ctors') [sEqClassDesc, sDecideClassDesc]-              else return []--  -- e.g. type SNat = Sing :: Nat -> *-  let kindedSynInst =-        DTySynD (singTyConName name)-                []-                (singFamily `DSigT` (DArrowT `DAppT` k `DAppT` DStarT))--  return $ (DDataInstD Data [] singFamilyName [DSigT a k] ctors' []) :-           kindedSynInst :-           singKindInst :-           sEqInsts-  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 recursiveCalls = zipWith mkRecursiveCall varNames promoted-          return $-            DClause [DConPa cname' (map DVarPa varNames)]-                    (multiCase recursiveCalls-                               (map (DConPa someSingDataName . listify . DVarPa)-                                    svarNames)-                               (DAppE (DConE someSingDataName)-                                         (foldExp (DConE (singDataConName cname))-                                                  (map DVarE svarNames))))--        mkRecursiveCall :: Name -> DKind -> DExp-        mkRecursiveCall var_name ki =-          DSigE (DAppE (DVarE toSingName) (DVarE var_name))-                (DAppT (DConT someSingTypeName) ki)--        emptyMethod :: Name -> [DClause]-        emptyMethod n = [DClause [DVarPa n] (DCaseE (DVarE n) emptyMatches)]---- refine a constructor. the first parameter is the type variable that--- the singleton GADT is parameterized by-singCtor :: DType -> DCon -> SgM DCon- -- polymorphic constructors are handled just- -- like monomorphic ones -- the polymorphism in- -- the kind is automatic-singCtor a (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 _ -> DNormalC $ map (noBang,) args-                    DRecC rec_fields ->-                      DRecC [ (singValName field_name, noBang, arg)-                            | (field_name, _, _) <- rec_fields-                            | arg <- args ]-  return $ DCon tvbs-                [mkEqPred a (foldType pCon indices)]-                sName-                conFields-                Nothing-  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,119 +0,0 @@-{- Data/Singletons/Single/Eq.hs--(c) Richard Eisenberg 2014-eir@cis.upenn.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.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, Name, Name)-sEqClassDesc, sDecideClassDesc :: Quasi q => EqualityClassDesc q-sEqClassDesc = (mkEqMethClause, sEqClassName, sEqMethName)-sDecideClassDesc = (mkDecideMethClause, sDecideClassName, sDecideMethName)---- pass the *singleton* constructors, not the originals-mkEqualityInstance :: Quasi q => DKind -> [DCon]-                   -> EqualityClassDesc q -> q DDec-mkEqualityInstance k ctors (mkMeth, className, methName) = do-  let ctorPairs = [ (c1, c2) | c1 <- ctors, c2 <- ctors ]-  methClauses <- if null ctors-                 then mkEmptyMethClauses-                 else mapM mkMeth ctorPairs-  return $ DInstanceD Nothing-                      (map (DAppPr (DConPr className)) (getKindVars k))-                     (DAppT (DConT className) k)-                     [DLetDec $ DFunD methName methClauses]-  where getKindVars :: DKind -> [DKind]-        getKindVars (DVarT x)         = [DVarT x]-        getKindVars (DAppT f a)       = concatMap getKindVars [f, a]-        getKindVars (DConT {})        = []-        getKindVars DStarT            = []-        getKindVars DArrowT           = []-        getKindVars other             =-          error ("getKindVars sees an unusual kind: " ++ show other)--        mkEmptyMethClauses :: Quasi q => q [DClause]-        mkEmptyMethClauses = do-          a <- qNewName "a"-          return [DClause [DVarPa a, DWildPa] (DCaseE (DVarE a) emptyMatches)]--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--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) emptyMatches)))--  where-    (lname, lNumArgs) = extractNameArgs c1-    (rname, rNumArgs) = extractNameArgs c2
− src/Data/Singletons/Single/Monad.hs 
@@ -1,230 +0,0 @@-{- Data/Singletons/Single/Monad.hs--(c) Richard Eisenberg 2014-eir@cis.upenn.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, bindTyVars, bindTyVarsEq, 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, VarPromotions )-import Data.Singletons.Names-import Data.Singletons.Util-import Data.Singletons-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 )--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--  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 })---- bindTyVarsEq--- ~~~~~~~~~~~~~~~~------ This function does some dirty business.------ The problem is that, whenever we bind a term variable, we would also like--- to bind a type variable, for use in promotions of any nested lambdas,--- cases, and lets. The natural idea, something like `(\(foo :: Sing ty_foo)--- (bar :: Sing ty_bar) -> ...)` doesn't work, because ScopedTypeVariables is--- stupid (in RAE's opinon). The ScopedTypeVariables extension says that any--- scoped type variable is a rigid skolem. This means that the types ty_foo--- and ty_bar must be distinct! That's actually not the problem. The problem--- is that the implicit kind variables used in ty_foo's and ty_bar's kinds are--- also skolems, and this breaks the idea.------ The solution? Use scoped type variables from a function signature, where--- the bound variables' kinds are *inferred*, not skolem. This means that,--- whenever we lambda-bind variables (that is, in lambdas, let-bound--- functions, and case matches), we must then pass the variables immediately--- to a function with an explicit type signature. Thus, something like------   (\foo bar -> ...)------ becomes------   (\foo bar ->---     let lambda :: forall ty_foo ty_bar. Sing ty_foo -> Sing ty_bar -> Sing ...---         lambda foo' bar' = ... (with foo |-> foo' and bar |-> bar')---     in lambda foo bar)------ Getting the ... right in the type above is a major nuisance, and it--- explains a bunch of the types stored in the ADExp AST. (See LetDecEnv.)------ A further, unsolved problem with all of this is that the type signature--- generated never has any constraints. Thus, if the body requires a--- constraint somewhere, the code will fail to compile; we're not quite clever--- enough to get everything to line up.------ As a stop-gap measure to fix this, in the function clause case, we tie the--- scoped type variables in this "lambda" to the outer scoped type variables.--- This has the effect of making sure that the kinds of ty_foo and ty_bar--- match that of the surrounding scope and makes sure that any constraint is--- available from within the "lambda".------ This means, though, that using constraints with case statements and lambdas--- will likely not work. Ugh. UPDATE: This actually bit in practice! The--- Enum class wants to define `succ = toEnum . (+1) . fromEnum`. But that--- (+1) is a right-section, which desugars to a lambda. The Num constraint--- couldn't get through. Changing (+1) to (1+) fixed the problem, as--- left-sections don't need a lambda.--bindTyVarsEq :: VarPromotions   -- the bindings we wish to effect-             -> DType           -- the type of the thing_inside-             -> [(DType, DType)]  -- and asserting these equalities-             -> SgM DExp -> SgM DExp-bindTyVarsEq var_proms prom_fun equalities thing_inside = do-  lambda <- qNewName "lambda"-  let (term_names, tyvar_names) = unzip var_proms-      eq_ct  = [ mkEqPred t1 t2-               | (t1, t2) <- equalities ]-      ty_sig = DSigD lambda $-               DForallT (map DPlainTV tyvar_names) eq_ct $-                        ravel (map (\tv_name -> singFamily `DAppT` DVarT tv_name)-                                    tyvar_names)-                              (singFamily `DAppT` prom_fun)-  arg_names <- mapM (qNewName . nameBase) term_names-  body <- bindLets [ (term_name, DVarE arg_name)-                   | term_name <- term_names-                   | arg_name <- arg_names ] $ thing_inside-  let fundef   = DFunD lambda [DClause (map DVarPa arg_names) body]-      let_body = foldExp (DVarE lambda) (map (DVarE . singValName) term_names)-  return $ DLetE [ty_sig, fundef] let_body--bindTyVars :: VarPromotions -> DType -> SgM DExp -> SgM DExp-bindTyVars var_proms prom_fun = bindTyVarsEq var_proms prom_fun []--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 `DAppE` proxyFor 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 `DAppE` proxyFor 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-eir@cis.upenn.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,20 +0,0 @@--- Data/Singletons/Hidden.hs------ (c) Richard Eisenberg 2014--- eir@cis.upenn.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 PolyKinds #-}--module Data.Singletons.SuppressUnusedWarnings where--import Data.Proxy---- | 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 :: Proxy t -> ()
− src/Data/Singletons/Syntax.hs 
@@ -1,136 +0,0 @@-{- Data/Singletons/Syntax.hs--(c) Richard Eisenberg 2014-eir@cis.upenn.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 #-}--module Data.Singletons.Syntax where--import Prelude hiding ( exp )-import Data.Monoid-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Desugar-import Data.Map.Strict ( Map )-import qualified Data.Map.Strict as Map--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 VarPromotions  -- bind these type variables to these term vars-                    DType          -- the promoted lambda-                    [Name] ADExp-           | ADCaseE ADExp DType [ADMatch] DType-               -- the first type is the promoted scrutinee;-               -- the second type is the return type-           | ADLetE ALetDecEnv ADExp-           | ADSigE ADExp DType-- -- unlike in other places, the DType in an ADMatch (the promoted "case" statement)- -- should be used with DAppT, *not* apply! (Case statements are not defunctionalized.)-data ADMatch = ADMatch VarPromotions DType 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-type instance IfAnn Annotated   yes no = yes-type instance 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 Monoid ULetDecEnv where-  mempty = LetDecEnv Map.empty Map.empty [] ()-  mappend (LetDecEnv defns1 types1 infx1 _) (LetDecEnv defns2 types2 infx2 _) =-    LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) ()--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
− src/Data/Singletons/TH.hs 
@@ -1,147 +0,0 @@-{-# LANGUAGE ExplicitNamespaces, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TH--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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,--  -- ** Utility functions-  cases, sCases,--  -- * Basic singleton definitions-  Sing(SFalse, STrue, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7),-  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, (:&&), SEq(..),-  POrd(..), SOrd(..), ThenCmp, sThenCmp, Foldl, sFoldl,-  Any,-  SDecide(..), (:~:)(..), Void, Refuted, Decision(..),-  Proxy(..), SomeSing(..),--  Error, ErrorSym0,-  TrueSym0, FalseSym0,-  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, ThenCmpSym0, FoldlSym0,--  SuppressUnusedWarnings(..)-- ) where--import Data.Singletons-import Data.Singletons.Single-import Data.Singletons.Promote-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Decide-import Data.Singletons.TypeLits-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.Names-import Language.Haskell.TH.Desugar--import GHC.Exts-import Language.Haskell.TH-import Data.Singletons.Util-import Data.Proxy ( Proxy(..) )-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,44 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeLits--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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.----------------------------------------------------------------------------------{-# OPTIONS_GHC -fno-warn-orphans #-}--module Data.Singletons.TypeLits (-  Nat, Symbol,-  Sing(SNat, SSym),-  SNat, SSymbol, withKnownNat, withKnownSymbol,-  Error, ErrorSym0, ErrorSym1, sError,-  KnownNat, natVal, KnownSymbol, symbolVal,--  (:^), (:^$), (:^$$), (:^$$$)-  ) where--import Data.Singletons.TypeLits.Internal-import Data.Singletons.Prelude.Num ()   -- for typelits instances---- 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--no_term_level_nats :: a-no_term_level_nats = error "The kind `Nat` may not be used at the term level."
− src/Data/Singletons/TypeLits/Internal.hs 
@@ -1,155 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeLits.Internal--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.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 #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Data.Singletons.TypeLits.Internal (-  Sing(..),--  Nat, Symbol,-  SNat, SSymbol, withKnownNat, withKnownSymbol,-  Error, ErrorSym0, ErrorSym1, sError,-  KnownNat, natVal, KnownSymbol, symbolVal,--  (:^), (:^$), (:^$$), (:^$$$)-  ) where--import Data.Singletons.Promote-import Data.Singletons-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 Data.Type.Equality-import Data.Proxy ( Proxy(..) )-import Unsafe.Coerce----------------------------------------------------------------------------- TypeLits singletons ----------------------------------------------------------------------------------------------------------------------data instance Sing (n :: Nat) = KnownNat n => SNat--instance KnownNat n => SingI n where-  sing = SNat--instance SingKind Nat where-  type DemoteRep Nat = Integer-  fromSing (SNat :: Sing n) = natVal (Proxy :: Proxy n)-  toSing n = case someNatVal n of-               Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNat :: Sing n)-               Nothing -> error "Negative singleton nat"--data instance Sing (n :: Symbol) = KnownSymbol n => SSym--instance KnownSymbol n => SingI n where-  sing = SSym--instance SingKind Symbol where-  type DemoteRep Symbol = String-  fromSing (SSym :: Sing n) = symbolVal (Proxy :: Proxy n)-  toSing s = case someSymbolVal s of-               SomeSymbol (_ :: Proxy n) -> SomeSing (SSym :: Sing n)---- SDecide instances:-instance SDecide Nat where-  (SNat :: Sing n) %~ (SNat :: Sing m)-    | natVal (Proxy :: Proxy n) == 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 ('Proxy :: Proxy Nat) where-  type (a :: Nat) :== (b :: Nat) = a == b-instance PEq ('Proxy :: Proxy Symbol) where-  type (a :: Symbol) :== (b :: Symbol) = a == 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 ('Proxy :: Proxy Nat) where-  type (a :: Nat) `Compare` (b :: Nat) = a `TL.CmpNat` b--instance POrd ('Proxy :: Proxy 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-$(genDefunSymbols [''Error])---- | The singleton for 'error'-sError :: Sing (str :: Symbol) -> a-sError sstr = error (fromSing sstr)---- TODO: move this to a better home:-type a :^ b = a ^ b-infixr 8 :^-$(genDefunSymbols [''(:^)])
− src/Data/Singletons/TypeRepStar.hs 
@@ -1,86 +0,0 @@-{-# LANGUAGE RankNTypes, TypeFamilies, KindSignatures, FlexibleInstances,-             GADTs, UndecidableInstances, ScopedTypeVariables, DataKinds,-             MagicHash, TypeOperators #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeRepStar--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)--- Stability   :  experimental--- Portability :  non-portable------ This module defines singleton instances making 'Typeable' 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 @*@:-  ---  -- > data instance Sing (a :: *) where-  -- >   STypeRep :: Typeable a => Sing a-  ---  -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and 'TestCoercion' are-  -- also supplied.-  ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons-import Data.Singletons.Prelude.Eq-import Data.Typeable-import Unsafe.Coerce-import Data.Singletons.Decide--import Data.Kind-import GHC.Exts ( Proxy# )-import Data.Type.Coercion-import Data.Type.Equality--data instance Sing (a :: *) where-  STypeRep :: Typeable a => Sing a--instance Typeable a => SingI (a :: *) where-  sing = STypeRep-instance SingKind Type where-  type DemoteRep Type = TypeRep-  fromSing (STypeRep :: Sing a) = typeOf (undefined :: a)-  toSing = dirty_mk_STypeRep--instance PEq ('Proxy :: Proxy Type) where-  type (a :: *) :== (b :: *) = a == b--instance SEq Type where-  (STypeRep :: Sing a) %:== (STypeRep :: Sing b) =-    case (eqT :: Maybe (a :~: b)) of-      Just Refl -> 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 :: Sing a) %~ (STypeRep :: Sing b) =-    case (eqT :: Maybe (a :~: b)) of-      Just Refl -> Proved Refl-      Nothing   -> Disproved (\Refl -> error "Data.Typeable.eqT failed")---- TestEquality instance already defined, but we need this one:-instance TestCoercion Sing where-  testCoercion (STypeRep :: Sing a) (STypeRep :: Sing b) =-    case (eqT :: Maybe (a :~: b)) of-      Just Refl -> Just Coercion-      Nothing   -> Nothing---- everything below here is private and dirty. Don't look!--newtype DI = Don'tInstantiate (forall a. Typeable a => Sing a)-dirty_mk_STypeRep :: TypeRep -> SomeSing *-dirty_mk_STypeRep rep =-  let justLikeTypeable :: Proxy# a -> TypeRep-      justLikeTypeable _ = rep-  in-  unsafeCoerce (Don'tInstantiate STypeRep) justLikeTypeable
− src/Data/Singletons/Util.hs 
@@ -1,465 +0,0 @@-{- Data/Singletons/Util.hs--(c) Richard Eisenberg 2013-eir@cis.upenn.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 Control.Monad.Fail ( MonadFail )---- The list of types that singletons processes by default-basicTypes :: [Name]-basicTypes = [ ''Maybe-             , ''[]-             , ''Either-             , ''NonEmpty-             ] ++ 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 an identifier uppercase?-isUpcase :: Name -> Bool-isUpcase n = let first = head (nameBase n) in isUpper first || first == ':'---- make an identifier uppercase-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-      |  first == ':'-      || first == '$' -- special case to avoid name clashes. See #29-      = symb ++ str-      | otherwise-      = symb ++ ':' : str--noPrefix :: (String, String)-noPrefix = ("", "")---- make an identifier lowercase-locase :: Name -> Name-locase n =-  let str = nameBase n-      first = head str in-    if isHsLetter first-     then mkName ((toLower first) : tail str)-     else mkName (tail str) -- remove the ":"---- put an uppercase prefix on a name. Takes two prefixes: one for identifiers--- and one for symbols-prefixUCName :: String -> String -> Name -> Name-prefixUCName pre tyPre n = case (nameBase n) of-    (':' : rest) -> mkName (tyPre ++ rest)-    alpha -> mkName (pre ++ alpha)---- put a lowercase prefix on a name. Takes two prefixes: one for identifiers--- and one for symbols-prefixLCName :: String -> String -> Name -> Name-prefixLCName pre tyPre n =-  let str = nameBase n-      first = head str in-    if isHsLetter first-     then mkName (pre ++ str)-     else mkName (tyPre ++ str)--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)---- 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--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---- 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--emptyMatches :: [DMatch]-emptyMatches = [DMatch DWildPa (DAppE (DVarE 'error) (DLitE (StringL errStr)))]-  where errStr = "Empty case reached -- this should be impossible"---- 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 )---- 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--  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]---- 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)--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,74 +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"-    ],-    testCompileAndDumpGroup "Promote"-    [ compileAndDumpStdTest "Constructors"-    , compileAndDumpStdTest "GenDefunSymbols"-    , compileAndDumpStdTest "Newtypes"-    , compileAndDumpStdTest "Pragmas"-    , compileAndDumpStdTest "Prelude"-    ],-    testGroup "Database client"-    [ compileAndDumpTest "GradingClient/Database" ghcOpts-    , compileAndDumpTest "GradingClient/Main"     ghcOpts-    ],-    testCompileAndDumpGroup "InsertionSort"-    [ compileAndDumpStdTest "InsertionSortImp"-    ]-  ]+main = pure ()
− tests/SingletonsTestSuiteUtils.hs 
@@ -1,258 +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.Process     ( CreateProcess(..), StdStream(..)-                          , createProcess, proc, waitForProcess-                          , readProcess, callCommand            )-import System.Directory   ( doesFileExist                       )-import Test.Tasty         ( TestTree, testGroup                 )-import Test.Tasty.Golden  ( goldenVsFileDiff                    )--import Distribution.Package                          ( PackageIdentifier(..)     )-import Distribution.Text                             ( simpleParse               )-import Data.Version                                  ( Version(..)               )-import System.IO.Unsafe                              ( unsafePerformIO           )--#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 = ".ghc80"---- The mtl package made an incompatible change between 2.1.3.1 and 2.2.1. Because--- test files are compiled outside of the cabal infrastructure, we need to check--- the mtl version and behave accordingly. Argh. The more general solution to this--- is to use cabal_macros.h and then use the package specifications in dist/setup-config.--- This also uses a cabal sandbox, if it is around.-extraOpts :: [String]-extraOpts = unsafePerformIO $ do-  (ghcPackageDbOpts, ghcPkgOpts) <- 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 ]-                               , [ "--no-user-package-db"  -- ghc-pkg is slightly different!-                                 , "--package-db=" ++ package_db ] )-       opts_from_config `liftM` readFile "cabal.sandbox.config"-     else return ([], [])-  mtl_string <- readProcess "ghc-pkg" (ghcPkgOpts ++ ["latest", "mtl"]) ""-  let Just (PackageIdentifier { pkgVersion = ver }) = simpleParse mtl_string-      firstModernVersion = Version [2,2,1] []-      mtlOpt | ver >= firstModernVersion = ["-DMODERN_MTL"]-             | otherwise                 = []-  return $ ghcPackageDbOpts ++ mtlOpt----- 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"-  ]---- 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/[!#$%&*+./>]\\{10\\}/%%%%%%%%%%/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.ghc80.template 
@@ -1,4907 +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 family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where-      Equals_0123456789 Zero Zero = TrueSym0-      Equals_0123456789 (Succ a) (Succ b) = (:==) a b-      Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0-    instance PEq (Proxy :: Proxy Nat) where-      type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b-    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. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = SuccSym1 l-    type family Compare_0123456789 (a :: Nat)-                                   (a :: Nat) :: Ordering where-      Compare_0123456789 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]-      Compare_0123456789 (Succ a_0123456789) (Succ b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])-      Compare_0123456789 Zero (Succ _z_0123456789) = LTSym0-      Compare_0123456789 (Succ _z_0123456789) Zero = GTSym0-    type Compare_0123456789Sym2 (t :: Nat) (t :: Nat) =-        Compare_0123456789 t t-    instance SuppressUnusedWarnings Compare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.())-    data Compare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) =>-        Compare_0123456789Sym1KindInference-    type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Compare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.())-    data Compare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                 -> Type))-      = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) =>-        Compare_0123456789Sym0KindInference-    type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l-    instance POrd (Proxy :: Proxy Nat) where-      type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789Sym0 a) a-    data instance Sing (z :: Nat)-      = z ~ Zero => SZero |-        forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat))-    type SNat = (Sing :: Nat -> Type)-    instance SingKind Nat where-      type DemoteRep Nat = Nat-      fromSing SZero = Zero-      fromSing (SSucc b) = Succ (fromSing b)-      toSing Zero = SomeSing SZero-      toSing (Succ b)-        = case toSing b :: SomeSing Nat of {-            SomeSing c -> SomeSing (SSucc c) }-    instance SEq Nat where-      (%:==) SZero SZero = STrue-      (%:==) SZero (SSucc _) = SFalse-      (%:==) (SSucc _) SZero = SFalse-      (%:==) (SSucc a) (SSucc b) = (%:==) a b-    instance SDecide Nat where-      (%~) SZero SZero = Proved Refl-      (%~) SZero (SSucc _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SSucc _) SZero-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SSucc a) (SSucc b)-        = case (%~) a b of {-            Proved Refl -> Proved Refl-            Disproved contra-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) }-    instance SOrd Nat => SOrd Nat where-      sCompare ::-        forall (t0 :: Nat) (t1 :: Nat).-        Sing t0-        -> Sing t1-           -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering-                                                            -> Type)-                                                 -> Type) t0 :: TyFun Nat Ordering-                                                                -> Type) t1 :: Ordering)-      sCompare SZero SZero-        = let-            lambda ::-              (t0 ~ ZeroSym0, t1 ~ ZeroSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  SNil-          in lambda-      sCompare (SSucc sA_0123456789) (SSucc sB_0123456789)-        = let-            lambda ::-              forall a_0123456789 b_0123456789.-              (t0 ~ Apply SuccSym0 a_0123456789,-               t1 ~ Apply SuccSym0 b_0123456789) =>-              Sing a_0123456789-              -> Sing b_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda a_0123456789 b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     SNil)-          in lambda sA_0123456789 sB_0123456789-      sCompare SZero (SSucc _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sCompare (SSucc _s_z_0123456789) SZero-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-    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 family Equals_0123456789 (a :: U) (b :: U) :: Bool where-      Equals_0123456789 BOOL BOOL = TrueSym0-      Equals_0123456789 STRING STRING = TrueSym0-      Equals_0123456789 NAT NAT = TrueSym0-      Equals_0123456789 (VEC a a) (VEC b b) = (:&&) ((:==) a b) ((:==) a b)-      Equals_0123456789 (a :: U) (b :: U) = FalseSym0-    instance PEq (Proxy :: Proxy U) where-      type (:==) (a :: U) (b :: U) = Equals_0123456789 a b-    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. KindOf (Apply (VECSym1 l) arg) ~ KindOf (VECSym2 l arg) =>-        VECSym1KindInference-    type instance Apply (VECSym1 l) l = VECSym2 l l-    instance SuppressUnusedWarnings VECSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) VECSym0KindInference GHC.Tuple.())-    data VECSym0 (l :: TyFun U (TyFun Nat U -> Type))-      = forall arg. KindOf (Apply VECSym0 arg) ~ KindOf (VECSym1 arg) =>-        VECSym0KindInference-    type instance Apply VECSym0 l = VECSym1 l-    type family Equals_0123456789 (a :: AChar)-                                  (b :: AChar) :: Bool where-      Equals_0123456789 CA CA = TrueSym0-      Equals_0123456789 CB CB = TrueSym0-      Equals_0123456789 CC CC = TrueSym0-      Equals_0123456789 CD CD = TrueSym0-      Equals_0123456789 CE CE = TrueSym0-      Equals_0123456789 CF CF = TrueSym0-      Equals_0123456789 CG CG = TrueSym0-      Equals_0123456789 CH CH = TrueSym0-      Equals_0123456789 CI CI = TrueSym0-      Equals_0123456789 CJ CJ = TrueSym0-      Equals_0123456789 CK CK = TrueSym0-      Equals_0123456789 CL CL = TrueSym0-      Equals_0123456789 CM CM = TrueSym0-      Equals_0123456789 CN CN = TrueSym0-      Equals_0123456789 CO CO = TrueSym0-      Equals_0123456789 CP CP = TrueSym0-      Equals_0123456789 CQ CQ = TrueSym0-      Equals_0123456789 CR CR = TrueSym0-      Equals_0123456789 CS CS = TrueSym0-      Equals_0123456789 CT CT = TrueSym0-      Equals_0123456789 CU CU = TrueSym0-      Equals_0123456789 CV CV = TrueSym0-      Equals_0123456789 CW CW = TrueSym0-      Equals_0123456789 CX CX = TrueSym0-      Equals_0123456789 CY CY = TrueSym0-      Equals_0123456789 CZ CZ = TrueSym0-      Equals_0123456789 (a :: AChar) (b :: AChar) = FalseSym0-    instance PEq (Proxy :: Proxy AChar) where-      type (:==) (a :: AChar) (b :: AChar) = Equals_0123456789 a b-    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. KindOf (Apply (AttrSym1 l) arg) ~ KindOf (AttrSym2 l arg) =>-        AttrSym1KindInference-    type instance Apply (AttrSym1 l) l = AttrSym2 l l-    instance SuppressUnusedWarnings AttrSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) AttrSym0KindInference GHC.Tuple.())-    data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type))-      = forall arg. KindOf (Apply AttrSym0 arg) ~ KindOf (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. KindOf (Apply SchSym0 arg) ~ KindOf (SchSym1 arg) =>-        SchSym0KindInference-    type instance Apply SchSym0 l = SchSym1 l-    type Let0123456789Scrutinee_0123456789Sym4 t t t t =-        Let0123456789Scrutinee_0123456789 t t t t-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym3KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym4 l l l arg) =>-        Let0123456789Scrutinee_0123456789Sym3KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) l = Let0123456789Scrutinee_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) =>-        Let0123456789Scrutinee_0123456789Sym2KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) =>-        Let0123456789Scrutinee_0123456789Sym1KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) =>-        Let0123456789Scrutinee_0123456789Sym0KindInference-    type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l-    type family Let0123456789Scrutinee_0123456789 name-                                                  name'-                                                  u-                                                  attrs where-      Let0123456789Scrutinee_0123456789 name name' u attrs = Apply (Apply (:==$) name) name'-    type family Case_0123456789 name name' u attrs t where-      Case_0123456789 name name' u attrs True = u-      Case_0123456789 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. KindOf (Apply (LookupSym1 l) arg) ~ KindOf (LookupSym2 l arg) =>-        LookupSym1KindInference-    type instance Apply (LookupSym1 l) l = LookupSym2 l l-    instance SuppressUnusedWarnings LookupSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LookupSym0KindInference GHC.Tuple.())-    data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type))-      = forall arg. KindOf (Apply LookupSym0 arg) ~ KindOf (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. KindOf (Apply (OccursSym1 l) arg) ~ KindOf (OccursSym2 l arg) =>-        OccursSym1KindInference-    type instance Apply (OccursSym1 l) l = OccursSym2 l l-    instance SuppressUnusedWarnings OccursSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) OccursSym0KindInference GHC.Tuple.())-    data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type))-      = forall arg. KindOf (Apply OccursSym0 arg) ~ KindOf (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. KindOf (Apply (AttrNotInSym1 l) arg) ~ KindOf (AttrNotInSym2 l arg) =>-        AttrNotInSym1KindInference-    type instance Apply (AttrNotInSym1 l) l = AttrNotInSym2 l l-    instance SuppressUnusedWarnings AttrNotInSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) AttrNotInSym0KindInference GHC.Tuple.())-    data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool-                                              -> Type))-      = forall arg. KindOf (Apply AttrNotInSym0 arg) ~ KindOf (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. KindOf (Apply (DisjointSym1 l) arg) ~ KindOf (DisjointSym2 l arg) =>-        DisjointSym1KindInference-    type instance Apply (DisjointSym1 l) l = DisjointSym2 l l-    instance SuppressUnusedWarnings DisjointSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) DisjointSym0KindInference GHC.Tuple.())-    data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type))-      = forall arg. KindOf (Apply DisjointSym0 arg) ~ KindOf (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. KindOf (Apply (AppendSym1 l) arg) ~ KindOf (AppendSym2 l arg) =>-        AppendSym1KindInference-    type instance Apply (AppendSym1 l) l = AppendSym2 l l-    instance SuppressUnusedWarnings AppendSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) AppendSym0KindInference GHC.Tuple.())-    data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type))-      = forall arg. KindOf (Apply AppendSym0 arg) ~ KindOf (AppendSym1 arg) =>-        AppendSym0KindInference-    type instance Apply AppendSym0 l = AppendSym1 l-    type family Lookup (a :: [AChar]) (a :: Schema) :: U where-      Lookup _z_0123456789 (Sch '[]) = Any-      Lookup name (Sch ((:) (Attr name' u) attrs)) = Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs)-    type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where-      Occurs _z_0123456789 (Sch '[]) = FalseSym0-      Occurs name (Sch ((:) (Attr name' _z_0123456789) attrs)) = Apply (Apply (:||$) (Apply (Apply (:==$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs))-    type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where-      AttrNotIn _z_0123456789 (Sch '[]) = TrueSym0-      AttrNotIn (Attr name u) (Sch ((:) (Attr name' _z_0123456789) 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 '[]) _z_0123456789 = 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)-    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 _s_z_0123456789 (SSch SNil)-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) =>-            Sing _z_0123456789 -> Sing (Apply (Apply LookupSym0 t) t :: U)-          lambda _z_0123456789 = undefined-        in lambda _s_z_0123456789-    sLookup sName (SSch (SCons (SAttr sName' sU) sAttrs))-      = let-          lambda ::-            forall name name' u attrs.-            (t ~ name,-             t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') u)) attrs)) =>-            Sing name-            -> Sing name'-               -> Sing u -> Sing attrs -> Sing (Apply (Apply LookupSym0 t) t :: U)-          lambda name name' u attrs-            = let-                sScrutinee_0123456789 ::-                  Sing (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs)-                sScrutinee_0123456789-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) name) name'-              in  case sScrutinee_0123456789 of {-                    STrue-                      -> let-                           lambda ::-                             TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs =>-                             Sing (Case_0123456789 name name' u attrs TrueSym0 :: U)-                           lambda = u-                         in lambda-                    SFalse-                      -> let-                           lambda ::-                             FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs =>-                             Sing (Case_0123456789 name name' u attrs FalseSym0 :: U)-                           lambda-                             = applySing-                                 (applySing (singFun2 (Proxy :: Proxy LookupSym0) sLookup) name)-                                 (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) attrs)-                         in lambda } ::-                    Sing (Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs) :: U)-        in lambda sName sName' sU sAttrs-    sOccurs _s_z_0123456789 (SSch SNil)-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) =>-            Sing _z_0123456789 -> Sing (Apply (Apply OccursSym0 t) t :: Bool)-          lambda _z_0123456789 = SFalse-        in lambda _s_z_0123456789-    sOccurs sName (SSch (SCons (SAttr sName' _s_z_0123456789) sAttrs))-      = let-          lambda ::-            forall name name' _z_0123456789 attrs.-            (t ~ name,-             t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) attrs)) =>-            Sing name-            -> Sing name'-               -> Sing _z_0123456789-                  -> Sing attrs -> Sing (Apply (Apply OccursSym0 t) t :: Bool)-          lambda name name' _z_0123456789 attrs-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:||$)) (%:||))-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) name) name'))-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy OccursSym0) sOccurs) name)-                   (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) attrs))-        in lambda sName sName' _s_z_0123456789 sAttrs-    sAttrNotIn _s_z_0123456789 (SSch SNil)-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) =>-            Sing _z_0123456789-            -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool)-          lambda _z_0123456789 = STrue-        in lambda _s_z_0123456789-    sAttrNotIn-      (SAttr sName sU)-      (SSch (SCons (SAttr sName' _s_z_0123456789) sT))-      = let-          lambda ::-            forall name u name' _z_0123456789 t.-            (t ~ Apply (Apply AttrSym0 name) u,-             t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) t)) =>-            Sing name-            -> Sing u-               -> Sing name'-                  -> Sing _z_0123456789-                     -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool)-          lambda name u name' _z_0123456789 t-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:&&$)) (%:&&))-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:/=$)) (%:/=)) name) name'))-                (applySing-                   (applySing-                      (singFun2 (Proxy :: Proxy AttrNotInSym0) sAttrNotIn)-                      (applySing-                         (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) name) u))-                   (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) t))-        in lambda sName sU sName' _s_z_0123456789 sT-    sDisjoint (SSch SNil) _s_z_0123456789-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ Apply SchSym0 '[], t ~ _z_0123456789) =>-            Sing _z_0123456789 -> Sing (Apply (Apply DisjointSym0 t) t :: Bool)-          lambda _z_0123456789 = STrue-        in lambda _s_z_0123456789-    sDisjoint (SSch (SCons sH sT)) sS-      = let-          lambda ::-            forall h t s.-            (t ~ Apply SchSym0 (Apply (Apply (:$) h) t), t ~ s) =>-            Sing h-            -> Sing t-               -> Sing s -> Sing (Apply (Apply DisjointSym0 t) t :: Bool)-          lambda h t s-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:&&$)) (%:&&))-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy AttrNotInSym0) sAttrNotIn) h)-                      s))-                (applySing-                   (applySing-                      (singFun2 (Proxy :: Proxy DisjointSym0) sDisjoint)-                      (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) t))-                   s)-        in lambda sH sT sS-    sAppend (SSch sS1) (SSch sS2)-      = let-          lambda ::-            forall s1 s2.-            (t ~ Apply SchSym0 s1, t ~ Apply SchSym0 s2) =>-            Sing s1 -> Sing s2 -> Sing (Apply (Apply AppendSym0 t) t :: Schema)-          lambda s1 s2-            = applySing-                (singFun1 (Proxy :: Proxy SchSym0) SSch)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:++$)) (%:++)) s1) s2)-        in lambda sS1 sS2-    data instance Sing (z :: U)-      = z ~ BOOL => SBOOL |-        z ~ STRING => SSTRING |-        z ~ NAT => SNAT |-        forall (n :: U) (n :: Nat). z ~ VEC n n =>-        SVEC (Sing (n :: U)) (Sing (n :: Nat))-    type SU = (Sing :: U -> Type)-    instance SingKind U where-      type DemoteRep 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 b)-        = case-              GHC.Tuple.(,) (toSing b :: SomeSing U) (toSing b :: SomeSing Nat)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SVEC c c) }-    instance 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 where-      (%~) SBOOL SBOOL = Proved Refl-      (%~) SBOOL SSTRING-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SBOOL SNAT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SBOOL (SVEC _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SSTRING SBOOL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SSTRING SSTRING = Proved Refl-      (%~) SSTRING SNAT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SSTRING (SVEC _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNAT SBOOL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNAT SSTRING-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNAT SNAT = Proved Refl-      (%~) SNAT (SVEC _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVEC _ _) SBOOL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVEC _ _) SSTRING-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVEC _ _) SNAT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 }) }-    data instance Sing (z :: AChar)-      = z ~ CA => SCA |-        z ~ CB => SCB |-        z ~ CC => SCC |-        z ~ CD => SCD |-        z ~ CE => SCE |-        z ~ CF => SCF |-        z ~ CG => SCG |-        z ~ CH => SCH |-        z ~ CI => SCI |-        z ~ CJ => SCJ |-        z ~ CK => SCK |-        z ~ CL => SCL |-        z ~ CM => SCM |-        z ~ CN => SCN |-        z ~ CO => SCO |-        z ~ CP => SCP |-        z ~ CQ => SCQ |-        z ~ CR => SCR |-        z ~ CS => SCS |-        z ~ CT => SCT |-        z ~ CU => SCU |-        z ~ CV => SCV |-        z ~ CW => SCW |-        z ~ CX => SCX |-        z ~ CY => SCY |-        z ~ CZ => SCZ-    type SAChar = (Sing :: AChar -> Type)-    instance SingKind AChar where-      type DemoteRep 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-    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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCA SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCB = Proved Refl-      (%~) SCB SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCB SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCC = Proved Refl-      (%~) SCC SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCC SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCD = Proved Refl-      (%~) SCD SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCD SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCE = Proved Refl-      (%~) SCE SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCE SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCF = Proved Refl-      (%~) SCF SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCF SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCG = Proved Refl-      (%~) SCG SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCG SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCH = Proved Refl-      (%~) SCH SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCH SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCI = Proved Refl-      (%~) SCI SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCI SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCJ = Proved Refl-      (%~) SCJ SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCJ SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCK = Proved Refl-      (%~) SCK SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCK SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCL = Proved Refl-      (%~) SCL SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCL SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCM = Proved Refl-      (%~) SCM SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCM SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCN = Proved Refl-      (%~) SCN SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCN SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCO = Proved Refl-      (%~) SCO SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCO SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCP = Proved Refl-      (%~) SCP SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCP SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCQ = Proved Refl-      (%~) SCQ SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCQ SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCR = Proved Refl-      (%~) SCR SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCR SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCS = Proved Refl-      (%~) SCS SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCS SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCT = Proved Refl-      (%~) SCT SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCT SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCU = Proved Refl-      (%~) SCU SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCU SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCV = Proved Refl-      (%~) SCV SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCV SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCW = Proved Refl-      (%~) SCW SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCW SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCX = Proved Refl-      (%~) SCX SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCX SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCY SCY = Proved Refl-      (%~) SCY SCZ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCA-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCB-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCC-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCD-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCE-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCF-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCG-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCH-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCI-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCJ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCK-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCL-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCM-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCN-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCO-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCP-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCQ-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCR-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCS-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCT-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCU-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCV-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCW-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCX-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCY-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SCZ SCZ = Proved Refl-    data instance Sing (z :: Attribute)-      = forall (n :: [AChar]) (n :: U). z ~ Attr n n =>-        SAttr (Sing (n :: [AChar])) (Sing (n :: U))-    type SAttribute = (Sing :: Attribute -> Type)-    instance SingKind Attribute where-      type DemoteRep Attribute = Attribute-      fromSing (SAttr b b) = Attr (fromSing b) (fromSing b)-      toSing (Attr b b)-        = 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)-      = forall (n :: [Attribute]). z ~ Sch n =>-        SSch (Sing (n :: [Attribute]))-    type SSchema = (Sing :: Schema -> Type)-    instance SingKind Schema where-      type DemoteRep Schema = Schema-      fromSing (SSch b) = Sch (fromSing b)-      toSing (Sch b)-        = case toSing b :: SomeSing [Attribute] of {-            SomeSing c -> SomeSing (SSch c) }-    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,557 +0,0 @@-{- Database.hs--(c) Richard Eisenberg 2012-eir@cis.upenn.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, CPP, InstanceSigs #-}-{-# OPTIONS_GHC -fno-warn-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.SuppressUnusedWarnings-import Data.Singletons.TH-import Control.Monad-import Data.List hiding ( tail )-import Data.Kind--#ifdef MODERN_MTL-import Control.Monad.Except  ( throwError )-#else-import Control.Monad.Error   ( throwError )-#endif---$(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 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 :: * -> Nat -> * 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 -> * 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 -> * 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 -> * where-  InElt :: InProof attr (Sch (attr ': schTail))-  InTail :: InProof attr (Sch attrs) -> InProof attr (Sch (a ': attrs))--data SubsetProof :: Schema -> Schema -> * 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 -> * 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 -> * 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 -> * 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 -> * 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.ghc80.template 
@@ -1,162 +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 (Proxy :: Proxy (:$)) SCons) SCM)-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA)-             (applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCJ)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCO)-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) SNil))))-    sGradeName-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCG)-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR)-             (applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCD)-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCE) SNil))))-    sYearName-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCY)-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCE)-             (applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) SNil)))-    sFirstName-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCF)-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCI)-             (applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCS)-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCT) SNil))))-    sLastName-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCL)-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA)-             (applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCS)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCT) SNil)))-    sGradingSchema-      = applySing-          (singFun1 (Proxy :: Proxy SchSym0) SSch)-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sLastName)-                   SSTRING))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sFirstName)-                      SSTRING))-                (applySing-                   (applySing-                      (singFun2 (Proxy :: Proxy (:$)) SCons)-                      (applySing-                         (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sYearName)-                         SNAT))-                   (applySing-                      (applySing-                         (singFun2 (Proxy :: Proxy (:$)) SCons)-                         (applySing-                            (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sGradeName)-                            SNAT))-                      (applySing-                         (applySing-                            (singFun2 (Proxy :: Proxy (:$)) SCons)-                            (applySing-                               (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sMajorName)-                               SBOOL))-                         SNil)))))-    sNames-      = applySing-          (singFun1 (Proxy :: Proxy SchSym0) SSch)-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sFirstName)-                   SSTRING))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sLastName)-                      SSTRING))-                SNil))
− tests/compile-and-dump/GradingClient/Main.hs 
@@ -1,54 +0,0 @@-{- GradingClient.hs--(c) Richard Eisenberg 2012-eir@cis.upenn.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.ghc80.template 
@@ -1,240 +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. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = SuccSym1 l-    data instance Sing (z :: Nat)-      = z ~ Zero => SZero |-        forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat))-    type SNat = (Sing :: Nat -> GHC.Types.Type)-    instance SingKind Nat where-      type DemoteRep Nat = Nat-      fromSing SZero = Zero-      fromSing (SSucc b) = Succ (fromSing b)-      toSing Zero = SomeSing SZero-      toSing (Succ b)-        = 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 Let0123456789Scrutinee_0123456789Sym3 t t t =-        Let0123456789Scrutinee_0123456789 t t t-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) =>-        Let0123456789Scrutinee_0123456789Sym2KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) =>-        Let0123456789Scrutinee_0123456789Sym1KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) =>-        Let0123456789Scrutinee_0123456789Sym0KindInference-    type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l-    type family Let0123456789Scrutinee_0123456789 n h t where-      Let0123456789Scrutinee_0123456789 n h t = Apply (Apply LeqSym0 n) h-    type family Case_0123456789 n h t t where-      Case_0123456789 n h t True = Apply (Apply (:$) n) (Apply (Apply (:$) h) t)-      Case_0123456789 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. KindOf (Apply (LeqSym1 l) arg) ~ KindOf (LeqSym2 l arg) =>-        LeqSym1KindInference-    type instance Apply (LeqSym1 l) l = LeqSym2 l l-    instance SuppressUnusedWarnings LeqSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LeqSym0KindInference GHC.Tuple.())-    data LeqSym0 (l :: TyFun Nat (TyFun Nat Bool -> GHC.Types.Type))-      = forall arg. KindOf (Apply LeqSym0 arg) ~ KindOf (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. KindOf (Apply (InsertSym1 l) arg) ~ KindOf (InsertSym2 l arg) =>-        InsertSym1KindInference-    type instance Apply (InsertSym1 l) l = InsertSym2 l l-    instance SuppressUnusedWarnings InsertSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) InsertSym0KindInference GHC.Tuple.())-    data InsertSym0 (l :: TyFun Nat (TyFun [Nat] [Nat]-                                     -> GHC.Types.Type))-      = forall arg. KindOf (Apply InsertSym0 arg) ~ KindOf (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. KindOf (Apply InsertionSortSym0 arg) ~ KindOf (InsertionSortSym1 arg) =>-        InsertionSortSym0KindInference-    type instance Apply InsertionSortSym0 l = InsertionSortSym1 l-    type family Leq (a :: Nat) (a :: Nat) :: Bool where-      Leq Zero _z_0123456789 = TrueSym0-      Leq (Succ _z_0123456789) 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_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 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 _s_z_0123456789-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ ZeroSym0, t ~ _z_0123456789) =>-            Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool)-          lambda _z_0123456789 = STrue-        in lambda _s_z_0123456789-    sLeq (SSucc _s_z_0123456789) SZero-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) =>-            Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool)-          lambda _z_0123456789 = SFalse-        in lambda _s_z_0123456789-    sLeq (SSucc sA) (SSucc sB)-      = let-          lambda ::-            forall a b.-            (t ~ Apply SuccSym0 a, t ~ Apply SuccSym0 b) =>-            Sing a -> Sing b -> Sing (Apply (Apply LeqSym0 t) t :: Bool)-          lambda a b-            = applySing-                (applySing (singFun2 (Proxy :: Proxy LeqSym0) sLeq) a) b-        in lambda sA sB-    sInsert sN SNil-      = let-          lambda ::-            forall n.-            (t ~ n, t ~ '[]) =>-            Sing n -> Sing (Apply (Apply InsertSym0 t) t :: [Nat])-          lambda n-            = applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n) SNil-        in lambda sN-    sInsert sN (SCons sH sT)-      = let-          lambda ::-            forall n h t.-            (t ~ n, t ~ Apply (Apply (:$) h) t) =>-            Sing n-            -> Sing h -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat])-          lambda n h t-            = let-                sScrutinee_0123456789 ::-                  Sing (Let0123456789Scrutinee_0123456789Sym3 n h t)-                sScrutinee_0123456789-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy LeqSym0) sLeq) n) h-              in  case sScrutinee_0123456789 of {-                    STrue-                      -> let-                           lambda ::-                             TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t =>-                             Sing (Case_0123456789 n h t TrueSym0 :: [Nat])-                           lambda-                             = applySing-                                 (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n)-                                 (applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) h) t)-                         in lambda-                    SFalse-                      -> let-                           lambda ::-                             FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t =>-                             Sing (Case_0123456789 n h t FalseSym0 :: [Nat])-                           lambda-                             = applySing-                                 (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) h)-                                 (applySing-                                    (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) n) t)-                         in lambda } ::-                    Sing (Case_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 n h t) :: [Nat])-        in lambda sN sH sT-    sInsertionSort SNil-      = let-          lambda :: t ~ '[] => Sing (Apply InsertionSortSym0 t :: [Nat])-          lambda = SNil-        in lambda-    sInsertionSort (SCons sH sT)-      = let-          lambda ::-            forall h t.-            t ~ Apply (Apply (:$) h) t =>-            Sing h -> Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat])-          lambda h t-            = applySing-                (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) h)-                (applySing-                   (singFun1 (Proxy :: Proxy InsertionSortSym0) sInsertionSort) t)-        in lambda sH sT
− tests/compile-and-dump/InsertionSort/InsertionSortImp.hs 
@@ -1,205 +0,0 @@-{- InsertionSortImp.hs--(c) Richard Eisenberg 2012-eir@cis.upenn.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] -> * 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.ghc80.template 
@@ -1,82 +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. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) 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. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) 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. KindOf (Apply (BarSym4 l l l l) arg) ~ KindOf (BarSym5 l l l l arg) =>-        BarSym4KindInference-    type instance Apply (BarSym4 l l l l) l = BarSym5 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. KindOf (Apply (BarSym3 l l l) arg) ~ KindOf (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. KindOf (Apply (BarSym2 l l) arg) ~ KindOf (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. KindOf (Apply (BarSym1 l) arg) ~ KindOf (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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 l
− tests/compile-and-dump/Promote/Constructors.hs 
@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fno-warn-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.ghc80.template 
@@ -1,47 +0,0 @@-Promote/GenDefunSymbols.hs:0:0:: Splicing declarations-    genDefunSymbols [''LiftMaybe, ''NatT, '':+]-  ======>-    type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789 -> Type)-                       (t :: Maybe a0123456789) =-        LiftMaybe t t-    instance SuppressUnusedWarnings LiftMaybeSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.())-    data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789 -> Type)-                       (l :: TyFun (Maybe a0123456789) (Maybe b0123456789))-      = forall arg. Data.Singletons.KindOf (Apply (LiftMaybeSym1 l) arg) ~ Data.Singletons.KindOf (LiftMaybeSym2 l arg) =>-        LiftMaybeSym1KindInference-    type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l-    instance SuppressUnusedWarnings LiftMaybeSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.())-    data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789-                                    -> Type) (TyFun (Maybe a0123456789) (Maybe b0123456789)-                                              -> Type))-      = forall arg. Data.Singletons.KindOf (Apply LiftMaybeSym0 arg) ~ Data.Singletons.KindOf (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.KindOf (Apply SuccSym0 arg) ~ Data.Singletons.KindOf (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = SuccSym1 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.KindOf (Apply ((:+$$) l) arg) ~ Data.Singletons.KindOf ((:+$$$) l arg) =>-        (:+$$###)-    type instance Apply ((:+$$) l) l = (:+$$$) l l-    instance SuppressUnusedWarnings (:+$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.())-    data (:+$) l-      = forall arg. Data.Singletons.KindOf (Apply (:+$) arg) ~ Data.Singletons.KindOf ((:+$$) arg) =>-        (:+$###)-    type instance Apply (:+$) l = (:+$$) l
− tests/compile-and-dump/Promote/GenDefunSymbols.hs 
@@ -1,19 +0,0 @@-{-# OPTIONS_GHC -fno-warn-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.ghc80.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 UnBarSym1 (t :: Bar) = UnBar t-    instance SuppressUnusedWarnings UnBarSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) UnBarSym0KindInference GHC.Tuple.())-    data UnBarSym0 (l :: TyFun Bar Nat)-      = forall arg. KindOf (Apply UnBarSym0 arg) ~ KindOf (UnBarSym1 arg) =>-        UnBarSym0KindInference-    type instance Apply UnBarSym0 l = UnBarSym1 l-    type family UnBar (a :: Bar) :: Nat where-      UnBar (Bar field) = field-    type family Equals_0123456789 (a :: Foo) (b :: Foo) :: Bool where-      Equals_0123456789 (Foo a) (Foo b) = (:==) a b-      Equals_0123456789 (a :: Foo) (b :: Foo) = FalseSym0-    instance PEq (Proxy :: Proxy Foo) where-      type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789 a b-    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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 l
− tests/compile-and-dump/Promote/Newtypes.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -fno-warn-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.ghc80.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.ghc80.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.KindOf (Apply OddSym0 arg) ~ Data.Singletons.KindOf (OddSym1 arg) =>-        OddSym0KindInference-    type instance Apply OddSym0 l = OddSym1 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,133 +0,0 @@-module Promote.Prelude where--import Data.Promotion.TH-import Data.Promotion.Prelude-import Data.Promotion.Prelude.List-import Data.Proxy-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/Singletons/AsPattern.ghc80.template 
@@ -1,387 +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. KindOf (Apply (BazSym2 l l) arg) ~ KindOf (BazSym3 l l arg) =>-        BazSym2KindInference-    type instance Apply (BazSym2 l l) l = BazSym3 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. KindOf (Apply (BazSym1 l) arg) ~ KindOf (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. KindOf (Apply BazSym0 arg) ~ KindOf (BazSym1 arg) =>-        BazSym0KindInference-    type instance Apply BazSym0 l = BazSym1 l-    type Let0123456789PSym0 = Let0123456789P-    type family Let0123456789P where-      Let0123456789P = '[]-    type Let0123456789PSym1 t = Let0123456789P t-    instance SuppressUnusedWarnings Let0123456789PSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.())-    data Let0123456789PSym0 l-      = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) =>-        Let0123456789PSym0KindInference-    type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l-    type family Let0123456789P wild_0123456789 where-      Let0123456789P wild_0123456789 = Apply (Apply (:$) wild_0123456789) '[]-    type Let0123456789PSym3 t t t = Let0123456789P t t t-    instance SuppressUnusedWarnings Let0123456789PSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym2KindInference GHC.Tuple.())-    data Let0123456789PSym2 l l l-      = forall arg. KindOf (Apply (Let0123456789PSym2 l l) arg) ~ KindOf (Let0123456789PSym3 l l arg) =>-        Let0123456789PSym2KindInference-    type instance Apply (Let0123456789PSym2 l l) l = Let0123456789PSym3 l l l-    instance SuppressUnusedWarnings Let0123456789PSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.())-    data Let0123456789PSym1 l l-      = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) =>-        Let0123456789PSym1KindInference-    type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l-    instance SuppressUnusedWarnings Let0123456789PSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.())-    data Let0123456789PSym0 l-      = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) =>-        Let0123456789PSym0KindInference-    type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l-    type family Let0123456789P wild_0123456789-                               wild_0123456789-                               wild_0123456789 where-      Let0123456789P wild_0123456789 wild_0123456789 wild_0123456789 = Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789)-    type Let0123456789PSym2 t t = Let0123456789P t t-    instance SuppressUnusedWarnings Let0123456789PSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.())-    data Let0123456789PSym1 l l-      = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) =>-        Let0123456789PSym1KindInference-    type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l-    instance SuppressUnusedWarnings Let0123456789PSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.())-    data Let0123456789PSym0 l-      = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) =>-        Let0123456789PSym0KindInference-    type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l-    type family Let0123456789P wild_0123456789 wild_0123456789 where-      Let0123456789P wild_0123456789 wild_0123456789 = Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789-    type Let0123456789PSym0 = Let0123456789P-    type family Let0123456789P where-      Let0123456789P = NothingSym0-    type Let0123456789PSym3 t t t = Let0123456789P t t t-    instance SuppressUnusedWarnings Let0123456789PSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym2KindInference GHC.Tuple.())-    data Let0123456789PSym2 l l l-      = forall arg. KindOf (Apply (Let0123456789PSym2 l l) arg) ~ KindOf (Let0123456789PSym3 l l arg) =>-        Let0123456789PSym2KindInference-    type instance Apply (Let0123456789PSym2 l l) l = Let0123456789PSym3 l l l-    instance SuppressUnusedWarnings Let0123456789PSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.())-    data Let0123456789PSym1 l l-      = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) =>-        Let0123456789PSym1KindInference-    type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l-    instance SuppressUnusedWarnings Let0123456789PSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.())-    data Let0123456789PSym0 l-      = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) =>-        Let0123456789PSym0KindInference-    type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l-    type family Let0123456789P wild_0123456789-                               wild_0123456789-                               wild_0123456789 where-      Let0123456789P wild_0123456789 wild_0123456789 wild_0123456789 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789)-    type Let0123456789XSym1 t = Let0123456789X t-    instance SuppressUnusedWarnings Let0123456789XSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789XSym0KindInference GHC.Tuple.())-    data Let0123456789XSym0 l-      = forall arg. KindOf (Apply Let0123456789XSym0 arg) ~ KindOf (Let0123456789XSym1 arg) =>-        Let0123456789XSym0KindInference-    type instance Apply Let0123456789XSym0 l = Let0123456789XSym1 l-    type family Let0123456789X wild_0123456789 where-      Let0123456789X wild_0123456789 = Apply JustSym0 wild_0123456789-    type Let0123456789PSym0 = Let0123456789P-    type family Let0123456789P where-      Let0123456789P = 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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 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. KindOf (Apply TupSym0 arg) ~ KindOf (TupSym1 arg) =>-        TupSym0KindInference-    type instance Apply TupSym0 l = TupSym1 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. KindOf (Apply Baz_Sym0 arg) ~ KindOf (Baz_Sym1 arg) =>-        Baz_Sym0KindInference-    type instance Apply Baz_Sym0 l = Baz_Sym1 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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 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. KindOf (Apply MaybePlusSym0 arg) ~ KindOf (MaybePlusSym1 arg) =>-        MaybePlusSym0KindInference-    type instance Apply MaybePlusSym0 l = MaybePlusSym1 l-    type family Foo (a :: [Nat]) :: [Nat] where-      Foo '[] = Let0123456789PSym0-      Foo '[wild_0123456789] = Let0123456789PSym1 wild_0123456789-      Foo ((:) wild_0123456789 ((:) wild_0123456789 wild_0123456789)) = Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789-    type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where-      Tup '(wild_0123456789,-            wild_0123456789) = Let0123456789PSym2 wild_0123456789 wild_0123456789-    type family Baz_ (a :: Maybe Baz) :: Maybe Baz where-      Baz_ Nothing = Let0123456789PSym0-      Baz_ (Just (Baz wild_0123456789 wild_0123456789 wild_0123456789)) = Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789-    type family Bar (a :: Maybe Nat) :: Maybe Nat where-      Bar (Just wild_0123456789) = Let0123456789XSym1 wild_0123456789-      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 = Let0123456789PSym0-    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-          lambda :: t ~ '[] => Sing (Apply FooSym0 t :: [Nat])-          lambda-            = let-                sP :: Sing Let0123456789PSym0-                sP = SNil-              in sP-        in lambda-    sFoo (SCons sWild_0123456789 SNil)-      = let-          lambda ::-            forall wild_0123456789.-            t ~ Apply (Apply (:$) wild_0123456789) '[] =>-            Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat])-          lambda wild_0123456789-            = let-                sP :: Sing (Let0123456789PSym1 wild_0123456789)-                sP-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789)-                      SNil-              in sP-        in lambda sWild_0123456789-    sFoo-      (SCons sWild_0123456789 (SCons sWild_0123456789 sWild_0123456789))-      = let-          lambda ::-            forall wild_0123456789 wild_0123456789 wild_0123456789.-            t ~ Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789) =>-            Sing wild_0123456789-            -> Sing wild_0123456789-               -> Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat])-          lambda wild_0123456789 wild_0123456789 wild_0123456789-            = let-                sP ::-                  Sing (Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789)-                sP-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789)-                      (applySing-                         (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789)-                         wild_0123456789)-              in sP-        in lambda sWild_0123456789 sWild_0123456789 sWild_0123456789-    sTup (STuple2 sWild_0123456789 sWild_0123456789)-      = let-          lambda ::-            forall wild_0123456789 wild_0123456789.-            t ~ Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789 =>-            Sing wild_0123456789-            -> Sing wild_0123456789 -> Sing (Apply TupSym0 t :: (Nat, Nat))-          lambda wild_0123456789 wild_0123456789-            = let-                sP :: Sing (Let0123456789PSym2 wild_0123456789 wild_0123456789)-                sP-                  = applySing-                      (applySing-                         (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) wild_0123456789)-                      wild_0123456789-              in sP-        in lambda sWild_0123456789 sWild_0123456789-    sBaz_ SNothing-      = let-          lambda :: t ~ NothingSym0 => Sing (Apply Baz_Sym0 t :: Maybe Baz)-          lambda-            = let-                sP :: Sing Let0123456789PSym0-                sP = SNothing-              in sP-        in lambda-    sBaz_-      (SJust (SBaz sWild_0123456789 sWild_0123456789 sWild_0123456789))-      = let-          lambda ::-            forall wild_0123456789 wild_0123456789 wild_0123456789.-            t ~ Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789) =>-            Sing wild_0123456789-            -> Sing wild_0123456789-               -> Sing wild_0123456789 -> Sing (Apply Baz_Sym0 t :: Maybe Baz)-          lambda wild_0123456789 wild_0123456789 wild_0123456789-            = let-                sP ::-                  Sing (Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789)-                sP-                  = applySing-                      (singFun1 (Proxy :: Proxy JustSym0) SJust)-                      (applySing-                         (applySing-                            (applySing-                               (singFun3 (Proxy :: Proxy BazSym0) SBaz) wild_0123456789)-                            wild_0123456789)-                         wild_0123456789)-              in sP-        in lambda sWild_0123456789 sWild_0123456789 sWild_0123456789-    sBar (SJust sWild_0123456789)-      = let-          lambda ::-            forall wild_0123456789.-            t ~ Apply JustSym0 wild_0123456789 =>-            Sing wild_0123456789 -> Sing (Apply BarSym0 t :: Maybe Nat)-          lambda wild_0123456789-            = let-                sX :: Sing (Let0123456789XSym1 wild_0123456789)-                sX-                  = applySing-                      (singFun1 (Proxy :: Proxy JustSym0) SJust) wild_0123456789-              in sX-        in lambda sWild_0123456789-    sBar SNothing-      = let-          lambda :: t ~ NothingSym0 => Sing (Apply BarSym0 t :: Maybe Nat)-          lambda = SNothing-        in lambda-    sMaybePlus (SJust sN)-      = let-          lambda ::-            forall n.-            t ~ Apply JustSym0 n =>-            Sing n -> Sing (Apply MaybePlusSym0 t :: Maybe Nat)-          lambda n-            = applySing-                (singFun1 (Proxy :: Proxy JustSym0) SJust)-                (applySing-                   (applySing-                      (singFun2 (Proxy :: Proxy PlusSym0) sPlus)-                      (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                   n)-        in lambda sN-    sMaybePlus SNothing-      = let-          lambda ::-            t ~ NothingSym0 => Sing (Apply MaybePlusSym0 t :: Maybe Nat)-          lambda-            = let-                sP :: Sing Let0123456789PSym0-                sP = SNothing-              in sP-        in lambda-    data instance Sing (z :: Baz)-      = forall (n :: Nat) (n :: Nat) (n :: Nat). z ~ Baz n n n =>-        SBaz (Sing (n :: Nat)) (Sing (n :: Nat)) (Sing (n :: Nat))-    type SBaz = (Sing :: Baz -> GHC.Types.Type)-    instance SingKind Baz where-      type DemoteRep Baz = Baz-      fromSing (SBaz b b b) = Baz (fromSing b) (fromSing b) (fromSing b)-      toSing (Baz b b b)-        = 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,33 +0,0 @@-module Singletons.AsPattern where--import Data.Proxy-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.ghc80.template 
@@ -1,3 +0,0 @@--Singletons/BadBoundedDeriving.hs:0:0: error:-    Can't derive Bounded instance for Foo_0 a_1.
− tests/compile-and-dump/Singletons/BadBoundedDeriving.hs 
@@ -1,8 +0,0 @@-module Singletons.BadBoundedDeriving where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|-  data Foo a = Foo | Bar a deriving (Bounded)-  |])
− tests/compile-and-dump/Singletons/BadEnumDeriving.ghc80.template 
@@ -1,3 +0,0 @@--Singletons/BadEnumDeriving.hs:0:0: error:-    Can't derive Enum instance for Foo_0 a_1.
− 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.ghc80.template 
@@ -1,259 +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 :: *) (b :: *)-            = 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 :: a0123456789) = Foo3 t-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789 (Foo3 a0123456789))-      = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 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. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = PairSym2 l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.())-    data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type))-      = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) =>-        PairSym0KindInference-    type instance Apply PairSym0 l = PairSym1 l-    type family MinBound_0123456789 :: Foo1 where-      MinBound_0123456789 = Foo1Sym0-    type MinBound_0123456789Sym0 = MinBound_0123456789-    type family MaxBound_0123456789 :: Foo1 where-      MaxBound_0123456789 = Foo1Sym0-    type MaxBound_0123456789Sym0 = MaxBound_0123456789-    instance PBounded (Proxy :: Proxy Foo1) where-      type MinBound = MinBound_0123456789Sym0-      type MaxBound = MaxBound_0123456789Sym0-    type family MinBound_0123456789 :: Foo2 where-      MinBound_0123456789 = ASym0-    type MinBound_0123456789Sym0 = MinBound_0123456789-    type family MaxBound_0123456789 :: Foo2 where-      MaxBound_0123456789 = ESym0-    type MaxBound_0123456789Sym0 = MaxBound_0123456789-    instance PBounded (Proxy :: Proxy Foo2) where-      type MinBound = MinBound_0123456789Sym0-      type MaxBound = MaxBound_0123456789Sym0-    type family MinBound_0123456789 :: Foo3 a where-      MinBound_0123456789 = Apply Foo3Sym0 MinBoundSym0-    type MinBound_0123456789Sym0 = MinBound_0123456789-    type family MaxBound_0123456789 :: Foo3 a where-      MaxBound_0123456789 = Apply Foo3Sym0 MaxBoundSym0-    type MaxBound_0123456789Sym0 = MaxBound_0123456789-    instance PBounded (Proxy :: Proxy (Foo3 a)) where-      type MinBound = MinBound_0123456789Sym0-      type MaxBound = MaxBound_0123456789Sym0-    type family MinBound_0123456789 :: Foo4 a b where-      MinBound_0123456789 = Foo41Sym0-    type MinBound_0123456789Sym0 = MinBound_0123456789-    type family MaxBound_0123456789 :: Foo4 a b where-      MaxBound_0123456789 = Foo42Sym0-    type MaxBound_0123456789Sym0 = MaxBound_0123456789-    instance PBounded (Proxy :: Proxy (Foo4 a b)) where-      type MinBound = MinBound_0123456789Sym0-      type MaxBound = MaxBound_0123456789Sym0-    type family MinBound_0123456789 :: Pair where-      MinBound_0123456789 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0-    type MinBound_0123456789Sym0 = MinBound_0123456789-    type family MaxBound_0123456789 :: Pair where-      MaxBound_0123456789 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0-    type MaxBound_0123456789Sym0 = MaxBound_0123456789-    instance PBounded (Proxy :: Proxy Pair) where-      type MinBound = MinBound_0123456789Sym0-      type MaxBound = MaxBound_0123456789Sym0-    data instance Sing (z :: Foo1) = z ~ Foo1 => SFoo1-    type SFoo1 = (Sing :: Foo1 -> Type)-    instance SingKind Foo1 where-      type DemoteRep Foo1 = Foo1-      fromSing SFoo1 = Foo1-      toSing Foo1 = SomeSing SFoo1-    data instance Sing (z :: Foo2)-      = z ~ A => SA |-        z ~ B => SB |-        z ~ C => SC |-        z ~ D => SD |-        z ~ E => SE-    type SFoo2 = (Sing :: Foo2 -> Type)-    instance SingKind Foo2 where-      type DemoteRep 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)-      = forall (n :: a). z ~ Foo3 n => SFoo3 (Sing (n :: a))-    type SFoo3 = (Sing :: Foo3 a -> Type)-    instance SingKind a => SingKind (Foo3 a) where-      type DemoteRep (Foo3 a) = Foo3 (DemoteRep a)-      fromSing (SFoo3 b) = Foo3 (fromSing b)-      toSing (Foo3 b)-        = case toSing b :: SomeSing a of {-            SomeSing c -> SomeSing (SFoo3 c) }-    data instance Sing (z :: Foo4 a b)-      = z ~ Foo41 => SFoo41 | z ~ Foo42 => SFoo42-    type SFoo4 = (Sing :: Foo4 a b -> Type)-    instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where-      type DemoteRep (Foo4 a b) = Foo4 (DemoteRep a) (DemoteRep b)-      fromSing SFoo41 = Foo41-      fromSing SFoo42 = Foo42-      toSing Foo41 = SomeSing SFoo41-      toSing Foo42 = SomeSing SFoo42-    data instance Sing (z :: Pair)-      = forall (n :: Bool) (n :: Bool). z ~ Pair n n =>-        SPair (Sing (n :: Bool)) (Sing (n :: Bool))-    type SPair = (Sing :: Pair -> Type)-    instance SingKind Pair where-      type DemoteRep Pair = Pair-      fromSing (SPair b b) = Pair (fromSing b) (fromSing b)-      toSing (Pair b b)-        = 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-        = let-            lambda :: Sing (MinBoundSym0 :: Foo1)-            lambda = SFoo1-          in lambda-      sMaxBound-        = let-            lambda :: Sing (MaxBoundSym0 :: Foo1)-            lambda = SFoo1-          in lambda-    instance SBounded Foo2 where-      sMinBound :: Sing (MinBoundSym0 :: Foo2)-      sMaxBound :: Sing (MaxBoundSym0 :: Foo2)-      sMinBound-        = let-            lambda :: Sing (MinBoundSym0 :: Foo2)-            lambda = SA-          in lambda-      sMaxBound-        = let-            lambda :: Sing (MaxBoundSym0 :: Foo2)-            lambda = SE-          in lambda-    instance SBounded a => SBounded (Foo3 a) where-      sMinBound :: Sing (MinBoundSym0 :: Foo3 a)-      sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a)-      sMinBound-        = let-            lambda :: Sing (MinBoundSym0 :: Foo3 a)-            lambda-              = applySing (singFun1 (Proxy :: Proxy Foo3Sym0) SFoo3) sMinBound-          in lambda-      sMaxBound-        = let-            lambda :: Sing (MaxBoundSym0 :: Foo3 a)-            lambda-              = applySing (singFun1 (Proxy :: Proxy Foo3Sym0) SFoo3) sMaxBound-          in lambda-    instance SBounded (Foo4 a b) where-      sMinBound :: Sing (MinBoundSym0 :: Foo4 a b)-      sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b)-      sMinBound-        = let-            lambda :: Sing (MinBoundSym0 :: Foo4 a b)-            lambda = SFoo41-          in lambda-      sMaxBound-        = let-            lambda :: Sing (MaxBoundSym0 :: Foo4 a b)-            lambda = SFoo42-          in lambda-    instance SBounded Bool => SBounded Pair where-      sMinBound :: Sing (MinBoundSym0 :: Pair)-      sMaxBound :: Sing (MaxBoundSym0 :: Pair)-      sMinBound-        = let-            lambda :: Sing (MinBoundSym0 :: Pair)-            lambda-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy PairSym0) SPair) sMinBound)-                  sMinBound-          in lambda-      sMaxBound-        = let-            lambda :: Sing (MaxBoundSym0 :: Pair)-            lambda-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy PairSym0) SPair) sMaxBound)-                  sMaxBound-          in lambda-    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 :: *) (b :: *) = 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.ghc80.template 
@@ -1,48 +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 :: forall a. Box a -> a-    unBox (FBox a) = a-    type FBoxSym1 (t :: a0123456789) = FBox t-    instance SuppressUnusedWarnings FBoxSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FBoxSym0KindInference GHC.Tuple.())-    data FBoxSym0 (l :: TyFun a0123456789 (Box a0123456789))-      = forall arg. KindOf (Apply FBoxSym0 arg) ~ KindOf (FBoxSym1 arg) =>-        FBoxSym0KindInference-    type instance Apply FBoxSym0 l = FBoxSym1 l-    type UnBoxSym1 (t :: Box a0123456789) = UnBox t-    instance SuppressUnusedWarnings UnBoxSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) UnBoxSym0KindInference GHC.Tuple.())-    data UnBoxSym0 (l :: TyFun (Box a0123456789) a0123456789)-      = forall arg. KindOf (Apply UnBoxSym0 arg) ~ KindOf (UnBoxSym1 arg) =>-        UnBoxSym0KindInference-    type instance Apply UnBoxSym0 l = UnBoxSym1 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)-      = let-          lambda ::-            forall a.-            t ~ Apply FBoxSym0 a => Sing a -> Sing (Apply UnBoxSym0 t :: a)-          lambda a = a-        in lambda sA-    data instance Sing (z :: Box a)-      = forall (n :: a). z ~ FBox n => SFBox (Sing (n :: a))-    type SBox = (Sing :: Box a -> GHC.Types.Type)-    instance SingKind a => SingKind (Box a) where-      type DemoteRep (Box a) = Box (DemoteRep a)-      fromSing (SFBox b) = FBox (fromSing b)-      toSing (FBox b)-        = 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 -fno-warn-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.ghc80.template 
@@ -1,358 +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 :: forall a. a -> Maybe a -> a-    foo1 d x-      = case x of {-          Just y -> y-          Nothing -> d }-    foo2 :: forall a. a -> Maybe a -> a-    foo2 d _ = case Just d of { Just y -> y }-    foo3 :: forall a b. 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 :: forall a. a -> a-    foo5 x = case x of { y -> (\ _ -> x) y }-    type family Case_0123456789 x y arg_0123456789 t where-      Case_0123456789 x y arg_0123456789 _z_0123456789 = x-    type family Lambda_0123456789 x y t where-      Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x t where-      Case_0123456789 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y-    type Let0123456789ZSym2 t t = Let0123456789Z t t-    instance SuppressUnusedWarnings Let0123456789ZSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.())-    data Let0123456789ZSym1 l l-      = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) =>-        Let0123456789ZSym1KindInference-    type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type family Let0123456789Z x y :: a where-      Let0123456789Z x y = y-    type family Case_0123456789 x t where-      Case_0123456789 x y = Let0123456789ZSym2 x y-    type Let0123456789Scrutinee_0123456789Sym2 t t =-        Let0123456789Scrutinee_0123456789 t t-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) =>-        Let0123456789Scrutinee_0123456789Sym1KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) =>-        Let0123456789Scrutinee_0123456789Sym0KindInference-    type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l-    type family Let0123456789Scrutinee_0123456789 a b where-      Let0123456789Scrutinee_0123456789 a b = Apply (Apply Tuple2Sym0 a) b-    type family Case_0123456789 a b t where-      Case_0123456789 a b '(p, _z_0123456789) = p-    type Let0123456789Scrutinee_0123456789Sym2 t t =-        Let0123456789Scrutinee_0123456789 t t-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) =>-        Let0123456789Scrutinee_0123456789Sym1KindInference-    type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) =>-        Let0123456789Scrutinee_0123456789Sym0KindInference-    type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l-    type family Let0123456789Scrutinee_0123456789 d _z_0123456789 where-      Let0123456789Scrutinee_0123456789 d _z_0123456789 = Apply JustSym0 d-    type family Case_0123456789 d _z_0123456789 t where-      Case_0123456789 d _z_0123456789 (Just y) = y-    type family Case_0123456789 d x t where-      Case_0123456789 d x (Just y) = y-      Case_0123456789 d x Nothing = d-    type Foo5Sym1 (t :: a0123456789) = Foo5 t-    instance SuppressUnusedWarnings Foo5Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.())-    data Foo5Sym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5Sym1 l-    type Foo4Sym1 (t :: a0123456789) = Foo4 t-    instance SuppressUnusedWarnings Foo4Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.())-    data Foo4Sym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4Sym1 l-    type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t-    instance SuppressUnusedWarnings Foo3Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.())-    data Foo3Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) =>-        Foo3Sym1KindInference-    type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 l-    type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) =-        Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789)-                  (l :: TyFun (Maybe a0123456789) a0123456789)-      = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) =-        Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789)-                  (l :: TyFun (Maybe a0123456789) a0123456789)-      = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    type family Foo5 (a :: a) :: a where-      Foo5 x = Case_0123456789 x x-    type family Foo4 (a :: a) :: a where-      Foo4 x = Case_0123456789 x x-    type family Foo3 (a :: a) (a :: b) :: a where-      Foo3 a b = Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b)-    type family Foo2 (a :: a) (a :: Maybe a) :: a where-      Foo2 d _z_0123456789 = Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789)-    type family Foo1 (a :: a) (a :: Maybe a) :: a where-      Foo1 d x = Case_0123456789 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-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: a)-          lambda x-            = case x of {-                sY-                  -> let-                       lambda ::-                         forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a)-                       lambda y-                         = applySing-                             (singFun1-                                (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y))-                                (\ sArg_0123456789-                                   -> let-                                        lambda ::-                                          forall arg_0123456789.-                                          Sing arg_0123456789-                                          -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789)-                                        lambda arg_0123456789-                                          = case arg_0123456789 of {-                                              _s_z_0123456789-                                                -> let-                                                     lambda ::-                                                       forall _z_0123456789.-                                                       _z_0123456789 ~ arg_0123456789 =>-                                                       Sing _z_0123456789-                                                       -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789)-                                                     lambda _z_0123456789 = x-                                                   in lambda _s_z_0123456789 } ::-                                              Sing (Case_0123456789 x y arg_0123456789 arg_0123456789)-                                      in lambda sArg_0123456789))-                             y-                     in lambda sY } ::-                Sing (Case_0123456789 x x :: a)-        in lambda sX-    sFoo4 sX-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: a)-          lambda x-            = case x of {-                sY-                  -> let-                       lambda ::-                         forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a)-                       lambda y-                         = let-                             sZ :: Sing (Let0123456789ZSym2 x y :: a)-                             sZ = y-                           in sZ-                     in lambda sY } ::-                Sing (Case_0123456789 x x :: a)-        in lambda sX-    sFoo3 sA sB-      = let-          lambda ::-            forall a b.-            (t ~ a, t ~ b) =>-            Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a)-          lambda a b-            = let-                sScrutinee_0123456789 ::-                  Sing (Let0123456789Scrutinee_0123456789Sym2 a b)-                sScrutinee_0123456789-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) a) b-              in  case sScrutinee_0123456789 of {-                    STuple2 sP _s_z_0123456789-                      -> let-                           lambda ::-                             forall p _z_0123456789.-                             Apply (Apply Tuple2Sym0 p) _z_0123456789 ~ Let0123456789Scrutinee_0123456789Sym2 a b =>-                             Sing p-                             -> Sing _z_0123456789-                                -> Sing (Case_0123456789 a b (Apply (Apply Tuple2Sym0 p) _z_0123456789) :: a)-                           lambda p _z_0123456789 = p-                         in lambda sP _s_z_0123456789 } ::-                    Sing (Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b) :: a)-        in lambda sA sB-    sFoo2 sD _s_z_0123456789-      = let-          lambda ::-            forall d _z_0123456789.-            (t ~ d, t ~ _z_0123456789) =>-            Sing d-            -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-          lambda d _z_0123456789-            = let-                sScrutinee_0123456789 ::-                  Sing (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789)-                sScrutinee_0123456789-                  = applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) d-              in  case sScrutinee_0123456789 of {-                    SJust sY-                      -> let-                           lambda ::-                             forall y.-                             Apply JustSym0 y ~ Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789 =>-                             Sing y-                             -> Sing (Case_0123456789 d _z_0123456789 (Apply JustSym0 y) :: a)-                           lambda y = y-                         in lambda sY } ::-                    Sing (Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) :: a)-        in lambda sD _s_z_0123456789-    sFoo1 sD sX-      = let-          lambda ::-            forall d x.-            (t ~ d, t ~ x) =>-            Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a)-          lambda d x-            = case x of {-                SJust sY-                  -> let-                       lambda ::-                         forall y.-                         Apply JustSym0 y ~ x =>-                         Sing y -> Sing (Case_0123456789 d x (Apply JustSym0 y) :: a)-                       lambda y = y-                     in lambda sY-                SNothing-                  -> let-                       lambda ::-                         NothingSym0 ~ x => Sing (Case_0123456789 d x NothingSym0 :: a)-                       lambda = d-                     in lambda } ::-                Sing (Case_0123456789 d x x :: a)-        in lambda sD sX
− tests/compile-and-dump/Singletons/CaseExpressions.hs 
@@ -1,67 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# OPTIONS_GHC -fno-warn-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.ghc80.template 
@@ -1,657 +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 Eq Foo2 where-            F == F = True-            G == G = True-            F == G = False-            G == F = False-          instance MyOrd Foo where-            mycompare = fooCompare-          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 |]-  ======>-    const :: forall a b. 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. KindOf (Apply (FooCompareSym1 l) arg) ~ KindOf (FooCompareSym2 l arg) =>-        FooCompareSym1KindInference-    type instance Apply (FooCompareSym1 l) l = FooCompareSym2 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. KindOf (Apply FooCompareSym0 arg) ~ KindOf (FooCompareSym1 arg) =>-        FooCompareSym0KindInference-    type instance Apply FooCompareSym0 l = FooCompareSym1 l-    type ConstSym2 (t :: a0123456789) (t :: b0123456789) = Const t t-    instance SuppressUnusedWarnings ConstSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ConstSym1KindInference GHC.Tuple.())-    data ConstSym1 (l :: a0123456789)-                   (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (ConstSym1 l) arg) ~ KindOf (ConstSym2 l arg) =>-        ConstSym1KindInference-    type instance Apply (ConstSym1 l) l = ConstSym2 l l-    instance SuppressUnusedWarnings ConstSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ConstSym0KindInference GHC.Tuple.())-    data ConstSym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                            -> GHC.Types.Type))-      = forall arg. KindOf (Apply ConstSym0 arg) ~ KindOf (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 _z_0123456789 = x-    infix 4 :<=>-    type MycompareSym2 (t :: a0123456789) (t :: a0123456789) =-        Mycompare t t-    instance SuppressUnusedWarnings MycompareSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MycompareSym1KindInference GHC.Tuple.())-    data MycompareSym1 (l :: a0123456789)-                       (l :: TyFun a0123456789 Ordering)-      = forall arg. KindOf (Apply (MycompareSym1 l) arg) ~ KindOf (MycompareSym2 l arg) =>-        MycompareSym1KindInference-    type instance Apply (MycompareSym1 l) l = MycompareSym2 l l-    instance SuppressUnusedWarnings MycompareSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MycompareSym0KindInference GHC.Tuple.())-    data MycompareSym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering-                                                -> GHC.Types.Type))-      = forall arg. KindOf (Apply MycompareSym0 arg) ~ KindOf (MycompareSym1 arg) =>-        MycompareSym0KindInference-    type instance Apply MycompareSym0 l = MycompareSym1 l-    type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t-    instance SuppressUnusedWarnings (:<=>$$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.())-    data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering)-      = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) =>-        (:<=>$$###)-    type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l-    instance SuppressUnusedWarnings (:<=>$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.())-    data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering-                                          -> GHC.Types.Type))-      = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) =>-        (:<=>$###)-    type instance Apply (:<=>$) l = (:<=>$$) l-    type family TFHelper_0123456789 (a :: a) (a :: a) :: Ordering where-      TFHelper_0123456789 a_0123456789 a_0123456789 = Apply (Apply MycompareSym0 a_0123456789) a_0123456789-    type TFHelper_0123456789Sym2 (t :: a0123456789)-                                 (t :: a0123456789) =-        TFHelper_0123456789 t t-    instance SuppressUnusedWarnings TFHelper_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) TFHelper_0123456789Sym1KindInference GHC.Tuple.())-    data TFHelper_0123456789Sym1 (l :: a0123456789)-                                 (l :: TyFun a0123456789 Ordering)-      = forall arg. KindOf (Apply (TFHelper_0123456789Sym1 l) arg) ~ KindOf (TFHelper_0123456789Sym2 l arg) =>-        TFHelper_0123456789Sym1KindInference-    type instance Apply (TFHelper_0123456789Sym1 l) l = TFHelper_0123456789Sym2 l l-    instance SuppressUnusedWarnings TFHelper_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) TFHelper_0123456789Sym0KindInference GHC.Tuple.())-    data TFHelper_0123456789Sym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering-                                                          -> GHC.Types.Type))-      = forall arg. KindOf (Apply TFHelper_0123456789Sym0 arg) ~ KindOf (TFHelper_0123456789Sym1 arg) =>-        TFHelper_0123456789Sym0KindInference-    type instance Apply TFHelper_0123456789Sym0 l = TFHelper_0123456789Sym1 l-    class kproxy ~ Proxy => PMyOrd (kproxy :: Proxy a) where-      type Mycompare (arg :: a) (arg :: a) :: Ordering-      type (:<=>) (arg :: a) (arg :: a) :: Ordering-      type (:<=>) a a = Apply (Apply TFHelper_0123456789Sym0 a) a-    type family Mycompare_0123456789 (a :: Nat)-                                     (a :: Nat) :: Ordering where-      Mycompare_0123456789 Zero Zero = EQSym0-      Mycompare_0123456789 Zero (Succ _z_0123456789) = LTSym0-      Mycompare_0123456789 (Succ _z_0123456789) Zero = GTSym0-      Mycompare_0123456789 (Succ n) (Succ m) = Apply (Apply MycompareSym0 m) n-    type Mycompare_0123456789Sym2 (t :: Nat) (t :: Nat) =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                   -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy Nat) where-      type Mycompare (a :: Nat) (a :: Nat) = Apply (Apply Mycompare_0123456789Sym0 a) a-    type family Mycompare_0123456789 (a :: ())-                                     (a :: ()) :: Ordering where-      Mycompare_0123456789 _z_0123456789 a_0123456789 = Apply (Apply ConstSym0 EQSym0) a_0123456789-    type Mycompare_0123456789Sym2 (t :: ()) (t :: ()) =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: ()) (l :: TyFun () Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun () (TyFun () Ordering-                                                  -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy ()) where-      type Mycompare (a :: ()) (a :: ()) = Apply (Apply Mycompare_0123456789Sym0 a) a-    type family Mycompare_0123456789 (a :: Foo)-                                     (a :: Foo) :: Ordering where-      Mycompare_0123456789 a_0123456789 a_0123456789 = Apply (Apply FooCompareSym0 a_0123456789) a_0123456789-    type Mycompare_0123456789Sym2 (t :: Foo) (t :: Foo) =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: Foo) (l :: TyFun Foo Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun Foo (TyFun Foo Ordering-                                                   -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy Foo) where-      type Mycompare (a :: Foo) (a :: Foo) = Apply (Apply Mycompare_0123456789Sym0 a) a-    type family TFHelper_0123456789 (a :: Foo2)-                                    (a :: Foo2) :: Bool where-      TFHelper_0123456789 F F = TrueSym0-      TFHelper_0123456789 G G = TrueSym0-      TFHelper_0123456789 F G = FalseSym0-      TFHelper_0123456789 G F = FalseSym0-    type TFHelper_0123456789Sym2 (t :: Foo2) (t :: Foo2) =-        TFHelper_0123456789 t t-    instance SuppressUnusedWarnings TFHelper_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) TFHelper_0123456789Sym1KindInference GHC.Tuple.())-    data TFHelper_0123456789Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool)-      = forall arg. KindOf (Apply (TFHelper_0123456789Sym1 l) arg) ~ KindOf (TFHelper_0123456789Sym2 l arg) =>-        TFHelper_0123456789Sym1KindInference-    type instance Apply (TFHelper_0123456789Sym1 l) l = TFHelper_0123456789Sym2 l l-    instance SuppressUnusedWarnings TFHelper_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) TFHelper_0123456789Sym0KindInference GHC.Tuple.())-    data TFHelper_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool-                                                   -> GHC.Types.Type))-      = forall arg. KindOf (Apply TFHelper_0123456789Sym0 arg) ~ KindOf (TFHelper_0123456789Sym1 arg) =>-        TFHelper_0123456789Sym0KindInference-    type instance Apply TFHelper_0123456789Sym0 l = TFHelper_0123456789Sym1 l-    instance PEq (Proxy :: Proxy Foo2) where-      type (:==) (a :: Foo2) (a :: Foo2) = Apply (Apply TFHelper_0123456789Sym0 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-      = let-          lambda ::-            (t ~ ASym0, t ~ ASym0) =>-            Sing (Apply (Apply FooCompareSym0 t) t :: Ordering)-          lambda = SEQ-        in lambda-    sFooCompare SA SB-      = let-          lambda ::-            (t ~ ASym0, t ~ BSym0) =>-            Sing (Apply (Apply FooCompareSym0 t) t :: Ordering)-          lambda = SLT-        in lambda-    sFooCompare SB SB-      = let-          lambda ::-            (t ~ BSym0, t ~ BSym0) =>-            Sing (Apply (Apply FooCompareSym0 t) t :: Ordering)-          lambda = SGT-        in lambda-    sFooCompare SB SA-      = let-          lambda ::-            (t ~ BSym0, t ~ ASym0) =>-            Sing (Apply (Apply FooCompareSym0 t) t :: Ordering)-          lambda = SEQ-        in lambda-    sConst sX _s_z_0123456789-      = let-          lambda ::-            forall x _z_0123456789.-            (t ~ x, t ~ _z_0123456789) =>-            Sing x-            -> Sing _z_0123456789 -> Sing (Apply (Apply ConstSym0 t) t :: a)-          lambda x _z_0123456789 = x-        in lambda sX _s_z_0123456789-    data instance Sing (z :: Foo) = z ~ A => SA | z ~ B => SB-    type SFoo = (Sing :: Foo -> GHC.Types.Type)-    instance SingKind Foo where-      type DemoteRep Foo = Foo-      fromSing SA = A-      fromSing SB = B-      toSing A = SomeSing SA-      toSing B = SomeSing SB-    data instance Sing (z :: Foo2) = z ~ F => SF | z ~ G => SG-    type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type)-    instance SingKind Foo2 where-      type DemoteRep 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 ~ Apply (Apply TFHelper_0123456789Sym0 t) t =>-                Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering)-      (%:<=>) sA_0123456789 sA_0123456789-        = let-            lambda ::-              forall a_0123456789 a_0123456789.-              (t ~ a_0123456789, t ~ a_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing (Apply (Apply (:<=>$) t) t :: Ordering)-            lambda a_0123456789 a_0123456789-              = applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) a_0123456789)-                  a_0123456789-          in lambda sA_0123456789 sA_0123456789-    instance SMyOrd Nat where-      sMycompare ::-        forall (t :: Nat) (t :: Nat).-        Sing t-        -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-      sMycompare SZero SZero-        = let-            lambda ::-              (t ~ ZeroSym0, t ~ ZeroSym0) =>-              Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda = SEQ-          in lambda-      sMycompare SZero (SSucc _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t ~ ZeroSym0, t ~ Apply SuccSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sMycompare (SSucc _s_z_0123456789) SZero-        = let-            lambda ::-              forall _z_0123456789.-              (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sMycompare (SSucc sN) (SSucc sM)-        = let-            lambda ::-              forall n m.-              (t ~ Apply SuccSym0 n, t ~ Apply SuccSym0 m) =>-              Sing n-              -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda n m-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m)-                  n-          in lambda sN sM-    instance SMyOrd () where-      sMycompare ::-        forall (t :: ()) (t :: ()).-        Sing t-        -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-      sMycompare _s_z_0123456789 sA_0123456789-        = let-            lambda ::-              forall _z_0123456789 a_0123456789.-              (t ~ _z_0123456789, t ~ a_0123456789) =>-              Sing _z_0123456789-              -> Sing a_0123456789-                 -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda _z_0123456789 a_0123456789-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy ConstSym0) sConst) SEQ)-                  a_0123456789-          in lambda _s_z_0123456789 sA_0123456789-    instance SMyOrd Foo where-      sMycompare ::-        forall (t :: Foo) (t :: Foo).-        Sing t-        -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-      sMycompare sA_0123456789 sA_0123456789-        = let-            lambda ::-              forall a_0123456789 a_0123456789.-              (t ~ a_0123456789, t ~ a_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda a_0123456789 a_0123456789-              = applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy FooCompareSym0) sFooCompare)-                     a_0123456789)-                  a_0123456789-          in lambda sA_0123456789 sA_0123456789-    instance SEq Foo2 where-      (%:==) ::-        forall (a :: Foo2) (b :: Foo2).-        Sing a -> Sing b -> Sing ((:==) a b)-      (%:==) SF SF-        = let-            lambda :: (a ~ FSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b)-            lambda = STrue-          in lambda-      (%:==) SG SG-        = let-            lambda :: (a ~ GSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b)-            lambda = STrue-          in lambda-      (%:==) SF SG-        = let-            lambda :: (a ~ FSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b)-            lambda = SFalse-          in lambda-      (%:==) SG SF-        = let-            lambda :: (a ~ GSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b)-            lambda = SFalse-          in lambda-    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_0123456789 (a :: Foo2)-                                     (a :: Foo2) :: Ordering where-      Mycompare_0123456789 F F = EQSym0-      Mycompare_0123456789 F _z_0123456789 = LTSym0-      Mycompare_0123456789 _z_0123456789 _z_0123456789 = GTSym0-    type Mycompare_0123456789Sym2 (t :: Foo2) (t :: Foo2) =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: Foo2)-                                  (l :: TyFun Foo2 Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering-                                                    -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy Foo2) where-      type Mycompare (a :: Foo2) (a :: Foo2) = Apply (Apply Mycompare_0123456789Sym0 a) a-    type family Compare_0123456789 (a :: Foo2)-                                   (a :: Foo2) :: Ordering where-      Compare_0123456789 F F = EQSym0-      Compare_0123456789 F _z_0123456789 = LTSym0-      Compare_0123456789 _z_0123456789 _z_0123456789 = GTSym0-    type Compare_0123456789Sym2 (t :: Foo2) (t :: Foo2) =-        Compare_0123456789 t t-    instance SuppressUnusedWarnings Compare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.())-    data Compare_0123456789Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering)-      = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) =>-        Compare_0123456789Sym1KindInference-    type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Compare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.())-    data Compare_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering-                                                  -> GHC.Types.Type))-      = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) =>-        Compare_0123456789Sym0KindInference-    type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l-    instance POrd (Proxy :: Proxy Foo2) where-      type Compare (a :: Foo2) (a :: Foo2) = Apply (Apply Compare_0123456789Sym0 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. KindOf (Apply Succ'Sym0 arg) ~ KindOf (Succ'Sym1 arg) =>-        Succ'Sym0KindInference-    type instance Apply Succ'Sym0 l = Succ'Sym1 l-    type family Mycompare_0123456789 (a :: Nat')-                                     (a :: Nat') :: Ordering where-      Mycompare_0123456789 Zero' Zero' = EQSym0-      Mycompare_0123456789 Zero' (Succ' _z_0123456789) = LTSym0-      Mycompare_0123456789 (Succ' _z_0123456789) Zero' = GTSym0-      Mycompare_0123456789 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n-    type Mycompare_0123456789Sym2 (t :: Nat') (t :: Nat') =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: Nat')-                                  (l :: TyFun Nat' Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering-                                                    -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy Nat') where-      type Mycompare (a :: Nat') (a :: Nat') = Apply (Apply Mycompare_0123456789Sym0 a) a-    data instance Sing (z :: Nat')-      = z ~ Zero' => SZero' |-        forall (n :: Nat'). z ~ Succ' n => SSucc' (Sing (n :: Nat'))-    type SNat' = (Sing :: Nat' -> GHC.Types.Type)-    instance SingKind Nat' where-      type DemoteRep Nat' = Nat'-      fromSing SZero' = Zero'-      fromSing (SSucc' b) = Succ' (fromSing b)-      toSing Zero' = SomeSing SZero'-      toSing (Succ' b)-        = 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 :: TyFun Nat' Ordering-                                                                           -> GHC.Types.Type) t :: Ordering)-      sMycompare SZero' SZero'-        = let-            lambda ::-              (t ~ Zero'Sym0, t ~ Zero'Sym0) =>-              Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda = SEQ-          in lambda-      sMycompare SZero' (SSucc' _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t ~ Zero'Sym0, t ~ Apply Succ'Sym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sMycompare (SSucc' _s_z_0123456789) SZero'-        = let-            lambda ::-              forall _z_0123456789.-              (t ~ Apply Succ'Sym0 _z_0123456789, t ~ Zero'Sym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sMycompare (SSucc' sN) (SSucc' sM)-        = let-            lambda ::-              forall n m.-              (t ~ Apply Succ'Sym0 n, t ~ Apply Succ'Sym0 m) =>-              Sing n-              -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)-            lambda n m-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m)-                  n-          in lambda sN sM-    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.ghc80.template 
@@ -1,116 +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. KindOf (Apply SuccFooSym0 arg) ~ KindOf (SuccFooSym1 arg) =>-        SuccFooSym0KindInference-    type instance Apply SuccFooSym0 l = SuccFooSym1 l-    type family Mycompare_0123456789 (a :: NatFoo)-                                     (a :: NatFoo) :: Ordering where-      Mycompare_0123456789 ZeroFoo ZeroFoo = EQSym0-      Mycompare_0123456789 ZeroFoo (SuccFoo _z_0123456789) = LTSym0-      Mycompare_0123456789 (SuccFoo _z_0123456789) ZeroFoo = GTSym0-      Mycompare_0123456789 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n-    type Mycompare_0123456789Sym2 (t :: NatFoo) (t :: NatFoo) =-        Mycompare_0123456789 t t-    instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym1 (l :: NatFoo)-                                  (l :: TyFun NatFoo Ordering)-      = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) =>-        Mycompare_0123456789Sym1KindInference-    type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.())-    data Mycompare_0123456789Sym0 (l :: TyFun NatFoo (TyFun NatFoo Ordering-                                                      -> GHC.Types.Type))-      = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) =>-        Mycompare_0123456789Sym0KindInference-    type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l-    instance PMyOrd (Proxy :: Proxy NatFoo) where-      type Mycompare (a :: NatFoo) (a :: NatFoo) = Apply (Apply Mycompare_0123456789Sym0 a) a-    data instance Sing (z :: NatFoo)-      = z ~ ZeroFoo => SZeroFoo |-        forall (n :: NatFoo). z ~ SuccFoo n =>-        SSuccFoo (Sing (n :: NatFoo))-    type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type)-    instance SingKind NatFoo where-      type DemoteRep NatFoo = NatFoo-      fromSing SZeroFoo = ZeroFoo-      fromSing (SSuccFoo b) = SuccFoo (fromSing b)-      toSing ZeroFoo = SomeSing SZeroFoo-      toSing (SuccFoo b)-        = case toSing b :: SomeSing NatFoo of {-            SomeSing c -> SomeSing (SSuccFoo c) }-    instance SMyOrd NatFoo where-      sMycompare ::-        forall (t0 :: NatFoo) (t1 :: NatFoo).-        Sing t0-        -> Sing t1-           -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo (TyFun NatFoo Ordering-                                                                 -> GHC.Types.Type)-                                                   -> GHC.Types.Type) t0 :: TyFun NatFoo Ordering-                                                                            -> GHC.Types.Type) t1 :: Ordering)-      sMycompare SZeroFoo SZeroFoo-        = let-            lambda ::-              (t0 ~ ZeroFooSym0, t1 ~ ZeroFooSym0) =>-              Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering)-            lambda = SEQ-          in lambda-      sMycompare SZeroFoo (SSuccFoo _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ ZeroFooSym0, t1 ~ Apply SuccFooSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sMycompare (SSuccFoo _s_z_0123456789) SZeroFoo-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply SuccFooSym0 _z_0123456789, t1 ~ ZeroFooSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sMycompare (SSuccFoo sN) (SSuccFoo sM)-        = let-            lambda ::-              forall n m.-              (t0 ~ Apply SuccFooSym0 n, t1 ~ Apply SuccFooSym0 m) =>-              Sing n-              -> Sing m -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering)-            lambda n m-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m)-                  n-          in lambda sN sM-    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.ghc80.template 
@@ -1,60 +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 :: forall a. Eq a => a -> [a] -> Bool-    contains _ GHC.Types.[] = False-    contains elt (h GHC.Types.: t) = ((elt == h) || (contains elt t))-    type ContainsSym2 (t :: a0123456789) (t :: [a0123456789]) =-        Contains t t-    instance SuppressUnusedWarnings ContainsSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ContainsSym1KindInference GHC.Tuple.())-    data ContainsSym1 (l :: a0123456789)-                      (l :: TyFun [a0123456789] Bool)-      = forall arg. KindOf (Apply (ContainsSym1 l) arg) ~ KindOf (ContainsSym2 l arg) =>-        ContainsSym1KindInference-    type instance Apply (ContainsSym1 l) l = ContainsSym2 l l-    instance SuppressUnusedWarnings ContainsSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ContainsSym0KindInference GHC.Tuple.())-    data ContainsSym0 (l :: TyFun a0123456789 (TyFun [a0123456789] Bool-                                               -> GHC.Types.Type))-      = forall arg. KindOf (Apply ContainsSym0 arg) ~ KindOf (ContainsSym1 arg) =>-        ContainsSym0KindInference-    type instance Apply ContainsSym0 l = ContainsSym1 l-    type family Contains (a :: a) (a :: [a]) :: Bool where-      Contains _z_0123456789 '[] = 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 _s_z_0123456789 SNil-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ '[]) =>-            Sing _z_0123456789 -> Sing (Apply (Apply ContainsSym0 t) t :: Bool)-          lambda _z_0123456789 = SFalse-        in lambda _s_z_0123456789-    sContains sElt (SCons sH sT)-      = let-          lambda ::-            forall elt h t.-            (t ~ elt, t ~ Apply (Apply (:$) h) t) =>-            Sing elt-            -> Sing h-               -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool)-          lambda elt h t-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:||$)) (%:||))-                   (applySing-                      (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) elt) h))-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy ContainsSym0) sContains) elt)-                   t)-        in lambda sElt sH 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.ghc80.template 
@@ -1,102 +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 :: a0123456789) (t :: b0123456789) = Pair t t-    instance SuppressUnusedWarnings PairSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.())-    data PairSym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 (Pair a0123456789 b0123456789))-      = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = PairSym2 l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.())-    data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789)-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (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) '[])-    sAList :: Sing AListSym0-    sTuple :: Sing TupleSym0-    sComplex :: Sing ComplexSym0-    sPr :: Sing PrSym0-    sAList-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero)-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                      (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)))-                SNil))-    sTuple-      = applySing-          (applySing-             (applySing (singFun3 (Proxy :: Proxy Tuple3Sym0) STuple3) SFalse)-             (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero))-          STrue-    sComplex-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy PairSym0) SPair)-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy PairSym0) SPair)-                   (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero))-                SZero))-          SFalse-    sPr-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy PairSym0) SPair)-             (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) SNil)-    data instance Sing (z :: Pair a b)-      = forall (n :: a) (n :: b). z ~ Pair n n =>-        SPair (Sing (n :: a)) (Sing (n :: b))-    type SPair = (Sing :: Pair a b -> GHC.Types.Type)-    instance (SingKind a, SingKind b) => SingKind (Pair a b) where-      type DemoteRep (Pair a b) = Pair (DemoteRep a) (DemoteRep b)-      fromSing (SPair b b) = Pair (fromSing b) (fromSing b)-      toSing (Pair b b)-        = case-              GHC.Tuple.(,) (toSing b :: SomeSing a) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SPair c c) }-    instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where-      sing = SPair sing sing
− tests/compile-and-dump/Singletons/DataValues.hs 
@@ -1,19 +0,0 @@-module Singletons.DataValues where--import Data.Singletons.TH-import Data.Singletons.Prelude-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.ghc80.template 
@@ -1,14 +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 DemoteRep Empty = Empty-      fromSing z-        = case z of {-            _ -> error "Empty case reached -- this should be impossible" }-      toSing z-        = case z of {-            _ -> error "Empty case reached -- this should be impossible" }
− 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/EnumDeriving.ghc80.template 
@@ -1,284 +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_0123456789 n t where-      Case_0123456789 n True = BumSym0-      Case_0123456789 n False = Apply ErrorSym0 "toEnum: bad argument"-    type family Case_0123456789 n t where-      Case_0123456789 n True = BazSym0-      Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2))-    type family Case_0123456789 n t where-      Case_0123456789 n True = BarSym0-      Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1))-    type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: Foo where-      ToEnum_0123456789 n = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0))-    type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) =-        ToEnum_0123456789 t-    instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.())-    data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat Foo)-      = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) =>-        ToEnum_0123456789Sym0KindInference-    type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l-    type family FromEnum_0123456789 (a :: Foo) :: GHC.Types.Nat where-      FromEnum_0123456789 Bar = FromInteger 0-      FromEnum_0123456789 Baz = FromInteger 1-      FromEnum_0123456789 Bum = FromInteger 2-    type FromEnum_0123456789Sym1 (t :: Foo) = FromEnum_0123456789 t-    instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.())-    data FromEnum_0123456789Sym0 (l :: TyFun Foo GHC.Types.Nat)-      = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) =>-        FromEnum_0123456789Sym0KindInference-    type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l-    instance PEnum (Proxy :: Proxy Foo) where-      type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a-      type FromEnum (a :: Foo) = Apply FromEnum_0123456789Sym0 a-    data instance Sing (z :: Foo)-      = z ~ Bar => SBar | z ~ Baz => SBaz | z ~ Bum => SBum-    type SFoo = (Sing :: Foo -> GHC.Types.Type)-    instance SingKind Foo where-      type DemoteRep 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) = z ~ Q1 => SQ1 | z ~ Q2 => SQ2-    type SQuux = (Sing :: Quux -> GHC.Types.Type)-    instance SingKind Quux where-      type DemoteRep Quux = Quux-      fromSing SQ1 = Q1-      fromSing SQ2 = Q2-      toSing Q1 = SomeSing SQ1-      toSing Q2 = SomeSing SQ2-    instance SEnum Foo where-      sToEnum ::-        forall (t0 :: GHC.Types.Nat).-        Sing t0-        -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Foo-                                      -> GHC.Types.Type) t0 :: Foo)-      sFromEnum ::-        forall (t0 :: Foo).-        Sing t0-        -> Sing (Apply (FromEnumSym0 :: TyFun Foo GHC.Types.Nat-                                        -> GHC.Types.Type) t0 :: GHC.Types.Nat)-      sToEnum sN-        = let-            lambda ::-              forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Foo)-            lambda n-              = case-                    applySing-                      (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n)-                      (sFromInteger (sing :: Sing 0))-                of {-                  STrue-                    -> let-                         lambda ::-                           TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) =>-                           Sing (Case_0123456789 n TrueSym0 :: Foo)-                         lambda = SBar-                       in lambda-                  SFalse-                    -> let-                         lambda ::-                           FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) =>-                           Sing (Case_0123456789 n FalseSym0 :: Foo)-                         lambda-                           = case-                                 applySing-                                   (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n)-                                   (sFromInteger (sing :: Sing 1))-                             of {-                               STrue-                                 -> let-                                      lambda ::-                                        TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) =>-                                        Sing (Case_0123456789 n TrueSym0 :: Foo)-                                      lambda = SBaz-                                    in lambda-                               SFalse-                                 -> let-                                      lambda ::-                                        FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) =>-                                        Sing (Case_0123456789 n FalseSym0 :: Foo)-                                      lambda-                                        = case-                                              applySing-                                                (applySing-                                                   (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n)-                                                (sFromInteger (sing :: Sing 2))-                                          of {-                                            STrue-                                              -> let-                                                   lambda ::-                                                     TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) =>-                                                     Sing (Case_0123456789 n TrueSym0 :: Foo)-                                                   lambda = SBum-                                                 in lambda-                                            SFalse-                                              -> let-                                                   lambda ::-                                                     FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) =>-                                                     Sing (Case_0123456789 n FalseSym0 :: Foo)-                                                   lambda-                                                     = sError (sing :: Sing "toEnum: bad argument")-                                                 in lambda } ::-                                            Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2)) :: Foo)-                                    in lambda } ::-                               Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Foo)-                       in lambda } ::-                  Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Foo)-          in lambda sN-      sFromEnum SBar-        = let-            lambda ::-              t0 ~ BarSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 0)-          in lambda-      sFromEnum SBaz-        = let-            lambda ::-              t0 ~ BazSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 1)-          in lambda-      sFromEnum SBum-        = let-            lambda ::-              t0 ~ BumSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 2)-          in lambda-    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_0123456789 n t where-      Case_0123456789 n True = Q2Sym0-      Case_0123456789 n False = Apply ErrorSym0 "toEnum: bad argument"-    type family Case_0123456789 n t where-      Case_0123456789 n True = Q1Sym0-      Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1))-    type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: Quux where-      ToEnum_0123456789 n = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0))-    type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) =-        ToEnum_0123456789 t-    instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.())-    data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat Quux)-      = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) =>-        ToEnum_0123456789Sym0KindInference-    type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l-    type family FromEnum_0123456789 (a :: Quux) :: GHC.Types.Nat where-      FromEnum_0123456789 Q1 = FromInteger 0-      FromEnum_0123456789 Q2 = FromInteger 1-    type FromEnum_0123456789Sym1 (t :: Quux) = FromEnum_0123456789 t-    instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.())-    data FromEnum_0123456789Sym0 (l :: TyFun Quux GHC.Types.Nat)-      = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) =>-        FromEnum_0123456789Sym0KindInference-    type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l-    instance PEnum (Proxy :: Proxy Quux) where-      type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a-      type FromEnum (a :: Quux) = Apply FromEnum_0123456789Sym0 a-    instance SEnum Quux where-      sToEnum ::-        forall (t0 :: GHC.Types.Nat).-        Sing t0-        -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Quux-                                      -> GHC.Types.Type) t0 :: Quux)-      sFromEnum ::-        forall (t0 :: Quux).-        Sing t0-        -> Sing (Apply (FromEnumSym0 :: TyFun Quux GHC.Types.Nat-                                        -> GHC.Types.Type) t0 :: GHC.Types.Nat)-      sToEnum sN-        = let-            lambda ::-              forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Quux)-            lambda n-              = case-                    applySing-                      (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n)-                      (sFromInteger (sing :: Sing 0))-                of {-                  STrue-                    -> let-                         lambda ::-                           TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) =>-                           Sing (Case_0123456789 n TrueSym0 :: Quux)-                         lambda = SQ1-                       in lambda-                  SFalse-                    -> let-                         lambda ::-                           FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) =>-                           Sing (Case_0123456789 n FalseSym0 :: Quux)-                         lambda-                           = case-                                 applySing-                                   (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n)-                                   (sFromInteger (sing :: Sing 1))-                             of {-                               STrue-                                 -> let-                                      lambda ::-                                        TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) =>-                                        Sing (Case_0123456789 n TrueSym0 :: Quux)-                                      lambda = SQ2-                                    in lambda-                               SFalse-                                 -> let-                                      lambda ::-                                        FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) =>-                                        Sing (Case_0123456789 n FalseSym0 :: Quux)-                                      lambda = sError (sing :: Sing "toEnum: bad argument")-                                    in lambda } ::-                               Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Quux)-                       in lambda } ::-                  Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Quux)-          in lambda sN-      sFromEnum SQ1-        = let-            lambda ::-              t0 ~ Q1Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 0)-          in lambda-      sFromEnum SQ2-        = let-            lambda ::-              t0 ~ Q2Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 1)-          in lambda
− tests/compile-and-dump/Singletons/EnumDeriving.hs 
@@ -1,12 +0,0 @@-module Singletons.EnumDeriving where--import Data.Singletons.Prelude-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.ghc80.template 
@@ -1,23 +0,0 @@-Singletons/EqInstances.hs:0:0:: Splicing declarations-    singEqInstances [''Foo, ''Empty]-  ======>-    instance SEq Foo where-      (%:==) SFLeaf SFLeaf = STrue-      (%:==) SFLeaf ((:%+:) _ _) = SFalse-      (%:==) ((:%+:) _ _) SFLeaf = SFalse-      (%:==) ((:%+:) a a) ((:%+:) b b) = (%:&&) ((%:==) a b) ((%:==) a b)-    type family Equals_0123456789 (a :: Foo) (b :: Foo) :: Bool where-      Equals_0123456789 FLeaf FLeaf = TrueSym0-      Equals_0123456789 ((:+:) a a) ((:+:) b b) = (:&&) ((:==) a b) ((:==) a b)-      Equals_0123456789 (a :: Foo) (b :: Foo) = FalseSym0-    instance PEq (Proxy :: Proxy Foo) where-      type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789 a b-    instance SEq Empty where-      (%:==) a _-        = case a of {-            _ -> error "Empty case reached -- this should be impossible" }-    type family Equals_0123456789 (a :: Empty)-                                  (b :: Empty) :: Bool where-      Equals_0123456789 (a :: Empty) (b :: Empty) = FalseSym0-    instance PEq (Proxy :: Proxy Empty) where-      type (:==) (a :: Empty) (b :: Empty) = Equals_0123456789 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.ghc80.template 
@@ -1,35 +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 :: forall a. [a] -> a-    head (a GHC.Types.: _) = a-    head GHC.Types.[] = error "Data.Singletons.List.head: empty list"-    type HeadSym1 (t :: [a0123456789]) = Head t-    instance SuppressUnusedWarnings HeadSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) HeadSym0KindInference GHC.Tuple.())-    data HeadSym0 (l :: TyFun [a0123456789] a0123456789)-      = forall arg. KindOf (Apply HeadSym0 arg) ~ KindOf (HeadSym1 arg) =>-        HeadSym0KindInference-    type instance Apply HeadSym0 l = HeadSym1 l-    type family Head (a :: [a]) :: a where-      Head ((:) a _z_0123456789) = a-      Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list"-    sHead :: forall (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a)-    sHead (SCons sA _s_z_0123456789)-      = let-          lambda ::-            forall a _z_0123456789.-            t ~ Apply (Apply (:$) a) _z_0123456789 =>-            Sing a -> Sing _z_0123456789 -> Sing (Apply HeadSym0 t :: a)-          lambda a _z_0123456789 = a-        in lambda sA _s_z_0123456789-    sHead SNil-      = let-          lambda :: t ~ '[] => Sing (Apply HeadSym0 t :: a)-          lambda-            = sError (sing :: Sing "Data.Singletons.List.head: empty list")-        in lambda
− 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.ghc80.template 
@@ -1,75 +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 <=>-    (====) :: forall a. a -> a -> a-    (====) a _ = a-    infix 4 ====-    type (:====$$$) (t :: a0123456789) (t :: a0123456789) = (:====) t t-    instance SuppressUnusedWarnings (:====$$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:====$$###) GHC.Tuple.())-    data (:====$$) (l :: a0123456789)-                   (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply ((:====$$) l) arg) ~ KindOf ((:====$$$) l arg) =>-        (:====$$###)-    type instance Apply ((:====$$) l) l = (:====$$$) l l-    instance SuppressUnusedWarnings (:====$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:====$###) GHC.Tuple.())-    data (:====$) (l :: TyFun a0123456789 (TyFun a0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply (:====$) arg) ~ KindOf ((:====$$) arg) =>-        (:====$###)-    type instance Apply (:====$) l = (:====$$) l-    type family (:====) (a :: a) (a :: a) :: a where-      (:====) a _z_0123456789 = a-    infix 4 :====-    infix 4 :<=>-    type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t-    instance SuppressUnusedWarnings (:<=>$$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.())-    data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering)-      = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) =>-        (:<=>$$###)-    type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l-    instance SuppressUnusedWarnings (:<=>$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.())-    data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering-                                          -> GHC.Types.Type))-      = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) =>-        (:<=>$###)-    type instance Apply (:<=>$) l = (:<=>$$) l-    class kproxy ~ Proxy => PMyOrd (kproxy :: Proxy a) 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 _s_z_0123456789-      = let-          lambda ::-            forall a _z_0123456789.-            (t ~ a, t ~ _z_0123456789) =>-            Sing a-            -> Sing _z_0123456789 -> Sing (Apply (Apply (:====$) t) t :: a)-          lambda a _z_0123456789 = a-        in lambda sA _s_z_0123456789-    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.ghc80.template 
@@ -1,96 +0,0 @@-Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations-    singletons-      [d| t1 = meth True-          -          class FD a b | a -> b where-            meth :: a -> a-            l2r :: a -> b-          -          instance FD Bool Nat where-            meth = not-            l2r False = 0-            l2r True = 1 |]-  ======>-    class FD a b | a -> b where-      meth :: a -> a-      l2r :: a -> b-    instance FD Bool Nat where-      meth = not-      l2r False = 0-      l2r True = 1-    t1 = meth True-    type T1Sym0 = T1-    type family T1 where-      T1 = Apply MethSym0 TrueSym0-    type MethSym1 (t :: a0123456789) = Meth t-    instance SuppressUnusedWarnings MethSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.())-    data MethSym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) =>-        MethSym0KindInference-    type instance Apply MethSym0 l = MethSym1 l-    type L2rSym1 (t :: a0123456789) = L2r t-    instance SuppressUnusedWarnings L2rSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) L2rSym0KindInference GHC.Tuple.())-    data L2rSym0 (l :: TyFun a0123456789 b0123456789)-      = forall arg. KindOf (Apply L2rSym0 arg) ~ KindOf (L2rSym1 arg) =>-        L2rSym0KindInference-    type instance Apply L2rSym0 l = L2rSym1 l-    class (kproxy ~ Proxy, kproxy ~ Proxy) => PFD (kproxy :: Proxy a)-                                                  (kproxy :: Proxy b) | a -> b where-      type Meth (arg :: a) :: a-      type L2r (arg :: a) :: b-    type family Meth_0123456789 (a :: Bool) :: Bool where-      Meth_0123456789 a_0123456789 = Apply NotSym0 a_0123456789-    type Meth_0123456789Sym1 (t :: Bool) = Meth_0123456789 t-    instance SuppressUnusedWarnings Meth_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Meth_0123456789Sym0KindInference GHC.Tuple.())-    data Meth_0123456789Sym0 (l :: TyFun Bool Bool)-      = forall arg. KindOf (Apply Meth_0123456789Sym0 arg) ~ KindOf (Meth_0123456789Sym1 arg) =>-        Meth_0123456789Sym0KindInference-    type instance Apply Meth_0123456789Sym0 l = Meth_0123456789Sym1 l-    type family L2r_0123456789 (a :: Bool) :: Nat where-      L2r_0123456789 False = FromInteger 0-      L2r_0123456789 True = FromInteger 1-    type L2r_0123456789Sym1 (t :: Bool) = L2r_0123456789 t-    instance SuppressUnusedWarnings L2r_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) L2r_0123456789Sym0KindInference GHC.Tuple.())-    data L2r_0123456789Sym0 (l :: TyFun Bool Nat)-      = forall arg. KindOf (Apply L2r_0123456789Sym0 arg) ~ KindOf (L2r_0123456789Sym1 arg) =>-        L2r_0123456789Sym0KindInference-    type instance Apply L2r_0123456789Sym0 l = L2r_0123456789Sym1 l-    instance PFD (Proxy :: Proxy Bool) (Proxy :: Proxy Nat) where-      type Meth (a :: Bool) = Apply Meth_0123456789Sym0 a-      type L2r (a :: Bool) = Apply L2r_0123456789Sym0 a-    sT1 :: Sing T1Sym0-    sT1 = applySing (singFun1 (Proxy :: Proxy 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_0123456789-        = let-            lambda ::-              forall a_0123456789.-              t ~ a_0123456789 =>-              Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool)-            lambda a_0123456789-              = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789-          in lambda sA_0123456789-      sL2r SFalse-        = let-            lambda :: t ~ FalseSym0 => Sing (Apply L2rSym0 t :: Nat)-            lambda = sFromInteger (sing :: Sing 0)-          in lambda-      sL2r STrue-        = let-            lambda :: t ~ TrueSym0 => Sing (Apply L2rSym0 t :: Nat)-            lambda = sFromInteger (sing :: Sing 1)-          in lambda
− 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.ghc80.template 
@@ -1,573 +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 :: forall a b. (a -> b) -> [a] -> [b]-    map _ GHC.Types.[] = []-    map f (h GHC.Types.: t) = ((f h) GHC.Types.: (map f t))-    liftMaybe :: forall a b. (a -> b) -> Maybe a -> Maybe b-    liftMaybe f (Just x) = Just (f x)-    liftMaybe _ Nothing = Nothing-    zipWith :: forall a b c. (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 :: forall a b. ((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 :: a0123456789) = Left t-    instance SuppressUnusedWarnings LeftSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LeftSym0KindInference GHC.Tuple.())-    data LeftSym0 (l :: TyFun a0123456789 (Either a0123456789 b0123456789))-      = forall arg. KindOf (Apply LeftSym0 arg) ~ KindOf (LeftSym1 arg) =>-        LeftSym0KindInference-    type instance Apply LeftSym0 l = LeftSym1 l-    type RightSym1 (t :: b0123456789) = Right t-    instance SuppressUnusedWarnings RightSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) RightSym0KindInference GHC.Tuple.())-    data RightSym0 (l :: TyFun b0123456789 (Either a0123456789 b0123456789))-      = forall arg. KindOf (Apply RightSym0 arg) ~ KindOf (RightSym1 arg) =>-        RightSym0KindInference-    type instance Apply RightSym0 l = RightSym1 l-    type family Case_0123456789 ns bs n b t where-      Case_0123456789 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n)-      Case_0123456789 ns bs n b False = n-    type family Lambda_0123456789 ns bs t t where-      Lambda_0123456789 ns bs n b = Case_0123456789 ns bs n b b-    type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 n b a_0123456789 a_0123456789 t where-      Case_0123456789 n b a_0123456789 a_0123456789 True = Apply SuccSym0 (Apply SuccSym0 n)-      Case_0123456789 n b a_0123456789 a_0123456789 False = n-    type family Lambda_0123456789 a_0123456789 a_0123456789 t t where-      Lambda_0123456789 a_0123456789 a_0123456789 n b = Case_0123456789 n b a_0123456789 a_0123456789 b-    type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type FooSym3 (t :: TyFun (TyFun a0123456789 b0123456789-                              -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type)-                 (t :: TyFun a0123456789 b0123456789 -> GHC.Types.Type)-                 (t :: a0123456789) =-        Foo t t t-    instance SuppressUnusedWarnings FooSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FooSym2KindInference GHC.Tuple.())-    data FooSym2 (l :: TyFun (TyFun a0123456789 b0123456789-                              -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type)-                 (l :: TyFun a0123456789 b0123456789 -> GHC.Types.Type)-                 (l :: TyFun a0123456789 b0123456789)-      = forall arg. KindOf (Apply (FooSym2 l l) arg) ~ KindOf (FooSym3 l l arg) =>-        FooSym2KindInference-    type instance Apply (FooSym2 l l) l = FooSym3 l l l-    instance SuppressUnusedWarnings FooSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.())-    data FooSym1 (l :: TyFun (TyFun a0123456789 b0123456789-                              -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type)-                 (l :: TyFun (TyFun a0123456789 b0123456789-                              -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                  -> GHC.Types.Type))-      = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (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 a0123456789 b0123456789-                                     -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                         -> GHC.Types.Type)-                              -> GHC.Types.Type) (TyFun (TyFun a0123456789 b0123456789-                                                         -> GHC.Types.Type) (TyFun a0123456789 b0123456789-                                                                             -> GHC.Types.Type)-                                                  -> GHC.Types.Type))-      = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    type ZipWithSym3 (t :: TyFun a0123456789 (TyFun b0123456789 c0123456789-                                              -> GHC.Types.Type)-                           -> GHC.Types.Type)-                     (t :: [a0123456789])-                     (t :: [b0123456789]) =-        ZipWith t t t-    instance SuppressUnusedWarnings ZipWithSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ZipWithSym2KindInference GHC.Tuple.())-    data ZipWithSym2 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789-                                              -> GHC.Types.Type)-                           -> GHC.Types.Type)-                     (l :: [a0123456789])-                     (l :: TyFun [b0123456789] [c0123456789])-      = forall arg. KindOf (Apply (ZipWithSym2 l l) arg) ~ KindOf (ZipWithSym3 l l arg) =>-        ZipWithSym2KindInference-    type instance Apply (ZipWithSym2 l l) l = ZipWithSym3 l l l-    instance SuppressUnusedWarnings ZipWithSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ZipWithSym1KindInference GHC.Tuple.())-    data ZipWithSym1 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789-                                              -> GHC.Types.Type)-                           -> GHC.Types.Type)-                     (l :: TyFun [a0123456789] (TyFun [b0123456789] [c0123456789]-                                                -> GHC.Types.Type))-      = forall arg. KindOf (Apply (ZipWithSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 c0123456789-                                                     -> GHC.Types.Type)-                                  -> GHC.Types.Type) (TyFun [a0123456789] (TyFun [b0123456789] [c0123456789]-                                                                           -> GHC.Types.Type)-                                                      -> GHC.Types.Type))-      = forall arg. KindOf (Apply ZipWithSym0 arg) ~ KindOf (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. KindOf (Apply (SplungeSym1 l) arg) ~ KindOf (SplungeSym2 l arg) =>-        SplungeSym1KindInference-    type instance Apply (SplungeSym1 l) l = SplungeSym2 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. KindOf (Apply SplungeSym0 arg) ~ KindOf (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. KindOf (Apply (EtadSym1 l) arg) ~ KindOf (EtadSym2 l arg) =>-        EtadSym1KindInference-    type instance Apply (EtadSym1 l) l = EtadSym2 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. KindOf (Apply EtadSym0 arg) ~ KindOf (EtadSym1 arg) =>-        EtadSym0KindInference-    type instance Apply EtadSym0 l = EtadSym1 l-    type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789-                             -> GHC.Types.Type)-                       (t :: Maybe a0123456789) =-        LiftMaybe t t-    instance SuppressUnusedWarnings LiftMaybeSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.())-    data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789-                             -> GHC.Types.Type)-                       (l :: TyFun (Maybe a0123456789) (Maybe b0123456789))-      = forall arg. KindOf (Apply (LiftMaybeSym1 l) arg) ~ KindOf (LiftMaybeSym2 l arg) =>-        LiftMaybeSym1KindInference-    type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l-    instance SuppressUnusedWarnings LiftMaybeSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.())-    data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789-                                    -> GHC.Types.Type) (TyFun (Maybe a0123456789) (Maybe b0123456789)-                                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply LiftMaybeSym0 arg) ~ KindOf (LiftMaybeSym1 arg) =>-        LiftMaybeSym0KindInference-    type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l-    type MapSym2 (t :: TyFun a0123456789 b0123456789 -> GHC.Types.Type)-                 (t :: [a0123456789]) =-        Map t t-    instance SuppressUnusedWarnings MapSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MapSym1KindInference GHC.Tuple.())-    data MapSym1 (l :: TyFun a0123456789 b0123456789 -> GHC.Types.Type)-                 (l :: TyFun [a0123456789] [b0123456789])-      = forall arg. KindOf (Apply (MapSym1 l) arg) ~ KindOf (MapSym2 l arg) =>-        MapSym1KindInference-    type instance Apply (MapSym1 l) l = MapSym2 l l-    instance SuppressUnusedWarnings MapSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MapSym0KindInference GHC.Tuple.())-    data MapSym0 (l :: TyFun (TyFun a0123456789 b0123456789-                              -> GHC.Types.Type) (TyFun [a0123456789] [b0123456789]-                                                  -> GHC.Types.Type))-      = forall arg. KindOf (Apply MapSym0 arg) ~ KindOf (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 _z_0123456789 '[] '[] = '[]-      ZipWith _z_0123456789 ((:) _z_0123456789 _z_0123456789) '[] = '[]-      ZipWith _z_0123456789 '[] ((:) _z_0123456789 _z_0123456789) = '[]-    type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where-      Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789Sym0 ns) bs)) ns) bs-    type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where-      Etad a_0123456789 a_0123456789 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789)) a_0123456789) a_0123456789-    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 _z_0123456789 Nothing = NothingSym0-    type family Map (a :: TyFun a b -> GHC.Types.Type)-                    (a :: [a]) :: [b] where-      Map _z_0123456789 '[] = '[]-      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 sG sA-      = let-          lambda ::-            forall f g a.-            (t ~ f, t ~ g, t ~ a) =>-            Sing f-            -> Sing g-               -> Sing a -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b)-          lambda f g a = applySing (applySing f g) a-        in lambda sF sG sA-    sZipWith sF (SCons sX sXs) (SCons sY sYs)-      = let-          lambda ::-            forall f x xs y ys.-            (t ~ f,-             t ~ Apply (Apply (:$) x) xs,-             t ~ Apply (Apply (:$) y) ys) =>-            Sing f-            -> Sing x-               -> Sing xs-                  -> Sing y-                     -> Sing ys -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c])-          lambda f x xs y ys-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing (applySing f x) y))-                (applySing-                   (applySing-                      (applySing (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith) f) xs)-                   ys)-        in lambda sF sX sXs sY sYs-    sZipWith _s_z_0123456789 SNil SNil-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ '[], t ~ '[]) =>-            Sing _z_0123456789-            -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c])-          lambda _z_0123456789 = SNil-        in lambda _s_z_0123456789-    sZipWith-      _s_z_0123456789-      (SCons _s_z_0123456789 _s_z_0123456789)-      SNil-      = let-          lambda ::-            forall _z_0123456789 _z_0123456789 _z_0123456789.-            (t ~ _z_0123456789,-             t ~ Apply (Apply (:$) _z_0123456789) _z_0123456789,-             t ~ '[]) =>-            Sing _z_0123456789-            -> Sing _z_0123456789-               -> Sing _z_0123456789-                  -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c])-          lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil-        in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789-    sZipWith-      _s_z_0123456789-      SNil-      (SCons _s_z_0123456789 _s_z_0123456789)-      = let-          lambda ::-            forall _z_0123456789 _z_0123456789 _z_0123456789.-            (t ~ _z_0123456789,-             t ~ '[],-             t ~ Apply (Apply (:$) _z_0123456789) _z_0123456789) =>-            Sing _z_0123456789-            -> Sing _z_0123456789-               -> Sing _z_0123456789-                  -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c])-          lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil-        in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789-    sSplunge sNs sBs-      = let-          lambda ::-            forall ns bs.-            (t ~ ns, t ~ bs) =>-            Sing ns -> Sing bs -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat])-          lambda ns bs-            = applySing-                (applySing-                   (applySing-                      (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith)-                      (singFun2-                         (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 ns) bs))-                         (\ sN sB-                            -> let-                                 lambda ::-                                   forall n b.-                                   Sing n-                                   -> Sing b-                                      -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 ns) bs) n) b)-                                 lambda n b-                                   = case b of {-                                       STrue-                                         -> let-                                              lambda ::-                                                TrueSym0 ~ b =>-                                                Sing (Case_0123456789 ns bs n b TrueSym0)-                                              lambda-                                                = applySing-                                                    (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                                                    (applySing-                                                       (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n)-                                            in lambda-                                       SFalse-                                         -> let-                                              lambda ::-                                                FalseSym0 ~ b =>-                                                Sing (Case_0123456789 ns bs n b FalseSym0)-                                              lambda = n-                                            in lambda } ::-                                       Sing (Case_0123456789 ns bs n b b)-                               in lambda sN sB)))-                   ns)-                bs-        in lambda sNs sBs-    sEtad sA_0123456789 sA_0123456789-      = let-          lambda ::-            forall a_0123456789 a_0123456789.-            (t ~ a_0123456789, t ~ a_0123456789) =>-            Sing a_0123456789-            -> Sing a_0123456789 -> Sing (Apply (Apply EtadSym0 t) t :: [Nat])-          lambda a_0123456789 a_0123456789-            = applySing-                (applySing-                   (applySing-                      (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith)-                      (singFun2-                         (Proxy ::-                            Proxy (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789))-                         (\ sN sB-                            -> let-                                 lambda ::-                                   forall n b.-                                   Sing n-                                   -> Sing b-                                      -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) n) b)-                                 lambda n b-                                   = case b of {-                                       STrue-                                         -> let-                                              lambda ::-                                                TrueSym0 ~ b =>-                                                Sing (Case_0123456789 n b a_0123456789 a_0123456789 TrueSym0)-                                              lambda-                                                = applySing-                                                    (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                                                    (applySing-                                                       (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n)-                                            in lambda-                                       SFalse-                                         -> let-                                              lambda ::-                                                FalseSym0 ~ b =>-                                                Sing (Case_0123456789 n b a_0123456789 a_0123456789 FalseSym0)-                                              lambda = n-                                            in lambda } ::-                                       Sing (Case_0123456789 n b a_0123456789 a_0123456789 b)-                               in lambda sN sB)))-                   a_0123456789)-                a_0123456789-        in lambda sA_0123456789 sA_0123456789-    sLiftMaybe sF (SJust sX)-      = let-          lambda ::-            forall f x.-            (t ~ f, t ~ Apply JustSym0 x) =>-            Sing f-            -> Sing x -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b)-          lambda f x-            = applySing-                (singFun1 (Proxy :: Proxy JustSym0) SJust) (applySing f x)-        in lambda sF sX-    sLiftMaybe _s_z_0123456789 SNothing-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ NothingSym0) =>-            Sing _z_0123456789-            -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b)-          lambda _z_0123456789 = SNothing-        in lambda _s_z_0123456789-    sMap _s_z_0123456789 SNil-      = let-          lambda ::-            forall _z_0123456789.-            (t ~ _z_0123456789, t ~ '[]) =>-            Sing _z_0123456789 -> Sing (Apply (Apply MapSym0 t) t :: [b])-          lambda _z_0123456789 = SNil-        in lambda _s_z_0123456789-    sMap sF (SCons sH sT)-      = let-          lambda ::-            forall f h t.-            (t ~ f, t ~ Apply (Apply (:$) h) t) =>-            Sing f-            -> Sing h -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b])-          lambda f h t-            = applySing-                (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) (applySing f h))-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy MapSym0) sMap) f) t)-        in lambda sF sH sT-    data instance Sing (z :: Either a b)-      = forall (n :: a). z ~ Left n => SLeft (Sing (n :: a)) |-        forall (n :: b). z ~ Right n => SRight (Sing (n :: b))-    type SEither = (Sing :: Either a b -> GHC.Types.Type)-    instance (SingKind a, SingKind b) => SingKind (Either a b) where-      type DemoteRep (Either a b) = Either (DemoteRep a) (DemoteRep b)-      fromSing (SLeft b) = Left (fromSing b)-      fromSing (SRight b) = Right (fromSing b)-      toSing (Left b)-        = case toSing b :: SomeSing a of {-            SomeSing c -> SomeSing (SLeft c) }-      toSing (Right 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 (TyCon2 Either) '[Int, Bool] '[Char, Double])-foo1a = Proxy--foo1b :: Proxy ('[Either Int Char, Either Bool Double])-foo1b = foo1a--foo2a :: Proxy (Map (TyCon1 (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.ghc80.template 
@@ -1,299 +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 :: forall a. a -> Maybe a -> a-    foo1 d x-      = \case {-          Just y -> y-          Nothing -> d }-          x-    foo2 :: forall a. a -> Maybe a -> a-    foo2 d _-      = \case {-          Just y -> y-          Nothing -> d }-          (Just d)-    foo3 :: forall a b. a -> b -> a-    foo3 a b = \case { (p, _) -> p } (a, b)-    type family Case_0123456789 a b x_0123456789 t where-      Case_0123456789 a b x_0123456789 '(p, _z_0123456789) = p-    type family Lambda_0123456789 a b t where-      Lambda_0123456789 a b x_0123456789 = Case_0123456789 a b x_0123456789 x_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 d x_0123456789 _z_0123456789 t where-      Case_0123456789 d x_0123456789 _z_0123456789 (Just y) = y-      Case_0123456789 d x_0123456789 _z_0123456789 Nothing = d-    type family Lambda_0123456789 d _z_0123456789 t where-      Lambda_0123456789 d _z_0123456789 x_0123456789 = Case_0123456789 d x_0123456789 _z_0123456789 x_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 d x x_0123456789 t where-      Case_0123456789 d x x_0123456789 (Just y) = y-      Case_0123456789 d x x_0123456789 Nothing = d-    type family Lambda_0123456789 d x t where-      Lambda_0123456789 d x x_0123456789 = Case_0123456789 d x x_0123456789 x_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t-    instance SuppressUnusedWarnings Foo3Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.())-    data Foo3Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) =>-        Foo3Sym1KindInference-    type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 l-    type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) =-        Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789)-                  (l :: TyFun (Maybe a0123456789) a0123456789)-      = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) =-        Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789)-                  (l :: TyFun (Maybe a0123456789) a0123456789)-      = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (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_0123456789Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b)-    type family Foo2 (a :: a) (a :: Maybe a) :: a where-      Foo2 d _z_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789) (Apply JustSym0 d)-    type family Foo1 (a :: a) (a :: Maybe a) :: a where-      Foo1 d x = Apply (Apply (Apply Lambda_0123456789Sym0 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 sB-      = let-          lambda ::-            forall a b.-            (t ~ a, t ~ b) =>-            Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a)-          lambda a b-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 a) b))-                   (\ sX_0123456789-                      -> let-                           lambda ::-                             forall x_0123456789.-                             Sing x_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x_0123456789)-                           lambda x_0123456789-                             = case x_0123456789 of {-                                 STuple2 sP _s_z_0123456789-                                   -> let-                                        lambda ::-                                          forall p _z_0123456789.-                                          Apply (Apply Tuple2Sym0 p) _z_0123456789 ~ x_0123456789 =>-                                          Sing p-                                          -> Sing _z_0123456789-                                             -> Sing (Case_0123456789 a b x_0123456789 (Apply (Apply Tuple2Sym0 p) _z_0123456789))-                                        lambda p _z_0123456789 = p-                                      in lambda sP _s_z_0123456789 } ::-                                 Sing (Case_0123456789 a b x_0123456789 x_0123456789)-                         in lambda sX_0123456789))-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) a) b)-        in lambda sA sB-    sFoo2 sD _s_z_0123456789-      = let-          lambda ::-            forall d _z_0123456789.-            (t ~ d, t ~ _z_0123456789) =>-            Sing d-            -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-          lambda d _z_0123456789-            = applySing-                (singFun1-                   (Proxy ::-                      Proxy (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789))-                   (\ sX_0123456789-                      -> let-                           lambda ::-                             forall x_0123456789.-                             Sing x_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789) x_0123456789)-                           lambda x_0123456789-                             = case x_0123456789 of {-                                 SJust sY-                                   -> let-                                        lambda ::-                                          forall y.-                                          Apply JustSym0 y ~ x_0123456789 =>-                                          Sing y-                                          -> Sing (Case_0123456789 d x_0123456789 _z_0123456789 (Apply JustSym0 y))-                                        lambda y = y-                                      in lambda sY-                                 SNothing-                                   -> let-                                        lambda ::-                                          NothingSym0 ~ x_0123456789 =>-                                          Sing (Case_0123456789 d x_0123456789 _z_0123456789 NothingSym0)-                                        lambda = d-                                      in lambda } ::-                                 Sing (Case_0123456789 d x_0123456789 _z_0123456789 x_0123456789)-                         in lambda sX_0123456789))-                (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) d)-        in lambda sD _s_z_0123456789-    sFoo1 sD sX-      = let-          lambda ::-            forall d x.-            (t ~ d, t ~ x) =>-            Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a)-          lambda d x-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 d) x))-                   (\ sX_0123456789-                      -> let-                           lambda ::-                             forall x_0123456789.-                             Sing x_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 d) x) x_0123456789)-                           lambda x_0123456789-                             = case x_0123456789 of {-                                 SJust sY-                                   -> let-                                        lambda ::-                                          forall y.-                                          Apply JustSym0 y ~ x_0123456789 =>-                                          Sing y-                                          -> Sing (Case_0123456789 d x x_0123456789 (Apply JustSym0 y))-                                        lambda y = y-                                      in lambda sY-                                 SNothing-                                   -> let-                                        lambda ::-                                          NothingSym0 ~ x_0123456789 =>-                                          Sing (Case_0123456789 d x x_0123456789 NothingSym0)-                                        lambda = d-                                      in lambda } ::-                                 Sing (Case_0123456789 d x x_0123456789 x_0123456789)-                         in lambda sX_0123456789))-                x-        in lambda sD 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.ghc80.template 
@@ -1,842 +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 :: forall a b. a -> b -> a-    foo0 = \ x y -> x-    foo1 :: forall a b. a -> b -> a-    foo1 x = \ _ -> x-    foo2 :: forall a b. a -> b -> a-    foo2 x y = (\ _ -> x) y-    foo3 :: forall a. a -> a-    foo3 x = (\ y -> y) x-    foo4 :: forall a b c. a -> b -> c -> a-    foo4 x y z = (\ _ _ -> x) y z-    foo5 :: forall a b. a -> b -> b-    foo5 x y = (\ x -> x) y-    foo6 :: forall a b. a -> b -> a-    foo6 a b = (\ x -> \ _ -> x) a b-    foo7 :: forall a b. a -> b -> b-    foo7 x y = (\ (_, b) -> b) (x, y)-    data Foo a b = Foo a b-    foo8 :: forall a b. Foo a b -> a-    foo8 x = (\ (Foo a _) -> a) x-    type FooSym2 (t :: a0123456789) (t :: b0123456789) = Foo t t-    instance SuppressUnusedWarnings FooSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.())-    data FooSym1 (l :: a0123456789)-                 (l :: TyFun b0123456789 (Foo a0123456789 b0123456789))-      = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (Foo a0123456789 b0123456789)-                                          -> GHC.Types.Type))-      = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    type family Case_0123456789 x arg_0123456789 t where-      Case_0123456789 x arg_0123456789 (Foo a _z_0123456789) = a-    type family Lambda_0123456789 x t where-      Lambda_0123456789 x arg_0123456789 = Case_0123456789 x arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x y arg_0123456789 t where-      Case_0123456789 x y arg_0123456789 '(_z_0123456789, b) = b-    type family Lambda_0123456789 x y t where-      Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 a b x arg_0123456789 t where-      Case_0123456789 a b x arg_0123456789 _z_0123456789 = x-    type family Lambda_0123456789 a b x t where-      Lambda_0123456789 a b x arg_0123456789 = Case_0123456789 a b x arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Lambda_0123456789 a b t where-      Lambda_0123456789 a b x = Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Lambda_0123456789 x y t where-      Lambda_0123456789 x y x = x-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x-                                y-                                z-                                arg_0123456789-                                arg_0123456789-                                t where-      Case_0123456789 x y z arg_0123456789 arg_0123456789 '(_z_0123456789,-                                                            _z_0123456789) = x-    type family Lambda_0123456789 x y z t t where-      Lambda_0123456789 x y z arg_0123456789 arg_0123456789 = Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789)-    type Lambda_0123456789Sym5 t t t t t = Lambda_0123456789 t t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym4 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym4KindInference GHC.Tuple.())-    data Lambda_0123456789Sym4 l l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym4 l l l l) arg) ~ KindOf (Lambda_0123456789Sym5 l l l l arg) =>-        Lambda_0123456789Sym4KindInference-    type instance Apply (Lambda_0123456789Sym4 l l l l) l = Lambda_0123456789Sym5 l l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Lambda_0123456789 x t where-      Lambda_0123456789 x y = y-    type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x y arg_0123456789 t where-      Case_0123456789 x y arg_0123456789 _z_0123456789 = x-    type family Lambda_0123456789 x y t where-      Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x arg_0123456789 a_0123456789 t where-      Case_0123456789 x arg_0123456789 a_0123456789 _z_0123456789 = x-    type family Lambda_0123456789 x a_0123456789 t where-      Lambda_0123456789 x a_0123456789 arg_0123456789 = Case_0123456789 x arg_0123456789 a_0123456789 arg_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Lambda_0123456789 a_0123456789 a_0123456789 t t where-      Lambda_0123456789 a_0123456789 a_0123456789 x y = x-    type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type Foo8Sym1 (t :: Foo a0123456789 b0123456789) = Foo8 t-    instance SuppressUnusedWarnings Foo8Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo8Sym0KindInference GHC.Tuple.())-    data Foo8Sym0 (l :: TyFun (Foo a0123456789 b0123456789) a0123456789)-      = forall arg. KindOf (Apply Foo8Sym0 arg) ~ KindOf (Foo8Sym1 arg) =>-        Foo8Sym0KindInference-    type instance Apply Foo8Sym0 l = Foo8Sym1 l-    type Foo7Sym2 (t :: a0123456789) (t :: b0123456789) = Foo7 t t-    instance SuppressUnusedWarnings Foo7Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo7Sym1KindInference GHC.Tuple.())-    data Foo7Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 b0123456789)-      = forall arg. KindOf (Apply (Foo7Sym1 l) arg) ~ KindOf (Foo7Sym2 l arg) =>-        Foo7Sym1KindInference-    type instance Apply (Foo7Sym1 l) l = Foo7Sym2 l l-    instance SuppressUnusedWarnings Foo7Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo7Sym0KindInference GHC.Tuple.())-    data Foo7Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo7Sym0 arg) ~ KindOf (Foo7Sym1 arg) =>-        Foo7Sym0KindInference-    type instance Apply Foo7Sym0 l = Foo7Sym1 l-    type Foo6Sym2 (t :: a0123456789) (t :: b0123456789) = Foo6 t t-    instance SuppressUnusedWarnings Foo6Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo6Sym1KindInference GHC.Tuple.())-    data Foo6Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo6Sym1 l) arg) ~ KindOf (Foo6Sym2 l arg) =>-        Foo6Sym1KindInference-    type instance Apply (Foo6Sym1 l) l = Foo6Sym2 l l-    instance SuppressUnusedWarnings Foo6Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo6Sym0KindInference GHC.Tuple.())-    data Foo6Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo6Sym0 arg) ~ KindOf (Foo6Sym1 arg) =>-        Foo6Sym0KindInference-    type instance Apply Foo6Sym0 l = Foo6Sym1 l-    type Foo5Sym2 (t :: a0123456789) (t :: b0123456789) = Foo5 t t-    instance SuppressUnusedWarnings Foo5Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo5Sym1KindInference GHC.Tuple.())-    data Foo5Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 b0123456789)-      = forall arg. KindOf (Apply (Foo5Sym1 l) arg) ~ KindOf (Foo5Sym2 l arg) =>-        Foo5Sym1KindInference-    type instance Apply (Foo5Sym1 l) l = Foo5Sym2 l l-    instance SuppressUnusedWarnings Foo5Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.())-    data Foo5Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5Sym1 l-    type Foo4Sym3 (t :: a0123456789)-                  (t :: b0123456789)-                  (t :: c0123456789) =-        Foo4 t t t-    instance SuppressUnusedWarnings Foo4Sym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo4Sym2KindInference GHC.Tuple.())-    data Foo4Sym2 (l :: a0123456789)-                  (l :: b0123456789)-                  (l :: TyFun c0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo4Sym2 l l) arg) ~ KindOf (Foo4Sym3 l l arg) =>-        Foo4Sym2KindInference-    type instance Apply (Foo4Sym2 l l) l = Foo4Sym3 l l l-    instance SuppressUnusedWarnings Foo4Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo4Sym1KindInference GHC.Tuple.())-    data Foo4Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 (TyFun c0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply (Foo4Sym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 a0123456789-                                                              -> GHC.Types.Type)-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4Sym1 l-    type Foo3Sym1 (t :: a0123456789) = Foo3 t-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 l-    type Foo2Sym2 (t :: a0123456789) (t :: b0123456789) = Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789) (t :: b0123456789) = Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    type Foo0Sym2 (t :: a0123456789) (t :: b0123456789) = Foo0 t t-    instance SuppressUnusedWarnings Foo0Sym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo0Sym1KindInference GHC.Tuple.())-    data Foo0Sym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 a0123456789)-      = forall arg. KindOf (Apply (Foo0Sym1 l) arg) ~ KindOf (Foo0Sym2 l arg) =>-        Foo0Sym1KindInference-    type instance Apply (Foo0Sym1 l) l = Foo0Sym2 l l-    instance SuppressUnusedWarnings Foo0Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo0Sym0KindInference GHC.Tuple.())-    data Foo0Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply Foo0Sym0 arg) ~ KindOf (Foo0Sym1 arg) =>-        Foo0Sym0KindInference-    type instance Apply Foo0Sym0 l = Foo0Sym1 l-    type family Foo8 (a :: Foo a b) :: a where-      Foo8 x = Apply (Apply Lambda_0123456789Sym0 x) x-    type family Foo7 (a :: a) (a :: b) :: b where-      Foo7 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y)-    type family Foo6 (a :: a) (a :: b) :: a where-      Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) a) b-    type family Foo5 (a :: a) (a :: b) :: b where-      Foo5 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y-    type family Foo4 (a :: a) (a :: b) (a :: c) :: a where-      Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z) y) z-    type family Foo3 (a :: a) :: a where-      Foo3 x = Apply (Apply Lambda_0123456789Sym0 x) x-    type family Foo2 (a :: a) (a :: b) :: a where-      Foo2 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y-    type family Foo1 (a :: a) (a :: b) :: a where-      Foo1 x a_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) a_0123456789-    type family Foo0 (a :: a) (a :: b) :: a where-      Foo0 a_0123456789 a_0123456789 = Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789-    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-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: a)-          lambda x-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x))-                   (\ sArg_0123456789-                      -> let-                           lambda ::-                             forall arg_0123456789.-                             Sing arg_0123456789-                             -> Sing (Apply (Apply Lambda_0123456789Sym0 x) arg_0123456789)-                           lambda arg_0123456789-                             = case arg_0123456789 of {-                                 SFoo sA _s_z_0123456789-                                   -> let-                                        lambda ::-                                          forall a _z_0123456789.-                                          Apply (Apply FooSym0 a) _z_0123456789 ~ arg_0123456789 =>-                                          Sing a-                                          -> Sing _z_0123456789-                                             -> Sing (Case_0123456789 x arg_0123456789 (Apply (Apply FooSym0 a) _z_0123456789))-                                        lambda a _z_0123456789 = a-                                      in lambda sA _s_z_0123456789 } ::-                                 Sing (Case_0123456789 x arg_0123456789 arg_0123456789)-                         in lambda sArg_0123456789))-                x-        in lambda sX-    sFoo7 sX sY-      = let-          lambda ::-            forall x y.-            (t ~ x, t ~ y) =>-            Sing x -> Sing y -> Sing (Apply (Apply Foo7Sym0 t) t :: b)-          lambda x y-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y))-                   (\ sArg_0123456789-                      -> let-                           lambda ::-                             forall arg_0123456789.-                             Sing arg_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789)-                           lambda arg_0123456789-                             = case arg_0123456789 of {-                                 STuple2 _s_z_0123456789 sB-                                   -> let-                                        lambda ::-                                          forall _z_0123456789 b.-                                          Apply (Apply Tuple2Sym0 _z_0123456789) b ~ arg_0123456789 =>-                                          Sing _z_0123456789-                                          -> Sing b-                                             -> Sing (Case_0123456789 x y arg_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) b))-                                        lambda _z_0123456789 b = b-                                      in lambda _s_z_0123456789 sB } ::-                                 Sing (Case_0123456789 x y arg_0123456789 arg_0123456789)-                         in lambda sArg_0123456789))-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y)-        in lambda sX sY-    sFoo6 sA sB-      = let-          lambda ::-            forall a b.-            (t ~ a, t ~ b) =>-            Sing a -> Sing b -> Sing (Apply (Apply Foo6Sym0 t) t :: a)-          lambda a b-            = applySing-                (applySing-                   (singFun1-                      (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 a) b))-                      (\ sX-                         -> let-                              lambda ::-                                forall x.-                                Sing x -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x)-                              lambda x-                                = singFun1-                                    (Proxy ::-                                       Proxy (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x))-                                    (\ sArg_0123456789-                                       -> let-                                            lambda ::-                                              forall arg_0123456789.-                                              Sing arg_0123456789-                                              -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x) arg_0123456789)-                                            lambda arg_0123456789-                                              = case arg_0123456789 of {-                                                  _s_z_0123456789-                                                    -> let-                                                         lambda ::-                                                           forall _z_0123456789.-                                                           _z_0123456789 ~ arg_0123456789 =>-                                                           Sing _z_0123456789-                                                           -> Sing (Case_0123456789 a b x arg_0123456789 _z_0123456789)-                                                         lambda _z_0123456789 = x-                                                       in lambda _s_z_0123456789 } ::-                                                  Sing (Case_0123456789 a b x arg_0123456789 arg_0123456789)-                                          in lambda sArg_0123456789)-                            in lambda sX))-                   a)-                b-        in lambda sA sB-    sFoo5 sX sY-      = let-          lambda ::-            forall x y.-            (t ~ x, t ~ y) =>-            Sing x -> Sing y -> Sing (Apply (Apply Foo5Sym0 t) t :: b)-          lambda x y-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y))-                   (\ sX-                      -> let-                           lambda ::-                             forall x.-                             Sing x -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) x)-                           lambda x = x-                         in lambda sX))-                y-        in lambda sX sY-    sFoo4 sX sY sZ-      = let-          lambda ::-            forall x y z.-            (t ~ x, t ~ y, t ~ z) =>-            Sing x-            -> Sing y-               -> Sing z -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a)-          lambda x y z-            = applySing-                (applySing-                   (singFun2-                      (Proxy ::-                         Proxy (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z))-                      (\ sArg_0123456789 sArg_0123456789-                         -> let-                              lambda ::-                                forall arg_0123456789 arg_0123456789.-                                Sing arg_0123456789-                                -> Sing arg_0123456789-                                   -> Sing (Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z) arg_0123456789) arg_0123456789)-                              lambda arg_0123456789 arg_0123456789-                                = case-                                      applySing-                                        (applySing-                                           (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2)-                                           arg_0123456789)-                                        arg_0123456789-                                  of {-                                    STuple2 _s_z_0123456789 _s_z_0123456789-                                      -> let-                                           lambda ::-                                             forall _z_0123456789 _z_0123456789.-                                             Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789 ~ Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789 =>-                                             Sing _z_0123456789-                                             -> Sing _z_0123456789-                                                -> Sing (Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789))-                                           lambda _z_0123456789 _z_0123456789 = x-                                         in lambda _s_z_0123456789 _s_z_0123456789 } ::-                                    Sing (Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789))-                            in lambda sArg_0123456789 sArg_0123456789))-                   y)-                z-        in lambda sX sY sZ-    sFoo3 sX-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: a)-          lambda x-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x))-                   (\ sY-                      -> let-                           lambda ::-                             forall y. Sing y -> Sing (Apply (Apply Lambda_0123456789Sym0 x) y)-                           lambda y = y-                         in lambda sY))-                x-        in lambda sX-    sFoo2 sX sY-      = let-          lambda ::-            forall x y.-            (t ~ x, t ~ y) =>-            Sing x -> Sing y -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-          lambda x y-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y))-                   (\ sArg_0123456789-                      -> let-                           lambda ::-                             forall arg_0123456789.-                             Sing arg_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789)-                           lambda arg_0123456789-                             = case arg_0123456789 of {-                                 _s_z_0123456789-                                   -> let-                                        lambda ::-                                          forall _z_0123456789.-                                          _z_0123456789 ~ arg_0123456789 =>-                                          Sing _z_0123456789-                                          -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789)-                                        lambda _z_0123456789 = x-                                      in lambda _s_z_0123456789 } ::-                                 Sing (Case_0123456789 x y arg_0123456789 arg_0123456789)-                         in lambda sArg_0123456789))-                y-        in lambda sX sY-    sFoo1 sX sA_0123456789-      = let-          lambda ::-            forall x a_0123456789.-            (t ~ x, t ~ a_0123456789) =>-            Sing x-            -> Sing a_0123456789 -> Sing (Apply (Apply Foo1Sym0 t) t :: a)-          lambda x a_0123456789-            = applySing-                (singFun1-                   (Proxy ::-                      Proxy (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789))-                   (\ sArg_0123456789-                      -> let-                           lambda ::-                             forall arg_0123456789.-                             Sing arg_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) arg_0123456789)-                           lambda arg_0123456789-                             = case arg_0123456789 of {-                                 _s_z_0123456789-                                   -> let-                                        lambda ::-                                          forall _z_0123456789.-                                          _z_0123456789 ~ arg_0123456789 =>-                                          Sing _z_0123456789-                                          -> Sing (Case_0123456789 x arg_0123456789 a_0123456789 _z_0123456789)-                                        lambda _z_0123456789 = x-                                      in lambda _s_z_0123456789 } ::-                                 Sing (Case_0123456789 x arg_0123456789 a_0123456789 arg_0123456789)-                         in lambda sArg_0123456789))-                a_0123456789-        in lambda sX sA_0123456789-    sFoo0 sA_0123456789 sA_0123456789-      = let-          lambda ::-            forall a_0123456789 a_0123456789.-            (t ~ a_0123456789, t ~ a_0123456789) =>-            Sing a_0123456789-            -> Sing a_0123456789 -> Sing (Apply (Apply Foo0Sym0 t) t :: a)-          lambda a_0123456789 a_0123456789-            = applySing-                (applySing-                   (singFun2-                      (Proxy ::-                         Proxy (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789))-                      (\ sX sY-                         -> let-                              lambda ::-                                forall x y.-                                Sing x-                                -> Sing y-                                   -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) x) y)-                              lambda x y = x-                            in lambda sX sY))-                   a_0123456789)-                a_0123456789-        in lambda sA_0123456789 sA_0123456789-    data instance Sing (z :: Foo a b)-      = forall (n :: a) (n :: b). z ~ Foo n n =>-        SFoo (Sing (n :: a)) (Sing (n :: b))-    type SFoo = (Sing :: Foo a b -> GHC.Types.Type)-    instance (SingKind a, SingKind b) => SingKind (Foo a b) where-      type DemoteRep (Foo a b) = Foo (DemoteRep a) (DemoteRep b)-      fromSing (SFoo b b) = Foo (fromSing b) (fromSing b)-      toSing (Foo b 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 -fno-warn-unused-matches -fno-warn-name-shadowing -fno-warn-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.ghc80.template 
@@ -1,81 +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_0123456789 t where-      Lambda_0123456789 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x-    type Lambda_0123456789Sym1 t = Lambda_0123456789 t-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 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_0123456789Sym0) (Apply (Apply (:$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[]))-    sBar :: Sing (BarSym0 :: [Nat])-    sFoo :: Sing (FooSym0 :: [Nat])-    sBar-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy MapSym0) sMap)-             (applySing-                (applySing-                   (singFun3 (Proxy :: Proxy Either_Sym0) sEither_)-                   (singFun1 (Proxy :: Proxy PredSym0) sPred))-                (singFun1 (Proxy :: Proxy SuccSym0) SSucc)))-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing (singFun1 (Proxy :: Proxy LeftSym0) SLeft) SZero))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (singFun1 (Proxy :: Proxy RightSym0) SRight)-                      (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)))-                SNil))-    sFoo-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy MapSym0) sMap)-             (singFun1-                (Proxy :: Proxy Lambda_0123456789Sym0)-                (\ sX-                   -> let-                        lambda :: forall x. Sing x -> Sing (Apply Lambda_0123456789Sym0 x)-                        lambda x-                          = applySing-                              (applySing-                                 (applySing-                                    (singFun3 (Proxy :: Proxy Either_Sym0) sEither_)-                                    (singFun1 (Proxy :: Proxy PredSym0) sPred))-                                 (singFun1 (Proxy :: Proxy SuccSym0) SSucc))-                              x-                      in lambda sX)))-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing (singFun1 (Proxy :: Proxy LeftSym0) SLeft) SZero))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (singFun1 (Proxy :: Proxy RightSym0) SRight)-                      (applySing (singFun1 (Proxy :: Proxy 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.ghc80.template 
@@ -1,1032 +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_ :: forall a. a -> a-    foo13_ y = y-    foo14 :: Nat -> (Nat, Nat)-    foo14 x = let (y, z) = (Succ x, x) in (z, y)-    type family Case_0123456789 x t where-      Case_0123456789 x '(y_0123456789, _z_0123456789) = y_0123456789-    type family Case_0123456789 x t where-      Case_0123456789 x '(_z_0123456789, y_0123456789) = y_0123456789-    type Let0123456789YSym1 t = Let0123456789Y t-    instance SuppressUnusedWarnings Let0123456789YSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.())-    data Let0123456789YSym0 l-      = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) =>-        Let0123456789YSym0KindInference-    type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l-    type Let0123456789ZSym1 t = Let0123456789Z t-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type Let0123456789X_0123456789Sym1 t = Let0123456789X_0123456789 t-    instance SuppressUnusedWarnings Let0123456789X_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789X_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789X_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789X_0123456789Sym0 arg) ~ KindOf (Let0123456789X_0123456789Sym1 arg) =>-        Let0123456789X_0123456789Sym0KindInference-    type instance Apply Let0123456789X_0123456789Sym0 l = Let0123456789X_0123456789Sym1 l-    type family Let0123456789Y x where-      Let0123456789Y x = Case_0123456789 x (Let0123456789X_0123456789Sym1 x)-    type family Let0123456789Z x where-      Let0123456789Z x = Case_0123456789 x (Let0123456789X_0123456789Sym1 x)-    type family Let0123456789X_0123456789 x where-      Let0123456789X_0123456789 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x-    type Let0123456789BarSym1 t = Let0123456789Bar t-    instance SuppressUnusedWarnings Let0123456789BarSym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Let0123456789BarSym0KindInference GHC.Tuple.())-    data Let0123456789BarSym0 l-      = forall arg. KindOf (Apply Let0123456789BarSym0 arg) ~ KindOf (Let0123456789BarSym1 arg) =>-        Let0123456789BarSym0KindInference-    type instance Apply Let0123456789BarSym0 l = Let0123456789BarSym1 l-    type family Let0123456789Bar x :: a where-      Let0123456789Bar 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) =>-        (:<<<%%%%%%%%%%:+$$###)-    type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l-    instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.())-    data (:<<<%%%%%%%%%%:+$) l-      = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) 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 Let0123456789ZSym1 t = Let0123456789Z t-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) =>-        (:<<<%%%%%%%%%%:+$$###)-    type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l-    instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.())-    data (:<<<%%%%%%%%%%:+$) l-      = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) arg) =>-        (:<<<%%%%%%%%%%:+$###)-    type instance Apply (:<<<%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%:+$$) l-    type family Let0123456789Z x :: Nat where-      Let0123456789Z 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) 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. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) =>-        (:<<<%%%%%%%%%%:+$$###)-    type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l-    instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.())-    data (:<<<%%%%%%%%%%:+$) l-      = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) 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_0123456789 x a_0123456789 t where-      Lambda_0123456789 x a_0123456789 x = x-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type Let0123456789ZSym2 t (t :: Nat) = Let0123456789Z t t-    instance SuppressUnusedWarnings Let0123456789ZSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.())-    data Let0123456789ZSym1 l (l :: TyFun Nat Nat)-      = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) =>-        Let0123456789ZSym1KindInference-    type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type family Let0123456789Z x (a :: Nat) :: Nat where-      Let0123456789Z x a_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) a_0123456789-    type family Lambda_0123456789 x t where-      Lambda_0123456789 x x = x-    type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type Let0123456789ZSym1 t = Let0123456789Z t-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type family Let0123456789Z x :: Nat where-      Let0123456789Z x = Apply (Apply Lambda_0123456789Sym0 x) ZeroSym0-    type Let0123456789XSym1 t = Let0123456789X t-    instance SuppressUnusedWarnings Let0123456789XSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789XSym0KindInference GHC.Tuple.())-    data Let0123456789XSym0 l-      = forall arg. KindOf (Apply Let0123456789XSym0 arg) ~ KindOf (Let0123456789XSym1 arg) =>-        Let0123456789XSym0KindInference-    type instance Apply Let0123456789XSym0 l = Let0123456789XSym1 l-    type family Let0123456789X x :: Nat where-      Let0123456789X x = ZeroSym0-    type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t-    instance SuppressUnusedWarnings Let0123456789FSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.())-    data Let0123456789FSym1 l (l :: TyFun Nat Nat)-      = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) =>-        Let0123456789FSym1KindInference-    type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l-    instance SuppressUnusedWarnings Let0123456789FSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.())-    data Let0123456789FSym0 l-      = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) =>-        Let0123456789FSym0KindInference-    type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l-    type family Let0123456789F x (a :: Nat) :: Nat where-      Let0123456789F x y = Apply SuccSym0 y-    type Let0123456789ZSym1 t = Let0123456789Z t-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type family Let0123456789Z x :: Nat where-      Let0123456789Z x = Apply (Let0123456789FSym1 x) x-    type Let0123456789ZSym2 t t = Let0123456789Z t t-    instance SuppressUnusedWarnings Let0123456789ZSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.())-    data Let0123456789ZSym1 l l-      = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) =>-        Let0123456789ZSym1KindInference-    type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l-    instance SuppressUnusedWarnings Let0123456789ZSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.())-    data Let0123456789ZSym0 l-      = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) =>-        Let0123456789ZSym0KindInference-    type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l-    type family Let0123456789Z x y :: Nat where-      Let0123456789Z x y = Apply SuccSym0 y-    type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t-    instance SuppressUnusedWarnings Let0123456789FSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.())-    data Let0123456789FSym1 l (l :: TyFun Nat Nat)-      = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) =>-        Let0123456789FSym1KindInference-    type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l-    instance SuppressUnusedWarnings Let0123456789FSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.())-    data Let0123456789FSym0 l-      = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) =>-        Let0123456789FSym0KindInference-    type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l-    type family Let0123456789F x (a :: Nat) :: Nat where-      Let0123456789F x y = Apply SuccSym0 (Let0123456789ZSym2 x y)-    type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t-    instance SuppressUnusedWarnings Let0123456789FSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.())-    data Let0123456789FSym1 l (l :: TyFun Nat Nat)-      = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) =>-        Let0123456789FSym1KindInference-    type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l-    instance SuppressUnusedWarnings Let0123456789FSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.())-    data Let0123456789FSym0 l-      = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) =>-        Let0123456789FSym0KindInference-    type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l-    type family Let0123456789F x (a :: Nat) :: Nat where-      Let0123456789F x y = Apply SuccSym0 y-    type Let0123456789YSym1 t = Let0123456789Y t-    instance SuppressUnusedWarnings Let0123456789YSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.())-    data Let0123456789YSym0 l-      = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) =>-        Let0123456789YSym0KindInference-    type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l-    type family Let0123456789Y x :: Nat where-      Let0123456789Y x = Apply SuccSym0 x-    type Let0123456789YSym0 = Let0123456789Y-    type Let0123456789ZSym0 = Let0123456789Z-    type family Let0123456789Y where-      Let0123456789Y = Apply SuccSym0 ZeroSym0-    type family Let0123456789Z where-      Let0123456789Z = Apply SuccSym0 Let0123456789YSym0-    type Let0123456789YSym1 t = Let0123456789Y t-    instance SuppressUnusedWarnings Let0123456789YSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.())-    data Let0123456789YSym0 l-      = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) =>-        Let0123456789YSym0KindInference-    type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l-    type family Let0123456789Y x :: Nat where-      Let0123456789Y 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. KindOf (Apply Foo14Sym0 arg) ~ KindOf (Foo14Sym1 arg) =>-        Foo14Sym0KindInference-    type instance Apply Foo14Sym0 l = Foo14Sym1 l-    type Foo13_Sym1 (t :: a0123456789) = Foo13_ t-    instance SuppressUnusedWarnings Foo13_Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo13_Sym0KindInference GHC.Tuple.())-    data Foo13_Sym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply Foo13_Sym0 arg) ~ KindOf (Foo13_Sym1 arg) =>-        Foo13_Sym0KindInference-    type instance Apply Foo13_Sym0 l = Foo13_Sym1 l-    type Foo13Sym1 (t :: a0123456789) = Foo13 t-    instance SuppressUnusedWarnings Foo13Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo13Sym0KindInference GHC.Tuple.())-    data Foo13Sym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply Foo13Sym0 arg) ~ KindOf (Foo13Sym1 arg) =>-        Foo13Sym0KindInference-    type instance Apply Foo13Sym0 l = Foo13Sym1 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. KindOf (Apply Foo12Sym0 arg) ~ KindOf (Foo12Sym1 arg) =>-        Foo12Sym0KindInference-    type instance Apply Foo12Sym0 l = Foo12Sym1 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. KindOf (Apply Foo11Sym0 arg) ~ KindOf (Foo11Sym1 arg) =>-        Foo11Sym0KindInference-    type instance Apply Foo11Sym0 l = Foo11Sym1 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. KindOf (Apply Foo10Sym0 arg) ~ KindOf (Foo10Sym1 arg) =>-        Foo10Sym0KindInference-    type instance Apply Foo10Sym0 l = Foo10Sym1 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. KindOf (Apply Foo9Sym0 arg) ~ KindOf (Foo9Sym1 arg) =>-        Foo9Sym0KindInference-    type instance Apply Foo9Sym0 l = Foo9Sym1 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. KindOf (Apply Foo8Sym0 arg) ~ KindOf (Foo8Sym1 arg) =>-        Foo8Sym0KindInference-    type instance Apply Foo8Sym0 l = Foo8Sym1 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. KindOf (Apply Foo7Sym0 arg) ~ KindOf (Foo7Sym1 arg) =>-        Foo7Sym0KindInference-    type instance Apply Foo7Sym0 l = Foo7Sym1 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. KindOf (Apply Foo6Sym0 arg) ~ KindOf (Foo6Sym1 arg) =>-        Foo6Sym0KindInference-    type instance Apply Foo6Sym0 l = Foo6Sym1 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. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5Sym1 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. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4Sym1 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. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 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. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    type family Foo14 (a :: Nat) :: (Nat, Nat) where-      Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789ZSym1 x)) (Let0123456789YSym1 x)-    type family Foo13_ (a :: a) :: a where-      Foo13_ y = y-    type family Foo13 (a :: a) :: a where-      Foo13 x = Apply Foo13_Sym0 (Let0123456789BarSym1 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)) (Let0123456789ZSym1 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 (Let0123456789ZSym1 x) x-    type family Foo8 (a :: Nat) :: Nat where-      Foo8 x = Let0123456789ZSym1 x-    type family Foo7 (a :: Nat) :: Nat where-      Foo7 x = Let0123456789XSym1 x-    type family Foo6 (a :: Nat) :: Nat where-      Foo6 x = Let0123456789ZSym1 x-    type family Foo5 (a :: Nat) :: Nat where-      Foo5 x = Apply (Let0123456789FSym1 x) x-    type family Foo4 (a :: Nat) :: Nat where-      Foo4 x = Apply (Let0123456789FSym1 x) x-    type family Foo3 (a :: Nat) :: Nat where-      Foo3 x = Let0123456789YSym1 x-    type family Foo2 :: Nat where-      Foo2 = Let0123456789ZSym0-    type family Foo1 (a :: Nat) :: Nat where-      Foo1 x = Let0123456789YSym1 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-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo14Sym0 t :: (Nat, Nat))-          lambda x-            = let-                sY :: Sing (Let0123456789YSym1 x)-                sZ :: Sing (Let0123456789ZSym1 x)-                sX_0123456789 :: Sing (Let0123456789X_0123456789Sym1 x)-                sY-                  = case sX_0123456789 of {-                      STuple2 sY_0123456789 _s_z_0123456789-                        -> let-                             lambda ::-                               forall y_0123456789 _z_0123456789.-                               Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789 ~ Let0123456789X_0123456789Sym1 x =>-                               Sing y_0123456789-                               -> Sing _z_0123456789-                                  -> Sing (Case_0123456789 x (Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789))-                             lambda y_0123456789 _z_0123456789 = y_0123456789-                           in lambda sY_0123456789 _s_z_0123456789 } ::-                      Sing (Case_0123456789 x (Let0123456789X_0123456789Sym1 x))-                sZ-                  = case sX_0123456789 of {-                      STuple2 _s_z_0123456789 sY_0123456789-                        -> let-                             lambda ::-                               forall _z_0123456789 y_0123456789.-                               Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789 ~ Let0123456789X_0123456789Sym1 x =>-                               Sing _z_0123456789-                               -> Sing y_0123456789-                                  -> Sing (Case_0123456789 x (Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789))-                             lambda _z_0123456789 y_0123456789 = y_0123456789-                           in lambda _s_z_0123456789 sY_0123456789 } ::-                      Sing (Case_0123456789 x (Let0123456789X_0123456789Sym1 x))-                sX_0123456789-                  = applySing-                      (applySing-                         (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2)-                         (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) x))-                      x-              in-                applySing-                  (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) sZ) sY-        in lambda sX-    sFoo13_ sY-      = let-          lambda ::-            forall y. t ~ y => Sing y -> Sing (Apply Foo13_Sym0 t :: a)-          lambda y = y-        in lambda sY-    sFoo13 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo13Sym0 t :: a)-          lambda x-            = let-                sBar :: Sing (Let0123456789BarSym1 x :: a)-                sBar = x-              in applySing (singFun1 (Proxy :: Proxy Foo13_Sym0) sFoo13_) sBar-        in lambda sX-    sFoo12 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo12Sym0 t :: Nat)-          lambda x-            = let-                (%:+) ::-                  forall (t :: Nat) (t :: Nat).-                  Sing t-                  -> Sing t-                     -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                (%:+) SZero sM-                  = let-                      lambda ::-                        forall m.-                        (t ~ ZeroSym0, t ~ m) =>-                        Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda m = m-                    in lambda sM-                (%:+) (SSucc sN) sM-                  = let-                      lambda ::-                        forall n m.-                        (t ~ Apply SuccSym0 n, t ~ m) =>-                        Sing n-                        -> Sing m-                           -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda n m-                        = applySing-                            (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                            (applySing-                               (applySing-                                  (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n)-                               x)-                    in lambda sN sM-              in-                applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) x)-                  (applySing-                     (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                     (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-        in lambda sX-    sFoo11 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo11Sym0 t :: Nat)-          lambda x-            = let-                sZ :: Sing (Let0123456789ZSym1 x :: Nat)-                (%:+) ::-                  forall (t :: Nat) (t :: Nat).-                  Sing t-                  -> Sing t-                     -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                sZ = x-                (%:+) SZero sM-                  = let-                      lambda ::-                        forall m.-                        (t ~ ZeroSym0, t ~ m) =>-                        Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda m = m-                    in lambda sM-                (%:+) (SSucc sN) sM-                  = let-                      lambda ::-                        forall n m.-                        (t ~ Apply SuccSym0 n, t ~ m) =>-                        Sing n-                        -> Sing m-                           -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda n m-                        = applySing-                            (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                            (applySing-                               (applySing-                                  (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n)-                               m)-                    in lambda sN sM-              in-                applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+))-                     (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                  sZ-        in lambda sX-    sFoo10 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo10Sym0 t :: Nat)-          lambda x-            = let-                (%:+) ::-                  forall (t :: Nat) (t :: Nat).-                  Sing t-                  -> Sing t-                     -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                (%:+) SZero sM-                  = let-                      lambda ::-                        forall m.-                        (t ~ ZeroSym0, t ~ m) =>-                        Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda m = m-                    in lambda sM-                (%:+) (SSucc sN) sM-                  = let-                      lambda ::-                        forall n m.-                        (t ~ Apply SuccSym0 n, t ~ m) =>-                        Sing n-                        -> Sing m-                           -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat)-                      lambda n m-                        = applySing-                            (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                            (applySing-                               (applySing-                                  (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n)-                               m)-                    in lambda sN sM-              in-                applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+))-                     (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                  x-        in lambda sX-    sFoo9 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo9Sym0 t :: Nat)-          lambda x-            = let-                sZ ::-                  forall (t :: Nat).-                  Sing t -> Sing (Apply (Let0123456789ZSym1 x) t :: Nat)-                sZ sA_0123456789-                  = let-                      lambda ::-                        forall a_0123456789.-                        t ~ a_0123456789 =>-                        Sing a_0123456789 -> Sing (Apply (Let0123456789ZSym1 x) t :: Nat)-                      lambda a_0123456789-                        = applySing-                            (singFun1-                               (Proxy ::-                                  Proxy (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789))-                               (\ sX-                                  -> let-                                       lambda ::-                                         forall x.-                                         Sing x-                                         -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) x)-                                       lambda x = x-                                     in lambda sX))-                            a_0123456789-                    in lambda sA_0123456789-              in-                applySing (singFun1 (Proxy :: Proxy (Let0123456789ZSym1 x)) sZ) x-        in lambda sX-    sFoo8 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: Nat)-          lambda x-            = let-                sZ :: Sing (Let0123456789ZSym1 x :: Nat)-                sZ-                  = applySing-                      (singFun1-                         (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x))-                         (\ sX-                            -> let-                                 lambda ::-                                   forall x.-                                   Sing x -> Sing (Apply (Apply Lambda_0123456789Sym0 x) x)-                                 lambda x = x-                               in lambda sX))-                      SZero-              in sZ-        in lambda sX-    sFoo7 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo7Sym0 t :: Nat)-          lambda x-            = let-                sX :: Sing (Let0123456789XSym1 x :: Nat)-                sX = SZero-              in sX-        in lambda sX-    sFoo6 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo6Sym0 t :: Nat)-          lambda x-            = let-                sF ::-                  forall (t :: Nat).-                  Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                sF sY-                  = let-                      lambda ::-                        forall y.-                        t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                      lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y-                    in lambda sY in-              let-                sZ :: Sing (Let0123456789ZSym1 x :: Nat)-                sZ-                  = applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x-              in sZ-        in lambda sX-    sFoo5 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: Nat)-          lambda x-            = let-                sF ::-                  forall (t :: Nat).-                  Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                sF sY-                  = let-                      lambda ::-                        forall y.-                        t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                      lambda y-                        = let-                            sZ :: Sing (Let0123456789ZSym2 x y :: Nat)-                            sZ = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y-                          in applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) sZ-                    in lambda sY-              in-                applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x-        in lambda sX-    sFoo4 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: Nat)-          lambda x-            = let-                sF ::-                  forall (t :: Nat).-                  Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                sF sY-                  = let-                      lambda ::-                        forall y.-                        t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat)-                      lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y-                    in lambda sY-              in-                applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x-        in lambda sX-    sFoo3 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: Nat)-          lambda x-            = let-                sY :: Sing (Let0123456789YSym1 x :: Nat)-                sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) x-              in sY-        in lambda sX-    sFoo2-      = let-          sY :: Sing Let0123456789YSym0-          sZ :: Sing Let0123456789ZSym0-          sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero-          sZ = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) sY-        in sZ-    sFoo1 sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply Foo1Sym0 t :: Nat)-          lambda x-            = let-                sY :: Sing (Let0123456789YSym1 x :: Nat)-                sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero-              in sY-        in lambda sX
− tests/compile-and-dump/Singletons/LetStatements.hs 
@@ -1,193 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-binds   -fno-warn-unused-matches-                -fno-warn-name-shadowing -fno-warn-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.ghc80.template 
@@ -1,63 +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 family Equals_0123456789 (a :: Maybe k)-                                  (b :: Maybe k) :: Bool where-      Equals_0123456789 Nothing Nothing = TrueSym0-      Equals_0123456789 (Just a) (Just b) = (:==) a b-      Equals_0123456789 (a :: Maybe k) (b :: Maybe k) = FalseSym0-    instance PEq (Proxy :: Proxy (Maybe k)) where-      type (:==) (a :: Maybe k) (b :: Maybe k) = Equals_0123456789 a b-    type NothingSym0 = Nothing-    type JustSym1 (t :: a0123456789) = Just t-    instance SuppressUnusedWarnings JustSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) JustSym0KindInference GHC.Tuple.())-    data JustSym0 (l :: TyFun a0123456789 (Maybe a0123456789))-      = forall arg. KindOf (Apply JustSym0 arg) ~ KindOf (JustSym1 arg) =>-        JustSym0KindInference-    type instance Apply JustSym0 l = JustSym1 l-    data instance Sing (z :: Maybe a)-      = z ~ Nothing => SNothing |-        forall (n :: a). z ~ Just n => SJust (Sing (n :: a))-    type SMaybe = (Sing :: Maybe a -> GHC.Types.Type)-    instance SingKind a => SingKind (Maybe a) where-      type DemoteRep (Maybe a) = Maybe (DemoteRep a)-      fromSing SNothing = Nothing-      fromSing (SJust b) = Just (fromSing b)-      toSing Nothing = SomeSing SNothing-      toSing (Just b)-        = case toSing b :: SomeSing a of {-            SomeSing c -> SomeSing (SJust c) }-    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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SJust _) SNothing-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SJust a) (SJust b)-        = case (%~) a b of {-            Proved Refl -> Proved Refl-            Disproved contra-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) }-    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,11 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Singletons.Maybe where--import Data.Singletons.TH-import Data.Singletons.SuppressUnusedWarnings-import Prelude hiding (Maybe, Nothing, Just)--$(singletons [d|-  data Maybe a = Nothing | Just a deriving (Eq, Show)- |])
− tests/compile-and-dump/Singletons/Nat.ghc80.template 
@@ -1,145 +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) |]-  ======>-    data Nat-      where-        Zero :: Nat-        Succ :: Nat -> Nat-      deriving (Eq, Show, Read)-    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 family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where-      Equals_0123456789 Zero Zero = TrueSym0-      Equals_0123456789 (Succ a) (Succ b) = (:==) a b-      Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0-    instance PEq (Proxy :: Proxy Nat) where-      type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b-    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. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = SuccSym1 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. KindOf (Apply PredSym0 arg) ~ KindOf (PredSym1 arg) =>-        PredSym0KindInference-    type instance Apply PredSym0 l = PredSym1 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. KindOf (Apply (PlusSym1 l) arg) ~ KindOf (PlusSym2 l arg) =>-        PlusSym1KindInference-    type instance Apply (PlusSym1 l) l = PlusSym2 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. KindOf (Apply PlusSym0 arg) ~ KindOf (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)-    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-      = let-          lambda :: t ~ ZeroSym0 => Sing (Apply PredSym0 t :: Nat)-          lambda = SZero-        in lambda-    sPred (SSucc sN)-      = let-          lambda ::-            forall n.-            t ~ Apply SuccSym0 n => Sing n -> Sing (Apply PredSym0 t :: Nat)-          lambda n = n-        in lambda sN-    sPlus SZero sM-      = let-          lambda ::-            forall m.-            (t ~ ZeroSym0, t ~ m) =>-            Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat)-          lambda m = m-        in lambda sM-    sPlus (SSucc sN) sM-      = let-          lambda ::-            forall n m.-            (t ~ Apply SuccSym0 n, t ~ m) =>-            Sing n -> Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat)-          lambda n m-            = applySing-                (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                (applySing-                   (applySing (singFun2 (Proxy :: Proxy PlusSym0) sPlus) n) m)-        in lambda sN sM-    data instance Sing (z :: Nat)-      = z ~ Zero => SZero |-        forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat))-    type SNat = (Sing :: Nat -> GHC.Types.Type)-    instance SingKind Nat where-      type DemoteRep Nat = Nat-      fromSing SZero = Zero-      fromSing (SSucc b) = Succ (fromSing b)-      toSing Zero = SomeSing SZero-      toSing (Succ b)-        = case toSing b :: SomeSing Nat of {-            SomeSing c -> SomeSing (SSucc c) }-    instance SEq Nat where-      (%:==) SZero SZero = STrue-      (%:==) SZero (SSucc _) = SFalse-      (%:==) (SSucc _) SZero = SFalse-      (%:==) (SSucc a) (SSucc b) = (%:==) a b-    instance SDecide Nat where-      (%~) SZero SZero = Proved Refl-      (%~) SZero (SSucc _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SSucc _) SZero-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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
− tests/compile-and-dump/Singletons/Nat.hs 
@@ -1,23 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Singletons.Nat where--import Data.Singletons.TH-import Data.Singletons-import Data.Proxy-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|-  data Nat where-    Zero :: Nat-    Succ :: Nat -> Nat-      deriving (Eq, Show, Read)--  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.ghc80.template 
@@ -1,126 +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. KindOf (Apply ((:+:$$) l) arg) ~ KindOf ((:+:$$$) 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. KindOf (Apply (:+:$) arg) ~ KindOf ((:+:$$) 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. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) 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. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) 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. KindOf (Apply ChildSym0 arg) ~ KindOf (ChildSym1 arg) =>-        ChildSym0KindInference-    type instance Apply ChildSym0 l = ChildSym1 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 _z_0123456789) = 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-      = let-          lambda ::-            forall m.-            (t ~ ZeroSym0, t ~ m) =>-            Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)-          lambda m = m-        in lambda sM-    (%:+) (SSucc sN) sM-      = let-          lambda ::-            forall n m.-            (t ~ Apply SuccSym0 n, t ~ m) =>-            Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)-          lambda n m-            = applySing-                (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                (applySing (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) n) m)-        in lambda sN sM-    sChild SFLeaf-      = let-          lambda :: t ~ FLeafSym0 => Sing (Apply ChildSym0 t :: Foo)-          lambda = SFLeaf-        in lambda-    sChild ((:%+:) sA _s_z_0123456789)-      = let-          lambda ::-            forall a _z_0123456789.-            t ~ Apply (Apply (:+:$) a) _z_0123456789 =>-            Sing a -> Sing _z_0123456789 -> Sing (Apply ChildSym0 t :: Foo)-          lambda a _z_0123456789 = a-        in lambda sA _s_z_0123456789-    data instance Sing (z :: Foo)-      = z ~ FLeaf => SFLeaf |-        forall (n :: Foo) (n :: Foo). z ~ (:+:) n n =>-        (:%+:) (Sing (n :: Foo)) (Sing (n :: Foo))-    type SFoo = (Sing :: Foo -> GHC.Types.Type)-    instance SingKind Foo where-      type DemoteRep Foo = Foo-      fromSing SFLeaf = FLeaf-      fromSing ((:%+:) b b) = (:+:) (fromSing b) (fromSing b)-      toSing FLeaf = SomeSing SFLeaf-      toSing ((:+:) b b)-        = 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,23 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Singletons.Operators where--import Data.Proxy-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.ghc80.template 
@@ -1,2913 +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 family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where-      Equals_0123456789 Zero Zero = TrueSym0-      Equals_0123456789 (Succ a) (Succ b) = (:==) a b-      Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0-    instance PEq (Proxy :: Proxy Nat) where-      type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b-    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. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = SuccSym1 l-    type family Equals_0123456789 (a :: Foo k k k k)-                                  (b :: Foo k k k k) :: Bool where-      Equals_0123456789 (A a a a a) (A b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (B a a a a) (B b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (C a a a a) (C b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (D a a a a) (D b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (E a a a a) (E b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (F a a a a) (F b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b)))-      Equals_0123456789 (a :: Foo k k k k) (b :: Foo k k k k) = FalseSym0-    instance PEq (Proxy :: Proxy (Foo k k k k)) where-      type (:==) (a :: Foo k k k k) (b :: Foo k k k k) = Equals_0123456789 a b-    type ASym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        A t t t t-    instance SuppressUnusedWarnings ASym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ASym3KindInference GHC.Tuple.())-    data ASym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (ASym3 l l l) arg) ~ KindOf (ASym4 l l l arg) =>-        ASym3KindInference-    type instance Apply (ASym3 l l l) l = ASym4 l l l l-    instance SuppressUnusedWarnings ASym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ASym2KindInference GHC.Tuple.())-    data ASym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (ASym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (ASym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply ASym0 arg) ~ KindOf (ASym1 arg) =>-        ASym0KindInference-    type instance Apply ASym0 l = ASym1 l-    type BSym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        B t t t t-    instance SuppressUnusedWarnings BSym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) BSym3KindInference GHC.Tuple.())-    data BSym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (BSym3 l l l) arg) ~ KindOf (BSym4 l l l arg) =>-        BSym3KindInference-    type instance Apply (BSym3 l l l) l = BSym4 l l l l-    instance SuppressUnusedWarnings BSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) BSym2KindInference GHC.Tuple.())-    data BSym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (BSym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (BSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply BSym0 arg) ~ KindOf (BSym1 arg) =>-        BSym0KindInference-    type instance Apply BSym0 l = BSym1 l-    type CSym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        C t t t t-    instance SuppressUnusedWarnings CSym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) CSym3KindInference GHC.Tuple.())-    data CSym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (CSym3 l l l) arg) ~ KindOf (CSym4 l l l arg) =>-        CSym3KindInference-    type instance Apply (CSym3 l l l) l = CSym4 l l l l-    instance SuppressUnusedWarnings CSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) CSym2KindInference GHC.Tuple.())-    data CSym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (CSym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (CSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply CSym0 arg) ~ KindOf (CSym1 arg) =>-        CSym0KindInference-    type instance Apply CSym0 l = CSym1 l-    type DSym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        D t t t t-    instance SuppressUnusedWarnings DSym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) DSym3KindInference GHC.Tuple.())-    data DSym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (DSym3 l l l) arg) ~ KindOf (DSym4 l l l arg) =>-        DSym3KindInference-    type instance Apply (DSym3 l l l) l = DSym4 l l l l-    instance SuppressUnusedWarnings DSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) DSym2KindInference GHC.Tuple.())-    data DSym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (DSym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (DSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply DSym0 arg) ~ KindOf (DSym1 arg) =>-        DSym0KindInference-    type instance Apply DSym0 l = DSym1 l-    type ESym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        E t t t t-    instance SuppressUnusedWarnings ESym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ESym3KindInference GHC.Tuple.())-    data ESym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (ESym3 l l l) arg) ~ KindOf (ESym4 l l l arg) =>-        ESym3KindInference-    type instance Apply (ESym3 l l l) l = ESym4 l l l l-    instance SuppressUnusedWarnings ESym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) ESym2KindInference GHC.Tuple.())-    data ESym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (ESym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (ESym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply ESym0 arg) ~ KindOf (ESym1 arg) =>-        ESym0KindInference-    type instance Apply ESym0 l = ESym1 l-    type FSym4 (t :: a0123456789)-               (t :: b0123456789)-               (t :: c0123456789)-               (t :: d0123456789) =-        F t t t t-    instance SuppressUnusedWarnings FSym3 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FSym3KindInference GHC.Tuple.())-    data FSym3 (l :: a0123456789)-               (l :: b0123456789)-               (l :: c0123456789)-               (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789))-      = forall arg. KindOf (Apply (FSym3 l l l) arg) ~ KindOf (FSym4 l l l arg) =>-        FSym3KindInference-    type instance Apply (FSym3 l l l) l = FSym4 l l l l-    instance SuppressUnusedWarnings FSym2 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) FSym2KindInference GHC.Tuple.())-    data FSym2 (l :: a0123456789)-               (l :: b0123456789)-               (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (FSym2 l l) arg) ~ KindOf (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 :: a0123456789)-               (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply (FSym1 l) arg) ~ KindOf (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 a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                                                              -> GHC.Types.Type)-                                                           -> GHC.Types.Type)-                                        -> GHC.Types.Type))-      = forall arg. KindOf (Apply FSym0 arg) ~ KindOf (FSym1 arg) =>-        FSym0KindInference-    type instance Apply FSym0 l = FSym1 l-    type family Compare_0123456789 (a :: Nat)-                                   (a :: Nat) :: Ordering where-      Compare_0123456789 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]-      Compare_0123456789 (Succ a_0123456789) (Succ b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])-      Compare_0123456789 Zero (Succ _z_0123456789) = LTSym0-      Compare_0123456789 (Succ _z_0123456789) Zero = GTSym0-    type Compare_0123456789Sym2 (t :: Nat) (t :: Nat) =-        Compare_0123456789 t t-    instance SuppressUnusedWarnings Compare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.())-    data Compare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) =>-        Compare_0123456789Sym1KindInference-    type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Compare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.())-    data Compare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                 -> GHC.Types.Type))-      = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) =>-        Compare_0123456789Sym0KindInference-    type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l-    instance POrd (Proxy :: Proxy Nat) where-      type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789Sym0 a) a-    type family Compare_0123456789 (a :: Foo a b c d)-                                   (a :: Foo a b c d) :: Ordering where-      Compare_0123456789 (A a_0123456789 a_0123456789 a_0123456789 a_0123456789) (A b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (B a_0123456789 a_0123456789 a_0123456789 a_0123456789) (B b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (C a_0123456789 a_0123456789 a_0123456789 a_0123456789) (C b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (D a_0123456789 a_0123456789 a_0123456789 a_0123456789) (D b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (E a_0123456789 a_0123456789 a_0123456789 a_0123456789) (E b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (F a_0123456789 a_0123456789 a_0123456789 a_0123456789) (F b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))))-      Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-      Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0-    type Compare_0123456789Sym2 (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789) =-        Compare_0123456789 t t-    instance SuppressUnusedWarnings Compare_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.())-    data Compare_0123456789Sym1 (l :: Foo a0123456789 b0123456789 c0123456789 d0123456789)-                                (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering)-      = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) =>-        Compare_0123456789Sym1KindInference-    type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l-    instance SuppressUnusedWarnings Compare_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.())-    data Compare_0123456789Sym0 (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) (TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering-                                                                                                   -> GHC.Types.Type))-      = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) =>-        Compare_0123456789Sym0KindInference-    type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l-    instance POrd (Proxy :: Proxy (Foo a b c d)) where-      type Compare (a :: Foo a b c d) (a :: Foo a b c d) = Apply (Apply Compare_0123456789Sym0 a) a-    data instance Sing (z :: Nat)-      = z ~ Zero => SZero |-        forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat))-    type SNat = (Sing :: Nat -> GHC.Types.Type)-    instance SingKind Nat where-      type DemoteRep Nat = Nat-      fromSing SZero = Zero-      fromSing (SSucc b) = Succ (fromSing b)-      toSing Zero = SomeSing SZero-      toSing (Succ b)-        = case toSing b :: SomeSing Nat of {-            SomeSing c -> SomeSing (SSucc c) }-    instance SEq Nat where-      (%:==) SZero SZero = STrue-      (%:==) SZero (SSucc _) = SFalse-      (%:==) (SSucc _) SZero = SFalse-      (%:==) (SSucc a) (SSucc b) = (%:==) a b-    instance SDecide Nat where-      (%~) SZero SZero = Proved Refl-      (%~) SZero (SSucc _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SSucc _) SZero-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SSucc a) (SSucc b)-        = case (%~) a b of {-            Proved Refl -> Proved Refl-            Disproved contra-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) }-    data instance Sing (z :: Foo a b c d)-      = forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ A n n n n =>-        SA (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) |-        forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ B n n n n =>-        SB (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) |-        forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ C n n n n =>-        SC (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) |-        forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ D n n n n =>-        SD (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) |-        forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ E n n n n =>-        SE (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) |-        forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ F n n n n =>-        SF (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d))-    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 DemoteRep (Foo a b c d) = Foo (DemoteRep a) (DemoteRep b) (DemoteRep c) (DemoteRep 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 b b b)-        = 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 b b b)-        = 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 b b b)-        = 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 b b b)-        = 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 b b b)-        = 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 b b b)-        = 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 (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SA _ _ _ _) (SC _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SA _ _ _ _) (SD _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SA _ _ _ _) (SE _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SA _ _ _ _) (SF _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SB _ _ _ _) (SA _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SB _ _ _ _) (SD _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SB _ _ _ _) (SE _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SB _ _ _ _) (SF _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SC _ _ _ _) (SA _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SC _ _ _ _) (SB _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SC _ _ _ _) (SE _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SC _ _ _ _) (SF _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SD _ _ _ _) (SA _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SD _ _ _ _) (SB _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SD _ _ _ _) (SC _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SD _ _ _ _) (SF _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SE _ _ _ _) (SA _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SE _ _ _ _) (SB _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SE _ _ _ _) (SC _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SE _ _ _ _) (SD _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SF _ _ _ _) (SA _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SF _ _ _ _) (SB _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SF _ _ _ _) (SC _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SF _ _ _ _) (SD _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SF _ _ _ _) (SE _ _ _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 SOrd Nat => SOrd Nat where-      sCompare ::-        forall (t0 :: Nat) (t1 :: Nat).-        Sing t0-        -> Sing t1-           -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering-                                                            -> GHC.Types.Type)-                                                 -> GHC.Types.Type) t0 :: TyFun Nat Ordering-                                                                          -> GHC.Types.Type) t1 :: Ordering)-      sCompare SZero SZero-        = let-            lambda ::-              (t0 ~ ZeroSym0, t1 ~ ZeroSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  SNil-          in lambda-      sCompare (SSucc sA_0123456789) (SSucc sB_0123456789)-        = let-            lambda ::-              forall a_0123456789 b_0123456789.-              (t0 ~ Apply SuccSym0 a_0123456789,-               t1 ~ Apply SuccSym0 b_0123456789) =>-              Sing a_0123456789-              -> Sing b_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda a_0123456789 b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     SNil)-          in lambda sA_0123456789 sB_0123456789-      sCompare SZero (SSucc _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sCompare (SSucc _s_z_0123456789) SZero-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-    instance (SOrd a, SOrd b, SOrd c, SOrd d) =>-             SOrd (Foo a b c d) where-      sCompare ::-        forall (t0 :: Foo a b c d) (t1 :: Foo a b c d).-        Sing t0-        -> Sing t1-           -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering-                                                                      -> GHC.Types.Type)-                                                 -> GHC.Types.Type) t0 :: TyFun (Foo a b c d) Ordering-                                                                          -> GHC.Types.Type) t1 :: Ordering)-      sCompare-        (SA sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SA sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SB sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SB sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SC sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SC sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SD sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SD sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SE sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SE sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SF sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789)-        (SF sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789-                     a_0123456789-                     a_0123456789-                     a_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789-                     b_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing a_0123456789-                    -> Sing a_0123456789-                       -> Sing b_0123456789-                          -> Sing b_0123456789-                             -> Sing b_0123456789-                                -> Sing b_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              a_0123456789-              a_0123456789-              a_0123456789-              a_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy (:$)) SCons)-                              (applySing-                                 (applySing-                                    (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                                 b_0123456789))-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy (:$)) SCons)-                                 (applySing-                                    (applySing-                                       (singFun2 (Proxy :: Proxy CompareSym0) sCompare)-                                       a_0123456789)-                                    b_0123456789))-                              SNil))))-          in-            lambda-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sA_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-              sB_0123456789-      sCompare-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SLT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SA _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SB _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SC _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SD _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-      sCompare-        (SF _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        (SE _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789-            _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789-                     _z_0123456789.-              (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789,-               t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing _z_0123456789-                       -> Sing _z_0123456789-                          -> Sing _z_0123456789-                             -> Sing _z_0123456789-                                -> Sing _z_0123456789-                                   -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              _z_0123456789-              = SGT-          in-            lambda-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-              _s_z_0123456789-    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/PatternMatching.ghc80.template 
@@ -1,586 +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 :: a0123456789) (t :: b0123456789) = Pair t t-    instance SuppressUnusedWarnings PairSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.())-    data PairSym1 (l :: a0123456789)-                  (l :: TyFun b0123456789 (Pair a0123456789 b0123456789))-      = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = PairSym2 l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.())-    data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789)-                                           -> GHC.Types.Type))-      = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (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) '[])-    sAList :: Sing AListSym0-    sTuple :: Sing TupleSym0-    sComplex :: Sing ComplexSym0-    sPr :: Sing PrSym0-    sAList-      = applySing-          (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero)-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing-                      (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                      (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)))-                SNil))-    sTuple-      = applySing-          (applySing-             (applySing (singFun3 (Proxy :: Proxy Tuple3Sym0) STuple3) SFalse)-             (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero))-          STrue-    sComplex-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy PairSym0) SPair)-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy PairSym0) SPair)-                   (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero))-                SZero))-          SFalse-    sPr-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy PairSym0) SPair)-             (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) SNil)-    data instance Sing (z :: Pair a b)-      = forall (n :: a) (n :: b). z ~ Pair n n =>-        SPair (Sing (n :: a)) (Sing (n :: b))-    type SPair = (Sing :: Pair a b -> GHC.Types.Type)-    instance (SingKind a, SingKind b) => SingKind (Pair a b) where-      type DemoteRep (Pair a b) = Pair (DemoteRep a) (DemoteRep b)-      fromSing (SPair b b) = Pair (fromSing b) (fromSing b)-      toSing (Pair b b)-        = case-              GHC.Tuple.(,) (toSing b :: SomeSing a) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SPair c c) }-    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 :: forall a b. (a, b) -> a-    foo1 (x, y) = (\ _ -> x) y-    foo2 :: forall a b. (# a, b #) -> a-    foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b }-    silly :: forall a. a -> ()-    silly x = case x of { _ -> GHC.Tuple.() }-    type family Case_0123456789 x t where-      Case_0123456789 x _z_0123456789 = Tuple0Sym0-    type Let0123456789TSym2 t t = Let0123456789T t t-    instance SuppressUnusedWarnings Let0123456789TSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789TSym1KindInference GHC.Tuple.())-    data Let0123456789TSym1 l l-      = forall arg. KindOf (Apply (Let0123456789TSym1 l) arg) ~ KindOf (Let0123456789TSym2 l arg) =>-        Let0123456789TSym1KindInference-    type instance Apply (Let0123456789TSym1 l) l = Let0123456789TSym2 l l-    instance SuppressUnusedWarnings Let0123456789TSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Let0123456789TSym0KindInference GHC.Tuple.())-    data Let0123456789TSym0 l-      = forall arg. KindOf (Apply Let0123456789TSym0 arg) ~ KindOf (Let0123456789TSym1 arg) =>-        Let0123456789TSym0KindInference-    type instance Apply Let0123456789TSym0 l = Let0123456789TSym1 l-    type family Let0123456789T x y where-      Let0123456789T x y = Apply (Apply Tuple2Sym0 x) y-    type family Case_0123456789 x y a b arg_0123456789 t where-      Case_0123456789 x y a b arg_0123456789 _z_0123456789 = a-    type family Lambda_0123456789 x y a b t where-      Lambda_0123456789 x y a b arg_0123456789 = Case_0123456789 x y a b arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym5 t t t t t = Lambda_0123456789 t t t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym4 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym4KindInference GHC.Tuple.())-    data Lambda_0123456789Sym4 l l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym4 l l l l) arg) ~ KindOf (Lambda_0123456789Sym5 l l l l arg) =>-        Lambda_0123456789Sym4KindInference-    type instance Apply (Lambda_0123456789Sym4 l l l l) l = Lambda_0123456789Sym5 l l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym3 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.())-    data Lambda_0123456789Sym3 l l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) =>-        Lambda_0123456789Sym3KindInference-    type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 x y t where-      Case_0123456789 x y '(a,-                            b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b) b-    type family Case_0123456789 x y arg_0123456789 t where-      Case_0123456789 x y arg_0123456789 _z_0123456789 = x-    type family Lambda_0123456789 x y t where-      Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789-    type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t-    instance SuppressUnusedWarnings Lambda_0123456789Sym2 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.())-    data Lambda_0123456789Sym2 l l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) =>-        Lambda_0123456789Sym2KindInference-    type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym1 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.())-    data Lambda_0123456789Sym1 l l-      = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) =>-        Lambda_0123456789Sym1KindInference-    type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l-    type family Case_0123456789 t where-      Case_0123456789 '[_z_0123456789,-                        y_0123456789,-                        Succ _z_0123456789] = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '[_z_0123456789,-                        _z_0123456789,-                        Succ y_0123456789] = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '(y_0123456789,-                        _z_0123456789,-                        _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '(_z_0123456789,-                        y_0123456789,-                        _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '(_z_0123456789,-                        _z_0123456789,-                        y_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Pair (Pair y_0123456789 _z_0123456789) _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Pair (Pair _z_0123456789 y_0123456789) _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Pair (Pair _z_0123456789 _z_0123456789) y_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Pair y_0123456789 _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Pair _z_0123456789 y_0123456789) = y_0123456789-    type SillySym1 (t :: a0123456789) = Silly t-    instance SuppressUnusedWarnings SillySym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) SillySym0KindInference GHC.Tuple.())-    data SillySym0 (l :: TyFun a0123456789 ())-      = forall arg. KindOf (Apply SillySym0 arg) ~ KindOf (SillySym1 arg) =>-        SillySym0KindInference-    type instance Apply SillySym0 l = SillySym1 l-    type Foo2Sym1 (t :: (a0123456789, b0123456789)) = Foo2 t-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789)-      = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym1 (t :: (a0123456789, b0123456789)) = Foo1 t-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789)-      = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 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_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    type family Silly (a :: a) :: () where-      Silly x = Case_0123456789 x x-    type family Foo2 (a :: (a, b)) :: a where-      Foo2 '(x, y) = Case_0123456789 x y (Let0123456789TSym2 x y)-    type family Foo1 (a :: (a, b)) :: a where-      Foo1 '(x, y) = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y-    type family Lsz :: Nat where-      Lsz = Case_0123456789 X_0123456789Sym0-    type family Blimy where-      Blimy = Case_0123456789 X_0123456789Sym0-    type family Tf where-      Tf = Case_0123456789 X_0123456789Sym0-    type family Tjz where-      Tjz = Case_0123456789 X_0123456789Sym0-    type family Tt where-      Tt = Case_0123456789 X_0123456789Sym0-    type family Jz where-      Jz = Case_0123456789 X_0123456789Sym0-    type family Zz where-      Zz = Case_0123456789 X_0123456789Sym0-    type family Fls :: Bool where-      Fls = Case_0123456789 X_0123456789Sym0-    type family Sz where-      Sz = Case_0123456789 X_0123456789Sym0-    type family Lz where-      Lz = Case_0123456789 X_0123456789Sym0-    type family X_0123456789 where-      X_0123456789 = PrSym0-    type family X_0123456789 where-      X_0123456789 = ComplexSym0-    type family X_0123456789 where-      X_0123456789 = TupleSym0-    type family X_0123456789 where-      X_0123456789 = 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_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sSilly sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply SillySym0 t :: ())-          lambda x-            = case x of {-                _s_z_0123456789-                  -> let-                       lambda ::-                         forall _z_0123456789.-                         _z_0123456789 ~ x =>-                         Sing _z_0123456789 -> Sing (Case_0123456789 x _z_0123456789 :: ())-                       lambda _z_0123456789 = STuple0-                     in lambda _s_z_0123456789 } ::-                Sing (Case_0123456789 x x :: ())-        in lambda sX-    sFoo2 (STuple2 sX sY)-      = let-          lambda ::-            forall x y.-            t ~ Apply (Apply Tuple2Sym0 x) y =>-            Sing x -> Sing y -> Sing (Apply Foo2Sym0 t :: a)-          lambda x y-            = let-                sT :: Sing (Let0123456789TSym2 x y)-                sT-                  = applySing-                      (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y-              in  case sT of {-                    STuple2 sA sB-                      -> let-                           lambda ::-                             forall a b.-                             Apply (Apply Tuple2Sym0 a) b ~ Let0123456789TSym2 x y =>-                             Sing a-                             -> Sing b-                                -> Sing (Case_0123456789 x y (Apply (Apply Tuple2Sym0 a) b) :: a)-                           lambda a b-                             = applySing-                                 (singFun1-                                    (Proxy ::-                                       Proxy (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b))-                                    (\ sArg_0123456789-                                       -> let-                                            lambda ::-                                              forall arg_0123456789.-                                              Sing arg_0123456789-                                              -> Sing (Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b) arg_0123456789)-                                            lambda arg_0123456789-                                              = case arg_0123456789 of {-                                                  _s_z_0123456789-                                                    -> let-                                                         lambda ::-                                                           forall _z_0123456789.-                                                           _z_0123456789 ~ arg_0123456789 =>-                                                           Sing _z_0123456789-                                                           -> Sing (Case_0123456789 x y a b arg_0123456789 _z_0123456789)-                                                         lambda _z_0123456789 = a-                                                       in lambda _s_z_0123456789 } ::-                                                  Sing (Case_0123456789 x y a b arg_0123456789 arg_0123456789)-                                          in lambda sArg_0123456789))-                                 b-                         in lambda sA sB } ::-                    Sing (Case_0123456789 x y (Let0123456789TSym2 x y) :: a)-        in lambda sX sY-    sFoo1 (STuple2 sX sY)-      = let-          lambda ::-            forall x y.-            t ~ Apply (Apply Tuple2Sym0 x) y =>-            Sing x -> Sing y -> Sing (Apply Foo1Sym0 t :: a)-          lambda x y-            = applySing-                (singFun1-                   (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y))-                   (\ sArg_0123456789-                      -> let-                           lambda ::-                             forall arg_0123456789.-                             Sing arg_0123456789-                             -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789)-                           lambda arg_0123456789-                             = case arg_0123456789 of {-                                 _s_z_0123456789-                                   -> let-                                        lambda ::-                                          forall _z_0123456789.-                                          _z_0123456789 ~ arg_0123456789 =>-                                          Sing _z_0123456789-                                          -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789)-                                        lambda _z_0123456789 = x-                                      in lambda _s_z_0123456789 } ::-                                 Sing (Case_0123456789 x y arg_0123456789 arg_0123456789)-                         in lambda sArg_0123456789))-                y-        in lambda sX sY-    sLsz-      = case sX_0123456789 of {-          SCons _s_z_0123456789-                (SCons sY_0123456789 (SCons (SSucc _s_z_0123456789) SNil))-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789 _z_0123456789.-                   Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[])) ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing _z_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[]))) :: Nat)-                 lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Nat)-    sBlimy-      = case sX_0123456789 of {-          SCons _s_z_0123456789-                (SCons _s_z_0123456789 (SCons (SSucc sY_0123456789) SNil))-            -> let-                 lambda ::-                   forall _z_0123456789 _z_0123456789 y_0123456789.-                   Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) (Apply SuccSym0 y_0123456789)) '[])) ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing _z_0123456789-                      -> Sing y_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) (Apply SuccSym0 y_0123456789)) '[]))))-                 lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sTf-      = case sX_0123456789 of {-          STuple3 sY_0123456789 _s_z_0123456789 _s_z_0123456789-            -> let-                 lambda ::-                   forall y_0123456789 _z_0123456789 _z_0123456789.-                   Apply (Apply (Apply Tuple3Sym0 y_0123456789) _z_0123456789) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing y_0123456789-                   -> Sing _z_0123456789-                      -> Sing _z_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 y_0123456789) _z_0123456789) _z_0123456789))-                 lambda y_0123456789 _z_0123456789 _z_0123456789 = y_0123456789-               in lambda sY_0123456789 _s_z_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sTjz-      = case sX_0123456789 of {-          STuple3 _s_z_0123456789 sY_0123456789 _s_z_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789 _z_0123456789.-                   Apply (Apply (Apply Tuple3Sym0 _z_0123456789) y_0123456789) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing _z_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 _z_0123456789) y_0123456789) _z_0123456789))-                 lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sTt-      = case sX_0123456789 of {-          STuple3 _s_z_0123456789 _s_z_0123456789 sY_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 _z_0123456789 y_0123456789.-                   Apply (Apply (Apply Tuple3Sym0 _z_0123456789) _z_0123456789) y_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing _z_0123456789-                      -> Sing y_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 _z_0123456789) _z_0123456789) y_0123456789))-                 lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sJz-      = case sX_0123456789 of {-          SPair (SPair sY_0123456789 _s_z_0123456789) _s_z_0123456789-            -> let-                 lambda ::-                   forall y_0123456789 _z_0123456789 _z_0123456789.-                   Apply (Apply PairSym0 (Apply (Apply PairSym0 y_0123456789) _z_0123456789)) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing y_0123456789-                   -> Sing _z_0123456789-                      -> Sing _z_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 y_0123456789) _z_0123456789)) _z_0123456789))-                 lambda y_0123456789 _z_0123456789 _z_0123456789 = y_0123456789-               in lambda sY_0123456789 _s_z_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sZz-      = case sX_0123456789 of {-          SPair (SPair _s_z_0123456789 sY_0123456789) _s_z_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789 _z_0123456789.-                   Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) y_0123456789)) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing _z_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) y_0123456789)) _z_0123456789))-                 lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sFls-      = case sX_0123456789 of {-          SPair (SPair _s_z_0123456789 _s_z_0123456789) sY_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 _z_0123456789 y_0123456789.-                   Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing _z_0123456789-                      -> Sing y_0123456789-                         -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789) :: Bool)-                 lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Bool)-    sSz-      = case sX_0123456789 of {-          SPair sY_0123456789 _s_z_0123456789-            -> let-                 lambda ::-                   forall y_0123456789 _z_0123456789.-                   Apply (Apply PairSym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing y_0123456789-                   -> Sing _z_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply PairSym0 y_0123456789) _z_0123456789))-                 lambda y_0123456789 _z_0123456789 = y_0123456789-               in lambda sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sLz-      = case sX_0123456789 of {-          SPair _s_z_0123456789 sY_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789.-                   Apply (Apply PairSym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply PairSym0 _z_0123456789) y_0123456789))-                 lambda _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0)-    sX_0123456789 = sPr-    sX_0123456789 = sComplex-    sX_0123456789 = sTuple-    sX_0123456789 = sAList
− tests/compile-and-dump/Singletons/PatternMatching.hs 
@@ -1,50 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-matches #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}--module Singletons.PatternMatching where--import Data.Singletons.Prelude-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/Records.ghc80.template 
@@ -1,59 +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 a0123456789) = Field1 t-    instance SuppressUnusedWarnings Field1Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Field1Sym0KindInference GHC.Tuple.())-    data Field1Sym0 (l :: TyFun (Record a0123456789) a0123456789)-      = forall arg. KindOf (Apply Field1Sym0 arg) ~ KindOf (Field1Sym1 arg) =>-        Field1Sym0KindInference-    type instance Apply Field1Sym0 l = Field1Sym1 l-    type Field2Sym1 (t :: Record a0123456789) = Field2 t-    instance SuppressUnusedWarnings Field2Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Field2Sym0KindInference GHC.Tuple.())-    data Field2Sym0 (l :: TyFun (Record a0123456789) Bool)-      = forall arg. KindOf (Apply Field2Sym0 arg) ~ KindOf (Field2Sym1 arg) =>-        Field2Sym0KindInference-    type instance Apply Field2Sym0 l = Field2Sym1 l-    type family Field1 (a :: Record a) :: a where-      Field1 (MkRecord field _z_0123456789) = field-    type family Field2 (a :: Record a) :: Bool where-      Field2 (MkRecord _z_0123456789 field) = field-    type MkRecordSym2 (t :: a0123456789) (t :: Bool) = MkRecord t t-    instance SuppressUnusedWarnings MkRecordSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MkRecordSym1KindInference GHC.Tuple.())-    data MkRecordSym1 (l :: a0123456789)-                      (l :: TyFun Bool (Record a0123456789))-      = forall arg. KindOf (Apply (MkRecordSym1 l) arg) ~ KindOf (MkRecordSym2 l arg) =>-        MkRecordSym1KindInference-    type instance Apply (MkRecordSym1 l) l = MkRecordSym2 l l-    instance SuppressUnusedWarnings MkRecordSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MkRecordSym0KindInference GHC.Tuple.())-    data MkRecordSym0 (l :: TyFun a0123456789 (TyFun Bool (Record a0123456789)-                                               -> GHC.Types.Type))-      = forall arg. KindOf (Apply MkRecordSym0 arg) ~ KindOf (MkRecordSym1 arg) =>-        MkRecordSym0KindInference-    type instance Apply MkRecordSym0 l = MkRecordSym1 l-    data instance Sing (z :: Record a)-      = forall (n :: a) (n :: Bool). z ~ MkRecord n n =>-        SMkRecord {sField1 :: (Sing (n :: a)),-                   sField2 :: (Sing (n :: Bool))}-    type SRecord = (Sing :: Record a -> GHC.Types.Type)-    instance SingKind a => SingKind (Record a) where-      type DemoteRep (Record a) = Record (DemoteRep a)-      fromSing (SMkRecord b b) = MkRecord (fromSing b) (fromSing b)-      toSing (MkRecord b b)-        = 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 -fno-warn-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.ghc80.template 
@@ -1,95 +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 :: forall a. a -> a-    id x = x-    idFoo :: forall c a. c -> a -> a-    idFoo _ = id-    type IdSym1 (t :: a0123456789) = Id t-    instance SuppressUnusedWarnings IdSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.())-    data IdSym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) =>-        IdSym0KindInference-    type instance Apply IdSym0 l = IdSym1 l-    type IdFooSym2 (t :: c0123456789) (t :: a0123456789) = IdFoo t t-    instance SuppressUnusedWarnings IdFooSym1 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) IdFooSym1KindInference GHC.Tuple.())-    data IdFooSym1 (l :: c0123456789)-                   (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply (IdFooSym1 l) arg) ~ KindOf (IdFooSym2 l arg) =>-        IdFooSym1KindInference-    type instance Apply (IdFooSym1 l) l = IdFooSym2 l l-    instance SuppressUnusedWarnings IdFooSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) IdFooSym0KindInference GHC.Tuple.())-    data IdFooSym0 (l :: TyFun c0123456789 (TyFun a0123456789 a0123456789-                                            -> GHC.Types.Type))-      = forall arg. KindOf (Apply IdFooSym0 arg) ~ KindOf (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. KindOf (Apply (ReturnFuncSym1 l) arg) ~ KindOf (ReturnFuncSym2 l arg) =>-        ReturnFuncSym1KindInference-    type instance Apply (ReturnFuncSym1 l) l = ReturnFuncSym2 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. KindOf (Apply ReturnFuncSym0 arg) ~ KindOf (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 _z_0123456789 a_0123456789 = Apply IdSym0 a_0123456789-    type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where-      ReturnFunc _z_0123456789 a_0123456789 = Apply SuccSym0 a_0123456789-    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-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a)-          lambda x = x-        in lambda sX-    sIdFoo _s_z_0123456789 sA_0123456789-      = let-          lambda ::-            forall _z_0123456789 a_0123456789.-            (t ~ _z_0123456789, t ~ a_0123456789) =>-            Sing _z_0123456789-            -> Sing a_0123456789 -> Sing (Apply (Apply IdFooSym0 t) t :: a)-          lambda _z_0123456789 a_0123456789-            = applySing (singFun1 (Proxy :: Proxy IdSym0) sId) a_0123456789-        in lambda _s_z_0123456789 sA_0123456789-    sReturnFunc _s_z_0123456789 sA_0123456789-      = let-          lambda ::-            forall _z_0123456789 a_0123456789.-            (t ~ _z_0123456789, t ~ a_0123456789) =>-            Sing _z_0123456789-            -> Sing a_0123456789-               -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat)-          lambda _z_0123456789 a_0123456789-            = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) a_0123456789-        in lambda _s_z_0123456789 sA_0123456789
− tests/compile-and-dump/Singletons/ReturnFunc.hs 
@@ -1,25 +0,0 @@-{-# OPTIONS_GHC -fno-warn-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.ghc80.template 
@@ -1,144 +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_0123456789 t where-      Lambda_0123456789 lhs_0123456789 = Apply (Apply (:+$) lhs_0123456789) (Apply SuccSym0 ZeroSym0)-    type Lambda_0123456789Sym1 t = Lambda_0123456789 t-    instance SuppressUnusedWarnings Lambda_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.())-    data Lambda_0123456789Sym0 l-      = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) =>-        Lambda_0123456789Sym0KindInference-    type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 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. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) 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. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) 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_0123456789Sym0) (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-      = let-          lambda ::-            forall m.-            (t ~ ZeroSym0, t ~ m) =>-            Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)-          lambda m = m-        in lambda sM-    (%:+) (SSucc sN) sM-      = let-          lambda ::-            forall n m.-            (t ~ Apply SuccSym0 n, t ~ m) =>-            Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)-          lambda n m-            = applySing-                (singFun1 (Proxy :: Proxy SuccSym0) SSucc)-                (applySing (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) n) m)-        in lambda sN sM-    sFoo1-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy MapSym0) sMap)-             (applySing-                (singFun2 (Proxy :: Proxy (:+$)) (%:+))-                (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)))-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero)-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                SNil))-    sFoo2-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy MapSym0) sMap)-             (singFun1-                (Proxy :: Proxy Lambda_0123456789Sym0)-                (\ sLhs_0123456789-                   -> let-                        lambda ::-                          forall lhs_0123456789.-                          Sing lhs_0123456789-                          -> Sing (Apply Lambda_0123456789Sym0 lhs_0123456789)-                        lambda lhs_0123456789-                          = applySing-                              (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) lhs_0123456789)-                              (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)-                      in lambda sLhs_0123456789)))-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero)-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                SNil))-    sFoo3-      = applySing-          (applySing-             (applySing-                (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith)-                (singFun2 (Proxy :: Proxy (:+$)) (%:+)))-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                (applySing-                   (applySing-                      (singFun2 (Proxy :: Proxy (:$)) SCons)-                      (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))-                   SNil)))-          (applySing-             (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero)-             (applySing-                (applySing-                   (singFun2 (Proxy :: Proxy (:$)) SCons)-                   (applySing (singFun1 (Proxy :: Proxy 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/Star.ghc80.template 
@@ -1,575 +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, Show, Read)-    type family Equals_0123456789 (a :: Type) (b :: Type) :: Bool where-      Equals_0123456789 Nat Nat = TrueSym0-      Equals_0123456789 Int Int = TrueSym0-      Equals_0123456789 String String = TrueSym0-      Equals_0123456789 (Maybe a) (Maybe b) = (:==) a b-      Equals_0123456789 (Vec a a) (Vec b b) = (:&&) ((:==) a b) ((:==) a b)-      Equals_0123456789 (a :: Type) (b :: Type) = FalseSym0-    instance PEq (Proxy :: Proxy Type) where-      type (:==) (a :: Type) (b :: Type) = Equals_0123456789 a b-    type NatSym0 = Nat-    type IntSym0 = Int-    type StringSym0 = String-    type MaybeSym1 (t :: Type) = Maybe t-    instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings MaybeSym0 where-      Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MaybeSym0KindInference GHC.Tuple.())-    data MaybeSym0 (l :: TyFun Type Type)-      = forall arg. KindOf (Apply MaybeSym0 arg) ~ KindOf (MaybeSym1 arg) =>-        MaybeSym0KindInference-    type instance Apply MaybeSym0 l = MaybeSym1 l-    type VecSym2 (t :: Type) (t :: Nat) = Vec t t-    instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings VecSym1 where-      Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) VecSym1KindInference GHC.Tuple.())-    data VecSym1 (l :: Type) (l :: TyFun Nat Type)-      = forall arg. KindOf (Apply (VecSym1 l) arg) ~ KindOf (VecSym2 l arg) =>-        VecSym1KindInference-    type instance Apply (VecSym1 l) l = VecSym2 l l-    instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings VecSym0 where-      Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) VecSym0KindInference GHC.Tuple.())-    data VecSym0 (l :: TyFun Type (TyFun Nat Type -> Type))-      = forall arg. KindOf (Apply VecSym0 arg) ~ KindOf (VecSym1 arg) =>-        VecSym0KindInference-    type instance Apply VecSym0 l = VecSym1 l-    type family Compare_0123456789 (a :: Type)-                                   (a :: Type) :: Ordering where-      Compare_0123456789 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]-      Compare_0123456789 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]-      Compare_0123456789 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]-      Compare_0123456789 (Maybe a_0123456789) (Maybe b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])-      Compare_0123456789 (Vec a_0123456789 a_0123456789) (Vec b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]))-      Compare_0123456789 Nat Int = LTSym0-      Compare_0123456789 Nat String = LTSym0-      Compare_0123456789 Nat (Maybe _z_0123456789) = LTSym0-      Compare_0123456789 Nat (Vec _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 Int Nat = GTSym0-      Compare_0123456789 Int String = LTSym0-      Compare_0123456789 Int (Maybe _z_0123456789) = LTSym0-      Compare_0123456789 Int (Vec _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 String Nat = GTSym0-      Compare_0123456789 String Int = GTSym0-      Compare_0123456789 String (Maybe _z_0123456789) = LTSym0-      Compare_0123456789 String (Vec _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (Maybe _z_0123456789) Nat = GTSym0-      Compare_0123456789 (Maybe _z_0123456789) Int = GTSym0-      Compare_0123456789 (Maybe _z_0123456789) String = GTSym0-      Compare_0123456789 (Maybe _z_0123456789) (Vec _z_0123456789 _z_0123456789) = LTSym0-      Compare_0123456789 (Vec _z_0123456789 _z_0123456789) Nat = GTSym0-      Compare_0123456789 (Vec _z_0123456789 _z_0123456789) Int = GTSym0-      Compare_0123456789 (Vec _z_0123456789 _z_0123456789) String = GTSym0-      Compare_0123456789 (Vec _z_0123456789 _z_0123456789) (Maybe _z_0123456789) = GTSym0-    type Compare_0123456789Sym2 (t :: Type) (t :: Type) =-        Compare_0123456789 t t-    instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789Sym1 where-      Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.())-    data Compare_0123456789Sym1 (l :: Type) (l :: TyFun Type Ordering)-      = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) =>-        Compare_0123456789Sym1KindInference-    type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l-    instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789Sym0 where-      Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.())-    data Compare_0123456789Sym0 (l :: TyFun Type (TyFun Type Ordering-                                                  -> Type))-      = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) =>-        Compare_0123456789Sym0KindInference-    type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l-    instance POrd (Proxy :: Proxy Type) where-      type Compare (a :: Type) (a :: Type) = Apply (Apply Compare_0123456789Sym0 a) a-    instance (SOrd Type, SOrd Nat) => SOrd Type where-      sCompare ::-        forall (t0 :: Type) (t1 :: Type).-        Sing t0-        -> Sing t1-           -> Sing (Apply (Apply (CompareSym0 :: TyFun Type (TyFun Type Ordering-                                                             -> Type)-                                                 -> Type) t0 :: TyFun Type Ordering-                                                                -> Type) t1 :: Ordering)-      sCompare SNat SNat-        = let-            lambda ::-              (t0 ~ NatSym0, t1 ~ NatSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  SNil-          in lambda-      sCompare SInt SInt-        = let-            lambda ::-              (t0 ~ IntSym0, t1 ~ IntSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  SNil-          in lambda-      sCompare SString SString-        = let-            lambda ::-              (t0 ~ StringSym0, t1 ~ StringSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  SNil-          in lambda-      sCompare (SMaybe sA_0123456789) (SMaybe sB_0123456789)-        = let-            lambda ::-              forall a_0123456789 b_0123456789.-              (t0 ~ Apply MaybeSym0 a_0123456789,-               t1 ~ Apply MaybeSym0 b_0123456789) =>-              Sing a_0123456789-              -> Sing b_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda a_0123456789 b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     SNil)-          in lambda sA_0123456789 sB_0123456789-      sCompare-        (SVec sA_0123456789 sA_0123456789)-        (SVec sB_0123456789 sB_0123456789)-        = let-            lambda ::-              forall a_0123456789 a_0123456789 b_0123456789 b_0123456789.-              (t0 ~ Apply (Apply VecSym0 a_0123456789) a_0123456789,-               t1 ~ Apply (Apply VecSym0 b_0123456789) b_0123456789) =>-              Sing a_0123456789-              -> Sing a_0123456789-                 -> Sing b_0123456789-                    -> Sing b_0123456789-                       -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda a_0123456789 a_0123456789 b_0123456789 b_0123456789-              = applySing-                  (applySing-                     (applySing-                        (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl)-                        (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp))-                     SEQ)-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:$)) SCons)-                        (applySing-                           (applySing-                              (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                           b_0123456789))-                     (applySing-                        (applySing-                           (singFun2 (Proxy :: Proxy (:$)) SCons)-                           (applySing-                              (applySing-                                 (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789)-                              b_0123456789))-                        SNil))-          in lambda sA_0123456789 sA_0123456789 sB_0123456789 sB_0123456789-      sCompare SNat SInt-        = let-            lambda ::-              (t0 ~ NatSym0, t1 ~ IntSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SLT-          in lambda-      sCompare SNat SString-        = let-            lambda ::-              (t0 ~ NatSym0, t1 ~ StringSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SLT-          in lambda-      sCompare SNat (SMaybe _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ NatSym0, t1 ~ Apply MaybeSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sCompare SNat (SVec _s_z_0123456789 _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ NatSym0,-               t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SLT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare SInt SNat-        = let-            lambda ::-              (t0 ~ IntSym0, t1 ~ NatSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SGT-          in lambda-      sCompare SInt SString-        = let-            lambda ::-              (t0 ~ IntSym0, t1 ~ StringSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SLT-          in lambda-      sCompare SInt (SMaybe _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ IntSym0, t1 ~ Apply MaybeSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sCompare SInt (SVec _s_z_0123456789 _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ IntSym0,-               t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SLT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare SString SNat-        = let-            lambda ::-              (t0 ~ StringSym0, t1 ~ NatSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SGT-          in lambda-      sCompare SString SInt-        = let-            lambda ::-              (t0 ~ StringSym0, t1 ~ IntSym0) =>-              Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda = SGT-          in lambda-      sCompare SString (SMaybe _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ StringSym0, t1 ~ Apply MaybeSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SLT-          in lambda _s_z_0123456789-      sCompare SString (SVec _s_z_0123456789 _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ StringSym0,-               t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SLT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare (SMaybe _s_z_0123456789) SNat-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ NatSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sCompare (SMaybe _s_z_0123456789) SInt-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ IntSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sCompare (SMaybe _s_z_0123456789) SString-        = let-            lambda ::-              forall _z_0123456789.-              (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ StringSym0) =>-              Sing _z_0123456789-              -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 = SGT-          in lambda _s_z_0123456789-      sCompare-        (SMaybe _s_z_0123456789)-        (SVec _s_z_0123456789 _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789 _z_0123456789.-              (t0 ~ Apply MaybeSym0 _z_0123456789,-               t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 _z_0123456789 = SLT-          in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789-      sCompare (SVec _s_z_0123456789 _s_z_0123456789) SNat-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789,-               t1 ~ NatSym0) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SGT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare (SVec _s_z_0123456789 _s_z_0123456789) SInt-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789,-               t1 ~ IntSym0) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SGT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare (SVec _s_z_0123456789 _s_z_0123456789) SString-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789.-              (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789,-               t1 ~ StringSym0) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 = SGT-          in lambda _s_z_0123456789 _s_z_0123456789-      sCompare-        (SVec _s_z_0123456789 _s_z_0123456789)-        (SMaybe _s_z_0123456789)-        = let-            lambda ::-              forall _z_0123456789 _z_0123456789 _z_0123456789.-              (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789,-               t1 ~ Apply MaybeSym0 _z_0123456789) =>-              Sing _z_0123456789-              -> Sing _z_0123456789-                 -> Sing _z_0123456789-                    -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering)-            lambda _z_0123456789 _z_0123456789 _z_0123456789 = SGT-          in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789-    data instance Sing (z :: Type)-      = z ~ Nat => SNat |-        z ~ Int => SInt |-        z ~ String => SString |-        forall (n :: Type). z ~ Maybe n => SMaybe (Sing (n :: Type)) |-        forall (n :: Type) (n :: Nat). z ~ Vec n n =>-        SVec (Sing (n :: Type)) (Sing (n :: Nat))-    type SRep = (Sing :: Type -> Type)-    instance SingKind Type where-      type DemoteRep 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)-        = case toSing b :: SomeSing Type of {-            SomeSing c -> SomeSing (SMaybe c) }-      toSing (Singletons.Star.Vec b b)-        = 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 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 where-      (%~) SNat SNat = Proved Refl-      (%~) SNat SInt-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNat SString-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNat (SMaybe _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SNat (SVec _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SInt SNat-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SInt SInt = Proved Refl-      (%~) SInt SString-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SInt (SMaybe _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SInt (SVec _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SString SNat-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SString SInt-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SString SString = Proved Refl-      (%~) SString (SMaybe _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) SString (SVec _ _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SMaybe _) SNat-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SMaybe _) SInt-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SMaybe _) SString-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVec _ _) SNat-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVec _ _) SInt-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVec _ _) SString-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (SVec _ _) (SMaybe _)-        = Disproved-            (\ x-               -> case x of {-                    _ -> error "Empty case reached -- this should be impossible" })-      (%~) (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 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 -fno-warn-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 :: * -> Nat -> * 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.ghc80.template 
@@ -1,37 +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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 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-      = let-          lambda :: t ~ TrueSym0 => Sing (Apply FooSym0 t :: ())-          lambda = STuple0-        in lambda-    sFoo SFalse-      = let-          lambda :: t ~ FalseSym0 => Sing (Apply FooSym0 t :: ())-          lambda = STuple0-        in lambda-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.ghc80.template 
@@ -1,271 +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_0123456789 (a :: [Bool]) :: [Bool] where-      Succ_0123456789 '[] = Apply (Apply (:$) TrueSym0) '[]-      Succ_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) as-      Succ_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) (Apply SuccSym0 as)-    type Succ_0123456789Sym1 (t :: [Bool]) = Succ_0123456789 t-    instance SuppressUnusedWarnings Succ_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Succ_0123456789Sym0KindInference GHC.Tuple.())-    data Succ_0123456789Sym0 (l :: TyFun [Bool] [Bool])-      = forall arg. KindOf (Apply Succ_0123456789Sym0 arg) ~ KindOf (Succ_0123456789Sym1 arg) =>-        Succ_0123456789Sym0KindInference-    type instance Apply Succ_0123456789Sym0 l = Succ_0123456789Sym1 l-    type family Pred_0123456789 (a :: [Bool]) :: [Bool] where-      Pred_0123456789 '[] = Apply ErrorSym0 "pred 0"-      Pred_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) (Apply PredSym0 as)-      Pred_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) as-    type Pred_0123456789Sym1 (t :: [Bool]) = Pred_0123456789 t-    instance SuppressUnusedWarnings Pred_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Pred_0123456789Sym0KindInference GHC.Tuple.())-    data Pred_0123456789Sym0 (l :: TyFun [Bool] [Bool])-      = forall arg. KindOf (Apply Pred_0123456789Sym0 arg) ~ KindOf (Pred_0123456789Sym1 arg) =>-        Pred_0123456789Sym0KindInference-    type instance Apply Pred_0123456789Sym0 l = Pred_0123456789Sym1 l-    type family Case_0123456789 i arg_0123456789 t where-      Case_0123456789 i arg_0123456789 True = '[]-      Case_0123456789 i arg_0123456789 False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i))-    type family Case_0123456789 i arg_0123456789 t where-      Case_0123456789 i arg_0123456789 True = Apply ErrorSym0 "negative toEnum"-      Case_0123456789 i arg_0123456789 False = Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0))-    type family Case_0123456789 arg_0123456789 t where-      Case_0123456789 arg_0123456789 i = Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0))-    type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: [Bool] where-      ToEnum_0123456789 arg_0123456789 = Case_0123456789 arg_0123456789 arg_0123456789-    type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) =-        ToEnum_0123456789 t-    instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.())-    data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat [Bool])-      = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) =>-        ToEnum_0123456789Sym0KindInference-    type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l-    type family FromEnum_0123456789 (a :: [Bool]) :: GHC.Types.Nat where-      FromEnum_0123456789 '[] = FromInteger 0-      FromEnum_0123456789 ((:) False as) = Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as)-      FromEnum_0123456789 ((:) True as) = Apply (Apply (:+$) (FromInteger 1)) (Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as))-    type FromEnum_0123456789Sym1 (t :: [Bool]) = FromEnum_0123456789 t-    instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.())-    data FromEnum_0123456789Sym0 (l :: TyFun [Bool] GHC.Types.Nat)-      = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) =>-        FromEnum_0123456789Sym0KindInference-    type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l-    instance PEnum (Proxy :: Proxy [Bool]) where-      type Succ (a :: [Bool]) = Apply Succ_0123456789Sym0 a-      type Pred (a :: [Bool]) = Apply Pred_0123456789Sym0 a-      type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a-      type FromEnum (a :: [Bool]) = Apply FromEnum_0123456789Sym0 a-    instance SEnum [Bool] where-      sSucc ::-        forall (t0 :: [Bool]).-        Sing t0-        -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool]-                                    -> GHC.Types.Type) t0 :: [Bool])-      sPred ::-        forall (t0 :: [Bool]).-        Sing t0-        -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool]-                                    -> GHC.Types.Type) t0 :: [Bool])-      sToEnum ::-        forall (t0 :: GHC.Types.Nat).-        Sing t0-        -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool]-                                      -> GHC.Types.Type) t0 :: [Bool])-      sFromEnum ::-        forall (t0 :: [Bool]).-        Sing t0-        -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat-                                        -> GHC.Types.Type) t0 :: GHC.Types.Nat)-      sSucc SNil-        = let-            lambda :: t0 ~ '[] => Sing (Apply SuccSym0 t0 :: [Bool])-            lambda-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) SNil-          in lambda-      sSucc (SCons SFalse sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) FalseSym0) as =>-              Sing as -> Sing (Apply SuccSym0 t0 :: [Bool])-            lambda as-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) as-          in lambda sAs-      sSucc (SCons STrue sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) TrueSym0) as =>-              Sing as -> Sing (Apply SuccSym0 t0 :: [Bool])-            lambda as-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse)-                  (applySing (singFun1 (Proxy :: Proxy SuccSym0) sSucc) as)-          in lambda sAs-      sPred SNil-        = let-            lambda :: t0 ~ '[] => Sing (Apply PredSym0 t0 :: [Bool])-            lambda = sError (sing :: Sing "pred 0")-          in lambda-      sPred (SCons SFalse sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) FalseSym0) as =>-              Sing as -> Sing (Apply PredSym0 t0 :: [Bool])-            lambda as-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue)-                  (applySing (singFun1 (Proxy :: Proxy PredSym0) sPred) as)-          in lambda sAs-      sPred (SCons STrue sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) TrueSym0) as =>-              Sing as -> Sing (Apply PredSym0 t0 :: [Bool])-            lambda as-              = applySing-                  (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse) as-          in lambda sAs-      sToEnum sArg_0123456789-        = let-            lambda ::-              forall arg_0123456789.-              t0 ~ arg_0123456789 =>-              Sing arg_0123456789 -> Sing (Apply ToEnumSym0 t0 :: [Bool])-            lambda arg_0123456789-              = case arg_0123456789 of {-                  sI-                    -> let-                         lambda ::-                           forall i.-                           i ~ arg_0123456789 =>-                           Sing i -> Sing (Case_0123456789 arg_0123456789 i :: [Bool])-                         lambda i-                           = case-                                 applySing-                                   (applySing (singFun2 (Proxy :: Proxy (:<$)) (%:<)) i)-                                   (sFromInteger (sing :: Sing 0))-                             of {-                               STrue-                                 -> let-                                      lambda ::-                                        TrueSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) =>-                                        Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool])-                                      lambda = sError (sing :: Sing "negative toEnum")-                                    in lambda-                               SFalse-                                 -> let-                                      lambda ::-                                        FalseSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) =>-                                        Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool])-                                      lambda-                                        = case-                                              applySing-                                                (applySing-                                                   (singFun2 (Proxy :: Proxy (:==$)) (%:==)) i)-                                                (sFromInteger (sing :: Sing 0))-                                          of {-                                            STrue-                                              -> let-                                                   lambda ::-                                                     TrueSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) =>-                                                     Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool])-                                                   lambda = SNil-                                                 in lambda-                                            SFalse-                                              -> let-                                                   lambda ::-                                                     FalseSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) =>-                                                     Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool])-                                                   lambda-                                                     = applySing-                                                         (singFun1 (Proxy :: Proxy SuccSym0) sSucc)-                                                         (applySing-                                                            (singFun1-                                                               (Proxy :: Proxy ToEnumSym0) sToEnum)-                                                            (applySing-                                                               (singFun1-                                                                  (Proxy :: Proxy PredSym0) sPred)-                                                               i))-                                                 in lambda } ::-                                            Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0)) :: [Bool])-                                    in lambda } ::-                               Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0)) :: [Bool])-                       in lambda sI } ::-                  Sing (Case_0123456789 arg_0123456789 arg_0123456789 :: [Bool])-          in lambda sArg_0123456789-      sFromEnum SNil-        = let-            lambda :: t0 ~ '[] => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda = sFromInteger (sing :: Sing 0)-          in lambda-      sFromEnum (SCons SFalse sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) FalseSym0) as =>-              Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda as-              = applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy (:*$)) (%:*))-                     (sFromInteger (sing :: Sing 2)))-                  (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as)-          in lambda sAs-      sFromEnum (SCons STrue sAs)-        = let-            lambda ::-              forall as.-              t0 ~ Apply (Apply (:$) TrueSym0) as =>-              Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat)-            lambda as-              = applySing-                  (applySing-                     (singFun2 (Proxy :: Proxy (:+$)) (%:+))-                     (sFromInteger (sing :: Sing 1)))-                  (applySing-                     (applySing-                        (singFun2 (Proxy :: Proxy (:*$)) (%:*))-                        (sFromInteger (sing :: Sing 2)))-                     (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as))-          in lambda 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.ghc80.template 
@@ -1,53 +0,0 @@-Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations-    singletons-      [d| class C a where-            meth :: a -> a |]-  ======>-    class C a where-      meth :: a -> a-    type MethSym1 (t :: a0123456789) = Meth t-    instance SuppressUnusedWarnings MethSym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.())-    data MethSym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) =>-        MethSym0KindInference-    type instance Apply MethSym0 l = MethSym1 l-    class kproxy ~ Proxy => PC (kproxy :: Proxy a) 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_0123456789 (a :: Bool) :: Bool where-      Meth_0123456789 a_0123456789 = Apply NotSym0 a_0123456789-    type Meth_0123456789Sym1 (t :: Bool) = Meth_0123456789 t-    instance SuppressUnusedWarnings Meth_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd (GHC.Tuple.(,) Meth_0123456789Sym0KindInference GHC.Tuple.())-    data Meth_0123456789Sym0 (l :: TyFun Bool Bool)-      = forall arg. KindOf (Apply Meth_0123456789Sym0 arg) ~ KindOf (Meth_0123456789Sym1 arg) =>-        Meth_0123456789Sym0KindInference-    type instance Apply Meth_0123456789Sym0 l = Meth_0123456789Sym1 l-    instance PC (Proxy :: Proxy Bool) where-      type Meth (a :: Bool) = Apply Meth_0123456789Sym0 a-    instance SC Bool where-      sMeth ::-        forall (t :: Bool).-        Sing t-        -> Sing (Apply (MethSym0 :: TyFun Bool Bool-                                    -> GHC.Types.Type) t :: Bool)-      sMeth sA_0123456789-        = let-            lambda ::-              forall a_0123456789.-              t ~ a_0123456789 =>-              Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool)-            lambda a_0123456789-              = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789-          in lambda sA_0123456789
− 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/T29.ghc80.template 
@@ -1,127 +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. KindOf (Apply BanSym0 arg) ~ KindOf (BanSym1 arg) =>-        BanSym0KindInference-    type instance Apply BanSym0 l = BanSym1 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. KindOf (Apply BazSym0 arg) ~ KindOf (BazSym1 arg) =>-        BazSym0KindInference-    type instance Apply BazSym0 l = BazSym1 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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 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-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply BanSym0 t :: Bool)-          lambda x-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy ($!$)) (%$!))-                   (applySing-                      (applySing-                         (singFun3 (Proxy :: Proxy (:.$)) (%:.))-                         (singFun1 (Proxy :: Proxy NotSym0) sNot))-                      (applySing-                         (applySing-                            (singFun3 (Proxy :: Proxy (:.$)) (%:.))-                            (singFun1 (Proxy :: Proxy NotSym0) sNot))-                         (singFun1 (Proxy :: Proxy NotSym0) sNot))))-                x-        in lambda sX-    sBaz sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply BazSym0 t :: Bool)-          lambda x-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy ($!$)) (%$!))-                   (singFun1 (Proxy :: Proxy NotSym0) sNot))-                x-        in lambda sX-    sBar sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply BarSym0 t :: Bool)-          lambda x-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy ($$)) (%$))-                   (applySing-                      (applySing-                         (singFun3 (Proxy :: Proxy (:.$)) (%:.))-                         (singFun1 (Proxy :: Proxy NotSym0) sNot))-                      (applySing-                         (applySing-                            (singFun3 (Proxy :: Proxy (:.$)) (%:.))-                            (singFun1 (Proxy :: Proxy NotSym0) sNot))-                         (singFun1 (Proxy :: Proxy NotSym0) sNot))))-                x-        in lambda sX-    sFoo sX-      = let-          lambda ::-            forall x. t ~ x => Sing x -> Sing (Apply FooSym0 t :: Bool)-          lambda x-            = applySing-                (applySing-                   (singFun2 (Proxy :: Proxy ($$)) (%$))-                   (singFun1 (Proxy :: Proxy NotSym0) sNot))-                x-        in lambda 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.ghc80.template 
@@ -1,34 +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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    type family Foo (a :: (Bool, Bool)) :: () where-      Foo '(_z_0123456789, _z_0123456789) = Tuple0Sym0-    sFoo ::-      forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ())-    sFoo (STuple2 _s_z_0123456789 _s_z_0123456789)-      = let-          lambda ::-            forall _z_0123456789 _z_0123456789.-            t ~ Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789 =>-            Sing _z_0123456789-            -> Sing _z_0123456789 -> Sing (Apply FooSym0 t :: ())-          lambda _z_0123456789 _z_0123456789 = STuple0-        in lambda _s_z_0123456789 _s_z_0123456789--Singletons/T33.hs:0:0: warning:-    Lazy pattern converted into regular pattern in promotion--Singletons/T33.hs:0:0: warning:-    Lazy pattern converted into regular pattern during singleton generation.
− 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.ghc80.template 
@@ -1,60 +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 Let0123456789Scrutinee_0123456789Sym1 t =-        Let0123456789Scrutinee_0123456789 t-    instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where-      suppressUnusedWarnings _-        = snd-            (GHC.Tuple.(,)-               Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.())-    data Let0123456789Scrutinee_0123456789Sym0 l-      = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) =>-        Let0123456789Scrutinee_0123456789Sym0KindInference-    type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l-    type family Let0123456789Scrutinee_0123456789 e where-      Let0123456789Scrutinee_0123456789 e = Apply (Apply (:$) NotSym0) '[]-    type family Case_0123456789 e t where-      Case_0123456789 e '[_z_0123456789] = 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. KindOf (Apply GSym0 arg) ~ KindOf (GSym1 arg) =>-        GSym0KindInference-    type instance Apply GSym0 l = GSym1 l-    type family G (a :: Bool) :: Bool where-      G e = Apply (Case_0123456789 e (Let0123456789Scrutinee_0123456789Sym1 e)) e-    sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool)-    sG sE-      = let-          lambda :: forall e. t ~ e => Sing e -> Sing (Apply GSym0 t :: Bool)-          lambda e-            = applySing-                (let-                   sScrutinee_0123456789 ::-                     Sing (Let0123456789Scrutinee_0123456789Sym1 e)-                   sScrutinee_0123456789-                     = applySing-                         (applySing-                            (singFun2 (Proxy :: Proxy (:$)) SCons)-                            (singFun1 (Proxy :: Proxy NotSym0) sNot))-                         SNil-                 in  case sScrutinee_0123456789 of {-                       SCons _s_z_0123456789 SNil-                         -> let-                              lambda ::-                                forall _z_0123456789.-                                Apply (Apply (:$) _z_0123456789) '[] ~ Let0123456789Scrutinee_0123456789Sym1 e =>-                                Sing _z_0123456789-                                -> Sing (Case_0123456789 e (Apply (Apply (:$) _z_0123456789) '[]))-                              lambda _z_0123456789 = singFun1 (Proxy :: Proxy NotSym0) sNot-                            in lambda _s_z_0123456789 } ::-                       Sing (Case_0123456789 e (Let0123456789Scrutinee_0123456789Sym1 e)))-                e-        in lambda sE
− tests/compile-and-dump/Singletons/T54.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -fno-warn-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.ghc80.template 
@@ -1,42 +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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 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)-      = let-          lambda ::-            t ~ Apply JustSym0 FalseSym0 => Sing (Apply FooSym0 t :: Bool)-          lambda = SFalse-        in lambda-    sFoo (SJust STrue)-      = let-          lambda ::-            t ~ Apply JustSym0 TrueSym0 => Sing (Apply FooSym0 t :: Bool)-          lambda = STrue-        in lambda-    sFoo SNothing-      = let-          lambda :: t ~ NothingSym0 => Sing (Apply FooSym0 t :: Bool)-          lambda = SFalse-        in lambda
− 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.ghc80.template 
@@ -1,407 +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. KindOf (Apply (BarSym1 l) arg) ~ KindOf (BarSym2 l arg) =>-        BarSym1KindInference-    type instance Apply (BarSym1 l) l = BarSym2 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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 l-    data instance Sing (z :: Bool)-      = z ~ False => SFalse | z ~ True => STrue-    type SBool = (Sing :: Bool -> GHC.Types.Type)-    instance SingKind Bool where-      type DemoteRep Bool = Bool-      fromSing SFalse = False-      fromSing STrue = True-      toSing False = SomeSing SFalse-      toSing True = SomeSing STrue-    data instance Sing (z :: Foo)-      = forall (n :: Bool) (n :: Bool). z ~ Bar n n =>-        SBar (Sing (n :: Bool)) (Sing (n :: Bool))-    type SFoo = (Sing :: Foo -> GHC.Types.Type)-    instance SingKind Foo where-      type DemoteRep Foo = Foo-      fromSing (SBar b b) = Bar (fromSing b) (fromSing b)-      toSing (Bar b b)-        = 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 :: forall a. 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_0123456789 a_0123456789 t where-      Case_0123456789 a_0123456789 '[y_0123456789,-                                     _z_0123456789] = y_0123456789-    type family Case_0123456789 a_0123456789 t where-      Case_0123456789 a_0123456789 '[_z_0123456789,-                                     y_0123456789] = y_0123456789-    type family Case_0123456789 a_0123456789 t where-      Case_0123456789 a_0123456789 '(y_0123456789,-                                     _z_0123456789) = y_0123456789-    type family Case_0123456789 a_0123456789 t where-      Case_0123456789 a_0123456789 '(_z_0123456789,-                                     y_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Bar y_0123456789 _z_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 (Bar _z_0123456789 y_0123456789) = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '[y_0123456789, _z_0123456789] = y_0123456789-    type family Case_0123456789 t where-      Case_0123456789 '[_z_0123456789, y_0123456789] = y_0123456789-    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. KindOf (Apply NotSym0 arg) ~ KindOf (NotSym1 arg) =>-        NotSym0KindInference-    type instance Apply NotSym0 l = NotSym1 l-    type IdSym1 (t :: a0123456789) = Id t-    instance SuppressUnusedWarnings IdSym0 where-      suppressUnusedWarnings _-        = Data.Tuple.snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.())-    data IdSym0 (l :: TyFun a0123456789 a0123456789)-      = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) =>-        IdSym0KindInference-    type instance Apply IdSym0 l = IdSym1 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. KindOf (Apply FSym0 arg) ~ KindOf (FSym1 arg) =>-        FSym0KindInference-    type instance Apply FSym0 l = FSym1 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. KindOf (Apply GSym0 arg) ~ KindOf (GSym1 arg) =>-        GSym0KindInference-    type instance Apply GSym0 l = GSym1 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. KindOf (Apply HSym0 arg) ~ KindOf (HSym1 arg) =>-        HSym0KindInference-    type instance Apply HSym0 l = HSym1 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. KindOf (Apply ISym0 arg) ~ KindOf (ISym1 arg) =>-        ISym0KindInference-    type instance Apply ISym0 l = ISym1 l-    type JSym0 = J-    type KSym0 = K-    type LSym0 = L-    type MSym0 = M-    type OtherwiseSym0 = Otherwise-    type X_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    type X_0123456789Sym0 = X_0123456789-    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_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789-    type family G (a :: Bool) :: Bool where-      G a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789-    type family H (a :: Bool) :: Bool where-      H a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789-    type family I (a :: Bool) :: Bool where-      I a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789-    type family J :: Bool where-      J = Case_0123456789 X_0123456789Sym0-    type family K :: Bool where-      K = Case_0123456789 X_0123456789Sym0-    type family L :: Bool where-      L = Case_0123456789 X_0123456789Sym0-    type family M :: Bool where-      M = Case_0123456789 X_0123456789Sym0-    type family Otherwise :: Bool where-      Otherwise = TrueSym0-    type family X_0123456789 where-      X_0123456789 = Apply (Apply (:$) NotSym0) (Apply (Apply (:$) IdSym0) '[])-    type family X_0123456789 where-      X_0123456789 = Apply (Apply Tuple2Sym0 FSym0) GSym0-    type family X_0123456789 where-      X_0123456789 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0)-    type family X_0123456789 where-      X_0123456789 = 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_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sX_0123456789 :: Sing X_0123456789Sym0-    sFalse_ = SFalse-    sNot STrue-      = let-          lambda :: t ~ TrueSym0 => Sing (Apply NotSym0 t :: Bool)-          lambda = SFalse-        in lambda-    sNot SFalse-      = let-          lambda :: t ~ FalseSym0 => Sing (Apply NotSym0 t :: Bool)-          lambda = STrue-        in lambda-    sId sX-      = let-          lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a)-          lambda x = x-        in lambda sX-    sF sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply FSym0 t :: Bool)-          lambda a_0123456789-            = applySing-                (case sX_0123456789 of {-                   SCons sY_0123456789 (SCons _s_z_0123456789 SNil)-                     -> let-                          lambda ::-                            forall y_0123456789 _z_0123456789.-                            Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]) ~ X_0123456789Sym0 =>-                            Sing y_0123456789-                            -> Sing _z_0123456789-                               -> Sing (Case_0123456789 a_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[])))-                          lambda y_0123456789 _z_0123456789 = y_0123456789-                        in lambda sY_0123456789 _s_z_0123456789 } ::-                   Sing (Case_0123456789 a_0123456789 X_0123456789Sym0))-                a_0123456789-        in lambda sA_0123456789-    sG sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply GSym0 t :: Bool)-          lambda a_0123456789-            = applySing-                (case sX_0123456789 of {-                   SCons _s_z_0123456789 (SCons sY_0123456789 SNil)-                     -> let-                          lambda ::-                            forall _z_0123456789 y_0123456789.-                            Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]) ~ X_0123456789Sym0 =>-                            Sing _z_0123456789-                            -> Sing y_0123456789-                               -> Sing (Case_0123456789 a_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[])))-                          lambda _z_0123456789 y_0123456789 = y_0123456789-                        in lambda _s_z_0123456789 sY_0123456789 } ::-                   Sing (Case_0123456789 a_0123456789 X_0123456789Sym0))-                a_0123456789-        in lambda sA_0123456789-    sH sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply HSym0 t :: Bool)-          lambda a_0123456789-            = applySing-                (case sX_0123456789 of {-                   STuple2 sY_0123456789 _s_z_0123456789-                     -> let-                          lambda ::-                            forall y_0123456789 _z_0123456789.-                            Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 =>-                            Sing y_0123456789-                            -> Sing _z_0123456789-                               -> Sing (Case_0123456789 a_0123456789 (Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789))-                          lambda y_0123456789 _z_0123456789 = y_0123456789-                        in lambda sY_0123456789 _s_z_0123456789 } ::-                   Sing (Case_0123456789 a_0123456789 X_0123456789Sym0))-                a_0123456789-        in lambda sA_0123456789-    sI sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply ISym0 t :: Bool)-          lambda a_0123456789-            = applySing-                (case sX_0123456789 of {-                   STuple2 _s_z_0123456789 sY_0123456789-                     -> let-                          lambda ::-                            forall _z_0123456789 y_0123456789.-                            Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 =>-                            Sing _z_0123456789-                            -> Sing y_0123456789-                               -> Sing (Case_0123456789 a_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789))-                          lambda _z_0123456789 y_0123456789 = y_0123456789-                        in lambda _s_z_0123456789 sY_0123456789 } ::-                   Sing (Case_0123456789 a_0123456789 X_0123456789Sym0))-                a_0123456789-        in lambda sA_0123456789-    sJ-      = case sX_0123456789 of {-          SBar sY_0123456789 _s_z_0123456789-            -> let-                 lambda ::-                   forall y_0123456789 _z_0123456789.-                   Apply (Apply BarSym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 =>-                   Sing y_0123456789-                   -> Sing _z_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply BarSym0 y_0123456789) _z_0123456789) :: Bool)-                 lambda y_0123456789 _z_0123456789 = y_0123456789-               in lambda sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Bool)-    sK-      = case sX_0123456789 of {-          SBar _s_z_0123456789 sY_0123456789-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789.-                   Apply (Apply BarSym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply BarSym0 _z_0123456789) y_0123456789) :: Bool)-                 lambda _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Bool)-    sL-      = case sX_0123456789 of {-          SCons sY_0123456789 (SCons _s_z_0123456789 SNil)-            -> let-                 lambda ::-                   forall y_0123456789 _z_0123456789.-                   Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]) ~ X_0123456789Sym0 =>-                   Sing y_0123456789-                   -> Sing _z_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[])) :: Bool)-                 lambda y_0123456789 _z_0123456789 = y_0123456789-               in lambda sY_0123456789 _s_z_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Bool)-    sM-      = case sX_0123456789 of {-          SCons _s_z_0123456789 (SCons sY_0123456789 SNil)-            -> let-                 lambda ::-                   forall _z_0123456789 y_0123456789.-                   Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]) ~ X_0123456789Sym0 =>-                   Sing _z_0123456789-                   -> Sing y_0123456789-                      -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[])) :: Bool)-                 lambda _z_0123456789 y_0123456789 = y_0123456789-               in lambda _s_z_0123456789 sY_0123456789 } ::-          Sing (Case_0123456789 X_0123456789Sym0 :: Bool)-    sOtherwise = STrue-    sX_0123456789-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy (:$)) SCons)-             (singFun1 (Proxy :: Proxy NotSym0) sNot))-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (singFun1 (Proxy :: Proxy IdSym0) sId))-             SNil)-    sX_0123456789-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2)-             (singFun1 (Proxy :: Proxy FSym0) sF))-          (singFun1 (Proxy :: Proxy GSym0) sG)-    sX_0123456789-      = applySing-          (applySing (singFun2 (Proxy :: Proxy BarSym0) SBar) STrue)-          (applySing (singFun1 (Proxy :: Proxy HSym0) sH) SFalse)-    sX_0123456789-      = applySing-          (applySing-             (singFun2 (Proxy :: Proxy (:$)) SCons)-             (applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) STrue))-          (applySing-             (applySing-                (singFun2 (Proxy :: Proxy (:$)) SCons)-                (applySing (singFun1 (Proxy :: Proxy IdSym0) sId) SFalse))-             SNil)
− tests/compile-and-dump/Singletons/TopLevelPatterns.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -fno-warn-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.ghc80.template 
@@ -1,51 +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. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 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. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    type family Bar (a :: Bool) :: Bool where-      Bar a_0123456789 = Apply (Apply ErrorSym0 "urk") a_0123456789-    type family Foo (a :: Bool) :: Bool where-      Foo a_0123456789 = Apply Any a_0123456789-    sBar ::-      forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool)-    sFoo ::-      forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool)-    sBar sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply BarSym0 t :: Bool)-          lambda a_0123456789 = sError (sing :: Sing "urk")-        in lambda sA_0123456789-    sFoo sA_0123456789-      = let-          lambda ::-            forall a_0123456789.-            t ~ a_0123456789 =>-            Sing a_0123456789 -> Sing (Apply FooSym0 t :: Bool)-          lambda a_0123456789 = undefined-        in lambda sA_0123456789
− tests/compile-and-dump/Singletons/Undef.hs 
@@ -1,12 +0,0 @@-module Singletons.Undef where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(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