diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,9 +1,145 @@ Changelog for singletons project ================================ -2.3.1 ------ -* Fix the Haddock build, thanks to @christiaanb. +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 --- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ -singletons 2.3.1 -================ +singletons 2.4 +============== +[![Hackage](https://img.shields.io/hackage/v/singletons.svg)](http://hackage.haskell.org/package/singletons) [![Build Status](https://travis-ci.org/goldfirere/singletons.svg?branch=master)](https://travis-ci.org/goldfirere/singletons) This is the README file for the singletons library. This file contains all the @@ -10,10 +11,10 @@ with significant contributions by Jan Stolarek, . 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 +[here](https://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf) and will be referenced in this documentation as the "singletons paper". A follow-up paper, _Promoting Functions to Type Families in Haskell_, is available -[here](http://www.cis.upenn.edu/~eir/papers/2014/promotion/promotion.pdf) +[here](https://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf) and will be referenced in this documentation as the "promotion paper". @@ -35,24 +36,26 @@ Compatibility ------------- -The singletons library requires GHC 8.2.1 or greater. Any code that uses the +The singletons library requires GHC 8.4.1 or greater. Any code that uses the singleton generation primitives needs to enable a long list of GHC extensions. This list includes, but is not necessarily limited to, the following: +* `DefaultSignatures` +* `EmptyCase` +* `ExistentialQuantification` +* `FlexibleContexts` +* `FlexibleInstances` +* `GADTs` +* `InstanceSigs` +* `KindSignatures` +* `RankNTypes` * `ScopedTypeVariables` * `TemplateHaskell` * `TypeFamilies` -* `GADTs` -* `KindSignatures` +* `TypeInType` * `TypeOperators` -* `FlexibleContexts` -* `RankNTypes` * `UndecidableInstances` -* `FlexibleInstances` -* `InstanceSigs` -* `DefaultSignatures` -* `TypeInType` You may also want @@ -78,17 +81,14 @@ `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.Maybe`, `Data.Either`, `Data.List`, `Data.Tuple`, `Data.Void` and +`GHC.Base`. We also provide singletonized `Eq`, `Ord`, `Show`, `Enum`, and +`Bounded` typeclasses. `Data.Singletons.Decide` exports type classes for propositional equality. `Data.Singletons.TypeLits` exports definitions for working with `GHC.TypeLits`. -`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 ------------------------------ @@ -114,7 +114,9 @@ `Data.Singletons.TH` module. The most common case is just calling `singletons`, which I'll describe here: - singletons :: Q [Dec] -> Q [Dec] +```haskell +singletons :: Q [Dec] -> Q [Dec] +``` Generates singletons from the definitions given. Because singleton generation requires promotion, this also promotes all of the definitions given to the @@ -137,29 +139,37 @@ 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) +```haskell +data family Sing (a :: k) +``` The data family of singleton types. A new instance of this data family is generated for every new singleton type. - class SingI (a :: k) where - sing :: Sing a +```haskell +class SingI (a :: k) where + sing :: Sing a +``` A class used to pass singleton values implicitly. The `sing` method produces an explicit singleton value. - data SomeSing k where - SomeSing :: Sing (a :: k) -> SomeSing k +```haskell +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k +``` The `SomeSing` type wraps up an _existentially-quantified_ singleton. Note that the type parameter `a` does not appear in the `SomeSing` type. Thus, this type can be used when you have a singleton, but you don't know at compile time what it will be. `SomeSing Thing` is isomorphic to `Thing`. - class SingKind k where - type Demote k :: * - fromSing :: Sing (a :: k) -> Demote k - toSing :: Demote k -> SomeSing k +```haskell +class SingKind k where + type Demote k :: * + fromSing :: Sing (a :: k) -> Demote k + toSing :: Demote k -> SomeSing k +``` This class is used to convert a singleton value back to a value in the original, unrefined ADT. The `fromSing` method converts, say, a @@ -168,9 +178,11 @@ The `Demote` associated kind-indexed type family maps the kind `Nat` back to the type `Nat`. - data SingInstance (a :: k) where - SingInstance :: SingI a => SingInstance a - singInstance :: Sing a -> SingInstance a +```haskell +data SingInstance (a :: k) where + SingInstance :: SingI a => SingInstance a +singInstance :: Sing a -> SingInstance a +``` Sometimes you have an explicit singleton (a `Sing`) where you need an implicit one (a dictionary for `SingI`). The `SingInstance` type simply wraps a `SingI` @@ -203,6 +215,36 @@ directly through functions exported from `Data.Singletons.TH`. +`Show` classes +-------------- + +Promoted and singled versions of the `Show` class (`PShow` and `SShow`, +respectively) are provided in the `Data.Singletons.Prelude.Show` module. In +addition, there is a `ShowSing` class provided in the +`Data.Singletons.ShowSing` module, which facilitates the ability to write +`Show` instances for `Sing` instances. + +What is the difference between the two? Let's use the `False` constructor as an +example. If you used the `PShow Bool` instance, then the output of calling +`Show_` on `False` is `"False"`, much like the value-level `Show Bool` instance +(similarly for the `SShow Bool` instance). However, the `ShowSing Bool` +instance is intended for printing the value of the _singleton_ constructor +`SFalse`, so calling `showsSingPrec 0 SFalse` yields `"SFalse"` (simiarly for +the `Show (Sing (SBool z))` instance). + +Instance of `PShow`, `SShow`, `ShowSing`, and `Show` (for the singleton type) +are generated when `singletons` is called on a datatype that has +`deriving Show`. You can also generate these instances directly through +functions exported from `Data.Singletons.TH`. + +A promoted and singled `Show` instance is provided for `Symbol`, but it is only +a crude approximation of the value-level `Show` instance for `String`. On the +value level, showing `String`s escapes special characters (such as double +quotes), but implementing this requires pattern-matching on character literals, +something which is currently impossible at the type level. As a consequence, the +type-level `Show` instance for `Symbol`s does not do any character escaping. + + Pre-defined singletons ---------------------- @@ -350,12 +392,11 @@ singleton type: `SNat` (which is really a synonym for `Sing`) -2. original datatype: `:/\:` - - promoted kind: `:/\:` +2. original datatype: `/\` - singleton type: `:%/\:` + promoted kind: `/\` + singleton type: `%/\` 3. original constructor: `Succ` @@ -373,7 +414,7 @@ singleton constructor: `:%+:` - symbols: `:+:$`, `:+:$$`, `:+:$$$` + symbols: `:+:@#@$`, `:+:@#@$$`, `:+:@#@$$$` 5. original value: `pred` @@ -387,11 +428,11 @@ 6. original value: `+` - promoted type: `:+` + promoted type: `+` - singleton value: `%:+` + singleton value: `%+` - symbols: `:+$`, `:+$$`, `:+$$$` + symbols: `+@#@$`, `+@#@$$`, `+@#@$$$` 7. original class: `Num` @@ -405,59 +446,88 @@ promoted class: `#~>` - singleton class: `:%~>` + singleton class: `%~>` Special names ------------- -There are some special cases: +There are some special cases, listed below (with asterisks\* denoting special +treatment): 1. original datatype: `[]` - singleton type: `SList` + promoted kind: `[]` + singleton type\*: `SList` -2. original constructor: `[]` - promoted type: `'[]` +2. original constructor: `[]` - singleton constructor: `SNil` + promoted type: `'[]` - symbols: `NilSym0` + singleton constructor\*: `SNil` + symbols\*: `NilSym0` + 3. original constructor: `:` promoted type: `':` - singleton constructr: `SCons` + singleton constructor\*: `SCons` - symbols: `ConsSym0`, `ConsSym1` + symbols: `:@#@$`, `:@#@$$`, `:@#@$$$` 4. original datatype: `(,)` - singleton type: `STuple2` + promoted kind: `(,)` + singleton type\*: `STuple2` + 5. original constructor: `(,)` promoted type: `'(,)` - singleton constructor: `STuple2` + singleton constructor\*: `STuple2` - symbols: `Tuple2Sym0`, `Tuple2Sym1`, `Tuple2Sym2` + symbols\*: `Tuple2Sym0`, `Tuple2Sym1`, `Tuple2Sym2` All tuples (including the 0-tuple, unit) are treated similarly. -6. original value: `undefined` - promoted type: `Any` +6. original value: `(.)` - singleton value: `undefined` + promoted type\*: `(:.)` + singleton value: `(%.)` + symbols: `(.@#@$)`, `(.@#@$$)`, `(.@#@$$$)` + + The promoted type is special because GHC can't parse a type named `(.)`. + +7. original value: `(!)` + + promoted type\*: `(:!)` + + singleton value: `(%!)` + + symbols: `(!@#@$)`, `(!@#@$$)`, `(!@#@$$$)` + + The promoted type is special because GHC can't parse a type named `(!)`. + +8. original value: `___foo` + + promoted type\*: `US___foo` ("`US`" stands for "underscore") + + singleton value\*: `___sfoo` + + symbols\*: `US___fooSym0` + + All functions that begin with leading underscores are treated similarly. + Supported Haskell constructs ---------------------------- @@ -467,14 +537,14 @@ * tuples * constructors * if statements -* infix expressions +* infix expressions and types * `_` patterns * aliased patterns * lists * sections * undefined * error -* deriving `Eq`, `Ord`, `Bounded`, and `Enum` +* deriving `Eq`, `Ord`, `Show`, `Bounded`, and `Enum` * class constraints (though these sometimes fail with `let`, `lambda`, and `case`) * literals (for `Nat` and `Symbol`), including overloaded number literals * unboxed tuples (which are treated as normal tuples) @@ -497,6 +567,16 @@ [this pull request](https://github.com/goldfirere/singletons/pull/171) for more background. +`singletons` is slightly more conservative with respect to `deriving` than GHC is. +The stock classes listed above (`Eq`, `Ord`, `Show`, `Bounded`, and `Enum`) are +the only ones that `singletons` will derive without an explicit deriving strategy. +To do anything more exotic, one must explicitly indicate one's intentions by +using the `DerivingStrategies` extension. + +`singletons` fully supports the `anyclass` strategy as well as the `stock` strategy +(at least, for the classes listed above). `singletons` does not support the +`newtype` strategy, as there is not an equivalent of `coerce` at the type level. + The following constructs are supported for promotion but not singleton generation: * scoped type variables @@ -521,13 +601,12 @@ * arithmetic sequences * datatypes that store arrows, `Nat`, or `Symbol` * literals (limited support) -* symbolic (as opposed to alphanumeric) types Why are these out of reach? The first two depend on monads, which mention a higher-kinded type variable. GHC did not support higher-sorted kind variables, which are be necessary to promote/singletonize monads, and `singletons` has not be rewritten to accommodate this new ability. [This bug -report](https://github.com/goldfirere/singletons/issues/37) is a feature request +report](https://github.com/goldfirere/singletons/issues/184) is a feature request looking for support for these constructs. Arithmetic sequences are defined using `Enum` typeclass, which uses infinite @@ -536,7 +615,9 @@ 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) +```haskell +data Foo = Bar (Bool -> Maybe Bool) +``` you will quickly run into errors. @@ -551,12 +632,6 @@ in datatype definitions. But, see [this bug report](https://github.com/goldfirere/singletons/issues/76) for a workaround. -Symbolic types used in kinds were not supported in GHC, but now are. However, -`singletons` still does not support them, mostly because of challenges around -telling datacon names apart from tycon names. [This -issue](https://github.com/goldfirere/singletons/issues/163) tracks adding -this feature. - Support for `*` --------------- @@ -570,10 +645,12 @@ making `*` the promoted version of `TypeRep`, as `TypeRep` is currently implemented. The singleton associated with `TypeRep` has one constructor: - data instance Sing (a :: *) where - STypeRep :: Typeable a => Sing a + ```haskell + newtype instance Sing :: Type -> Type where + STypeRep :: TypeRep a -> Sing a + ``` -Thus, an implicit `TypeRep` is stored in the singleton constructor. However, + Thus, a `TypeRep` is stored in the singleton constructor. However, any datatypes that store `TypeRep`s will not generally work as expected; the built-in promotion mechanism will not promote `TypeRep` to `*`. diff --git a/singletons.cabal b/singletons.cabal --- a/singletons.cabal +++ b/singletons.cabal @@ -1,5 +1,5 @@ name: singletons -version: 2.3.1 +version: 2.4 -- Remember to bump version in the Makefile as well cabal-version: >= 1.10 synopsis: A framework for generating singleton types @@ -9,17 +9,17 @@ maintainer: Richard Eisenberg , Jan Stolarek bug-reports: https://github.com/goldfirere/singletons/issues stability: experimental -tested-with: GHC == 8.2.1 +tested-with: GHC == 8.4.1 extra-source-files: README.md, CHANGES.md, tests/compile-and-dump/buildGoldenFiles.awk, tests/compile-and-dump/GradingClient/*.hs, tests/compile-and-dump/InsertionSort/*.hs, tests/compile-and-dump/Promote/*.hs, tests/compile-and-dump/Singletons/*.hs - tests/compile-and-dump/GradingClient/*.ghc82.template, - tests/compile-and-dump/InsertionSort/*.ghc82.template, - tests/compile-and-dump/Promote/*.ghc82.template, - tests/compile-and-dump/Singletons/*.ghc82.template + tests/compile-and-dump/GradingClient/*.ghc84.template, + tests/compile-and-dump/InsertionSort/*.ghc84.template, + tests/compile-and-dump/Promote/*.ghc84.template, + tests/compile-and-dump/Singletons/*.ghc84.template license: BSD3 license-file: LICENSE build-type: Simple @@ -29,87 +29,99 @@ to use dependently typed programming techniques. The library was originally presented in /Dependently Typed Programming with Singletons/, published at the Haskell Symposium, 2012. - () + () Version 1.0 and onwards works a lot harder to promote functions. See the paper published at Haskell Symposium, 2014: - . + . source-repository this type: git location: https://github.com/goldfirere/singletons.git - tag: v2.3.1 + tag: v2.4 library hs-source-dirs: src - build-depends: base >= 4.10 && < 5, - mtl >= 2.1.2, + build-depends: base >= 4.11 && < 4.12, + mtl >= 2.2.1, + ghc-boot-th, template-haskell, containers >= 0.5, - th-desugar >= 1.7 && < 1.8, + th-desugar >= 1.8 && < 1.9, syb >= 0.4, - text >= 1.2 + text >= 1.2, + transformers >= 0.5.2 default-language: Haskell2010 other-extensions: TemplateHaskell -- TemplateHaskell must be listed in cabal file to work with -- ghc7.8+ - exposed-modules: Data.Singletons, - Data.Singletons.CustomStar, - Data.Singletons.TypeRepStar, - Data.Singletons.TH, - Data.Singletons.Prelude, - Data.Singletons.Prelude.Base, - Data.Singletons.Prelude.Bool, - Data.Singletons.Prelude.Either, - Data.Singletons.Prelude.Enum, - Data.Singletons.Prelude.Eq, - Data.Singletons.Prelude.Function, - Data.Singletons.Prelude.Ord, - Data.Singletons.Prelude.List, - Data.Singletons.Prelude.List.NonEmpty, - Data.Singletons.Prelude.Maybe, + exposed-modules: Data.Singletons + Data.Singletons.CustomStar + Data.Singletons.TypeRepStar + Data.Singletons.TH + Data.Singletons.Prelude + Data.Singletons.Prelude.Base + Data.Singletons.Prelude.Bool + Data.Singletons.Prelude.Either + Data.Singletons.Prelude.Enum + Data.Singletons.Prelude.Eq + Data.Singletons.Prelude.Function + Data.Singletons.Prelude.IsString + Data.Singletons.Prelude.Ord + Data.Singletons.Prelude.List + Data.Singletons.Prelude.List.NonEmpty + Data.Singletons.Prelude.Maybe Data.Singletons.Prelude.Num - Data.Singletons.Prelude.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.Function, - Data.Promotion.Prelude.Ord, - Data.Promotion.Prelude.Enum, - Data.Promotion.Prelude.List, - Data.Promotion.Prelude.List.NonEmpty, - Data.Promotion.Prelude.Maybe, - Data.Promotion.Prelude.Num, - Data.Promotion.Prelude.Tuple, - Data.Singletons.TypeLits, - Data.Singletons.Decide, + Data.Singletons.Prelude.Show + Data.Singletons.Prelude.Tuple + Data.Singletons.Prelude.Void + Data.Promotion.Prelude + Data.Promotion.TH + Data.Promotion.Prelude.Base + Data.Promotion.Prelude.Bool + Data.Promotion.Prelude.Either + Data.Promotion.Prelude.Eq + Data.Promotion.Prelude.Function + Data.Promotion.Prelude.IsString + Data.Promotion.Prelude.Ord + Data.Promotion.Prelude.Enum + Data.Promotion.Prelude.List + Data.Promotion.Prelude.List.NonEmpty + Data.Promotion.Prelude.Maybe + Data.Promotion.Prelude.Num + Data.Promotion.Prelude.Show + Data.Promotion.Prelude.Tuple + Data.Promotion.Prelude.Void + Data.Singletons.TypeLits + Data.Singletons.Decide + Data.Singletons.ShowSing + Data.Singletons.Sigma Data.Singletons.SuppressUnusedWarnings - other-modules: Data.Singletons.Deriving.Infer, - Data.Singletons.Deriving.Bounded, - Data.Singletons.Deriving.Enum, - Data.Singletons.Deriving.Ord, - Data.Singletons.Prelude.List.NonEmpty.Internal, - Data.Singletons.Promote, - Data.Singletons.Promote.Monad, - Data.Singletons.Promote.Eq, - Data.Singletons.Promote.Type, - Data.Singletons.Promote.Defun, - Data.Singletons.Util, - Data.Singletons.Partition, - Data.Singletons.Prelude.Instances, - Data.Singletons.Names, - Data.Singletons.Single.Monad, - Data.Singletons.Single.Type, - Data.Singletons.Single.Eq, - Data.Singletons.Single.Data, - Data.Singletons.Single.Fixity, - Data.Singletons.Single, - Data.Singletons.TypeLits.Internal, + other-modules: Data.Singletons.Deriving.Infer + Data.Singletons.Deriving.Bounded + Data.Singletons.Deriving.Enum + Data.Singletons.Deriving.Ord + Data.Singletons.Deriving.Show + Data.Singletons.Internal + Data.Singletons.Prelude.List.NonEmpty.Internal + Data.Singletons.Promote + Data.Singletons.Promote.Monad + Data.Singletons.Promote.Eq + Data.Singletons.Promote.Type + Data.Singletons.Promote.Defun + Data.Singletons.Util + Data.Singletons.Partition + Data.Singletons.Prelude.Instances + Data.Singletons.Names + Data.Singletons.Single.Monad + Data.Singletons.Single.Type + Data.Singletons.Single.Eq + Data.Singletons.Single.Data + Data.Singletons.Single.Fixity + Data.Singletons.Single + Data.Singletons.TypeLits.Internal Data.Singletons.Syntax ghc-options: -Wall -Wno-redundant-constraints @@ -122,11 +134,10 @@ main-is: SingletonsTestSuite.hs other-modules: SingletonsTestSuiteUtils - build-depends: base >= 4.10 && < 5, + build-depends: base >= 4.11 && < 4.12, filepath >= 1.3, process >= 1.1, singletons, tasty >= 0.6, tasty-golden >= 2.2, - Cabal >= 2.0, directory >= 1 diff --git a/src/Data/Promotion/Prelude.hs b/src/Data/Promotion/Prelude.hs --- a/src/Data/Promotion/Prelude.hs +++ b/src/Data/Promotion/Prelude.hs @@ -15,7 +15,7 @@ module Data.Promotion.Prelude ( -- * Standard types, classes and related functions -- ** Basic data types - If, Not, (:&&), (:||), Otherwise, + If, Not, type (&&), type (||), Otherwise, maybe_, Maybe_, either_, Either_, @@ -24,7 +24,7 @@ Fst, Snd, Curry, Uncurry, -- * Error reporting - Error, ErrorSym0, + Error, Undefined, -- * Promoted equality module Data.Promotion.Prelude.Eq, @@ -41,18 +41,22 @@ -- * Promoted numbers module Data.Promotion.Prelude.Num, + type (^), + -- * Promoted 'Show' + PShow(..), ShowS, SChar, show_, type (<>), Shows, ShowChar, ShowString, ShowParen, + -- ** Miscellaneous functions Id, Const, (:.), type ($), type ($!), Flip, AsTypeOf, Until, Seq, -- * List operations - Map, (:++), Filter, - Head, Last, Tail, Init, Null, Length, (:!!), + Map, type (++), Filter, + Head, Last, Tail, Init, Null, Length, type (!!), Reverse, -- ** Reducing lists (folds) Foldl, Foldl1, Foldr, Foldr1, -- *** Special folds - And, Or, any_, Any_, All, + And, Or, Any, All, Sum, Product, Concat, ConcatMap, Maximum, Minimum, @@ -69,10 +73,14 @@ Elem, NotElem, Lookup, -- ** Zipping and unzipping lists Zip, Zip3, ZipWith, ZipWith3, Unzip, Unzip3, + -- ** Functions on 'Symbol's + Unlines, Unwords, -- * Defunctionalization symbols FalseSym0, TrueSym0, - NotSym0, NotSym1, (:&&$), (:&&$$), (:&&$$$), (:||$), (:||$$), (:||$$$), + NotSym0, NotSym1, + type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), + type (||@#@$), type (||@#@$$), type (||@#@$$$), OtherwiseSym0, NothingSym0, JustSym0, JustSym1, @@ -92,18 +100,29 @@ CurrySym0, CurrySym1, CurrySym2, CurrySym3, UncurrySym0, UncurrySym1, UncurrySym2, - (:^$), (:^$$), + ErrorSym0, ErrorSym1, UndefinedSym0, + type (^@#@$), type (^@#@$$), type (^@#@$$$), + + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + Show_Sym0, Show_Sym1, + ShowListSym0, ShowListSym1, ShowListSym2, + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + ShowsSym0, ShowsSym1, ShowsSym2, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - (:.$), (:.$$), (:.$$$), - type ($$), type ($$$), type ($$$$), - type ($!$), type ($!$$), type ($!$$$), + type (.@#@$), type (.@#@$$), type (.@#@$$$), + type ($@#@$), type ($@#@$$), type ($@#@$$$), + type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), FlipSym0, FlipSym1, FlipSym2, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2, - (:$), (:$$), (:$$$), NilSym0, + (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, - (:++$$), (:++$), HeadSym0, HeadSym1, LastSym0, LastSym1, + type (++@#@$$), type (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, @@ -116,7 +135,7 @@ MaximumBySym0, MaximumBySym1, MaximumBySym2, MinimumBySym0, MinimumBySym1, MinimumBySym2, AndSym0, AndSym1, OrSym0, OrSym1, - Any_Sym0, Any_Sym1, Any_Sym2, + AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, @@ -133,6 +152,8 @@ ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, UnzipSym0, UnzipSym1, + UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1, + UntilSym0, UntilSym1, UntilSym2, UntilSym3, LengthSym0, LengthSym1, SumSym0, SumSym1, @@ -147,7 +168,7 @@ BreakSym0, BreakSym1, BreakSym2, LookupSym0, LookupSym1, LookupSym2, FilterSym0, FilterSym1, FilterSym2, - (:!!$), (:!!$$), (:!!$$$), + type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ) where import Data.Promotion.Prelude.Base @@ -161,4 +182,5 @@ import Data.Promotion.Prelude.Enum hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1) import Data.Promotion.Prelude.Num +import Data.Promotion.Prelude.Show import Data.Singletons.TypeLits diff --git a/src/Data/Promotion/Prelude/Base.hs b/src/Data/Promotion/Prelude/Base.hs --- a/src/Data/Promotion/Prelude/Base.hs +++ b/src/Data/Promotion/Prelude/Base.hs @@ -23,19 +23,19 @@ module Data.Promotion.Prelude.Base ( -- * Promoted functions from @GHC.Base@ - Foldr, Map, (:++), Otherwise, Id, Const, (:.), type ($), type ($!), + Foldr, Map, type (++), Otherwise, Id, Const, (:.), type ($), type ($!), Flip, Until, AsTypeOf, Seq, -- * Defunctionalization symbols FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, MapSym0, MapSym1, MapSym2, - (:++$), (:++$$), (:++$$$), + type (++@#@$), type (++@#@$$), type (++@#@$$$), OtherwiseSym0, IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - (:.$), (:.$$), (:.$$$), (:.$$$$), - type ($$), type ($$$), type ($$$$), - type ($!$), type ($!$$), type ($!$$$), + type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), + type ($@#@$), type ($@#@$$), type ($@#@$$$), + type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), FlipSym0, FlipSym1, FlipSym2, FlipSym3, UntilSym0, UntilSym1, UntilSym2, UntilSym3, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, diff --git a/src/Data/Promotion/Prelude/Bool.hs b/src/Data/Promotion/Prelude/Bool.hs --- a/src/Data/Promotion/Prelude/Bool.hs +++ b/src/Data/Promotion/Prelude/Bool.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitNamespaces #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Promotion.Prelude.Bool @@ -27,14 +29,14 @@ -- @Data.Bool@. The extra underscore is to avoid name clashes with the type -- 'Bool'. - Not, (:&&), (:||), Otherwise, + Not, type (&&), type (||), Otherwise, -- * Defunctionalization symbols TrueSym0, FalseSym0, NotSym0, NotSym1, - (:&&$), (:&&$$), (:&&$$$), - (:||$), (:||$$), (:||$$$), + type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), + type (||@#@$), type (||@#@$$), type (||@#@$$$), Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3, OtherwiseSym0 ) where diff --git a/src/Data/Promotion/Prelude/Eq.hs b/src/Data/Promotion/Prelude/Eq.hs --- a/src/Data/Promotion/Prelude/Eq.hs +++ b/src/Data/Promotion/Prelude/Eq.hs @@ -13,7 +13,9 @@ {-# LANGUAGE ExplicitNamespaces #-} module Data.Promotion.Prelude.Eq ( - PEq(..), (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$) + PEq(..), + type (==@#@$), type (==@#@$$), type (==@#@$$$), + type (/=@#@$), type (/=@#@$$), type (/=@#@$$$) ) where import Data.Singletons.Prelude.Eq diff --git a/src/Data/Promotion/Prelude/Function.hs b/src/Data/Promotion/Prelude/Function.hs --- a/src/Data/Promotion/Prelude/Function.hs +++ b/src/Data/Promotion/Prelude/Function.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitNamespaces #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Promotion.Prelude.Function @@ -23,15 +25,15 @@ -- * "Prelude" re-exports Id, Const, (:.), Flip, type ($) -- * Other combinators - , (:&), On + , type (&), On -- * Defunctionalization symbols , IdSym0, IdSym1 , ConstSym0, ConstSym1, ConstSym2 - , (:.$), (:.$$), (:.$$$), (:.$$$$) + , type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$) , FlipSym0, FlipSym1, FlipSym2, FlipSym3 - , type ($$), type ($$$), type ($$$$) - , (:&$), (:&$$), (:&$$$) + , type ($@#@$), type ($@#@$$), type ($@#@$$$) + , type (&@#@$), type (&@#@$$), type (&@#@$$$) , OnSym0, OnSym1, OnSym2, OnSym3, OnSym4 ) where diff --git a/src/Data/Promotion/Prelude/IsString.hs b/src/Data/Promotion/Prelude/IsString.hs new file mode 100644 --- /dev/null +++ b/src/Data/Promotion/Prelude/IsString.hs @@ -0,0 +1,22 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Promotion.Prelude.IsString +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines and exports a promoted version of the 'IsString' +-- type class from "Data.String". +---------------------------------------------------------------------------- + +module Data.Promotion.Prelude.IsString ( + PIsString(..), + + -- ** Defunctionalization symbols + FromStringSym0, FromStringSym1 + ) where + +import Data.Singletons.Prelude.IsString +import Data.Singletons.TypeLits () -- for the IsString instance! diff --git a/src/Data/Promotion/Prelude/List.hs b/src/Data/Promotion/Prelude/List.hs --- a/src/Data/Promotion/Prelude/List.hs +++ b/src/Data/Promotion/Prelude/List.hs @@ -24,7 +24,7 @@ module Data.Promotion.Prelude.List ( -- * Basic functions - (:++), Head, Last, Tail, Init, Null, Length, + type (++), Head, Last, Tail, Init, Null, Length, -- * List transformations Map, Reverse, Intersperse, Intercalate, Transpose, Subsequences, Permutations, @@ -33,8 +33,7 @@ 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 + Concat, ConcatMap, And, Or, Any, All, Sum, Product, Maximum, Minimum, -- * Building lists @@ -71,7 +70,7 @@ Find, Filter, Partition, -- * Indexing lists - (:!!), ElemIndex, ElemIndices, FindIndex, FindIndices, + type (!!), ElemIndex, ElemIndices, FindIndex, FindIndices, -- * Zipping and unzipping lists Zip, Zip3, Zip4, Zip5, Zip6, Zip7, @@ -80,8 +79,11 @@ -- * Special lists + -- ** Functions on 'Symbol's + Unlines, Unwords, + -- ** \"Set\" operations - Nub, Delete, (:\\), Union, Intersect, + Nub, Delete, type (\\), Union, Intersect, -- ** Ordered lists Sort, Insert, @@ -102,9 +104,10 @@ -- * Defunctionalization symbols NilSym0, - (:$), (:$$), (:$$$), + (:@#@$), (:@#@$$), (:@#@$$$), - (:++$$$), (:++$$), (:++$), HeadSym0, HeadSym1, LastSym0, LastSym1, + type (++@#@$$$), type (++@#@$$), type (++@#@$), + HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, @@ -123,7 +126,7 @@ ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, - Any_Sym0, Any_Sym1, Any_Sym2, + AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, @@ -157,7 +160,7 @@ Unzip7Sym0, Unzip7Sym1, DeleteSym0, DeleteSym1, DeleteSym2, - (:\\$), (:\\$$), (:\\$$$), + type (\\@#@$), type (\\@#@$$), type (\\@#@$$$), IntersectSym0, IntersectSym1, IntersectSym2, InsertSym0, InsertSym1, InsertSym2, @@ -193,7 +196,7 @@ FilterSym0, FilterSym1, FilterSym2, PartitionSym0, PartitionSym1, PartitionSym2, - (:!!$), (:!!$$), (:!!$$$), + type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ElemIndexSym0, ElemIndexSym1, ElemIndexSym2, ElemIndicesSym0, ElemIndicesSym1, ElemIndicesSym2, @@ -209,6 +212,9 @@ ZipWith5Sym0, ZipWith5Sym1, ZipWith5Sym2, ZipWith5Sym3, ZipWith5Sym4, ZipWith5Sym5, ZipWith5Sym6, ZipWith6Sym0, ZipWith6Sym1, ZipWith6Sym2, ZipWith6Sym3, ZipWith6Sym4, ZipWith6Sym5, ZipWith6Sym6, ZipWith6Sym7, ZipWith7Sym0, ZipWith7Sym1, ZipWith7Sym2, ZipWith7Sym3, ZipWith7Sym4, ZipWith7Sym5, ZipWith7Sym6, ZipWith7Sym7, ZipWith7Sym8, + + UnlinesSym0, UnlinesSym1, + UnwordsSym0, UnwordsSym1, NubSym0, NubSym1, NubBySym0, NubBySym1, NubBySym2, diff --git a/src/Data/Promotion/Prelude/List/NonEmpty.hs b/src/Data/Promotion/Prelude/List/NonEmpty.hs --- a/src/Data/Promotion/Prelude/List/NonEmpty.hs +++ b/src/Data/Promotion/Prelude/List/NonEmpty.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitNamespaces #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Promotion.Prelude.List.NonEmpty @@ -29,7 +31,7 @@ Tail, Last, Init, - (:<|), + type (<|), Cons, Uncons, Unfoldr, @@ -59,7 +61,7 @@ IsPrefixOf, Nub, NubBy, - (:!!), + type (!!), Zip, ZipWith, Unzip, @@ -69,7 +71,7 @@ Xor, -- * Defunctionalization symbols - (:|$), (:|$$), (:|$$$), + (:|@#@$), (:|@#@$$), (:|@#@$$$), MapSym0, MapSym1, MapSym2, IntersperseSym0, IntersperseSym1, IntersperseSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, @@ -84,7 +86,7 @@ TailSym0, TailSym1, LastSym0, LastSym1, InitSym0, InitSym1, - (:<|$), (:<|$$), (:<|$$$), + type (<|@#@$), type (<|@#@$$), type (<|@#@$$$), ConsSym0, ConsSym1, ConsSym2, UnconsSym0, UnconsSym1, UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, @@ -114,7 +116,7 @@ IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, NubSym0, NubSym1, NubBySym0, NubBySym1, NubBySym2, - (:!!$), (:!!$$), (:!!$$$), + type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ZipSym0, ZipSym1, ZipSym2, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, UnzipSym0, UnzipSym1, diff --git a/src/Data/Promotion/Prelude/Num.hs b/src/Data/Promotion/Prelude/Num.hs --- a/src/Data/Promotion/Prelude/Num.hs +++ b/src/Data/Promotion/Prelude/Num.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitNamespaces #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Promotion.Prelude.Num @@ -16,9 +18,9 @@ PNum(..), Subtract, -- ** Defunctionalization symbols - (:+$), (:+$$), (:+$$$), - (:-$), (:-$$), (:-$$$), - (:*$), (:*$$), (:*$$$), + type (+@#@$), type (+@#@$$), type (+@#@$$$), + type (-@#@$), type (-@#@$$), type (-@#@$$$), + type (*@#@$), type (*@#@$$), type (*@#@$$$), NegateSym0, NegateSym1, AbsSym0, AbsSym1, SignumSym0, SignumSym1, diff --git a/src/Data/Promotion/Prelude/Ord.hs b/src/Data/Promotion/Prelude/Ord.hs --- a/src/Data/Promotion/Prelude/Ord.hs +++ b/src/Data/Promotion/Prelude/Ord.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitNamespaces #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Promotion.Prelude.Ord @@ -13,14 +15,21 @@ module Data.Promotion.Prelude.Ord ( POrd(..), + + Comparing, + ThenCmp, + + -- ** Defunctionalization symbols + ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, LTSym0, EQSym0, GTSym0, CompareSym0, CompareSym1, CompareSym2, - (:<$), (:<$$), (:<$$$), - (:<=$), (:<=$$), (:<=$$$), - (:>$), (:>$$), (:>$$$), - (:>=$), (:>=$$), (:>=$$$), + type (<@#@$), type (<@#@$$), type (<@#@$$$), + type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), + type (>@#@$), type (>@#@$$), type (>@#@$$$), + type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), MaxSym0, MaxSym1, MaxSym2, - MinSym0, MinSym1, MinSym2 + MinSym0, MinSym1, MinSym2, + ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3 ) where import Data.Singletons.Prelude.Ord diff --git a/src/Data/Promotion/Prelude/Show.hs b/src/Data/Promotion/Prelude/Show.hs new file mode 100644 --- /dev/null +++ b/src/Data/Promotion/Prelude/Show.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Promotion.Prelude.Show +-- Copyright : (C) 2014 Jan Stolarek, Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports a promoted version of 'Show' +-- +----------------------------------------------------------------------------- + +module Data.Promotion.Prelude.Show ( + PShow(..), SymbolS, SChar, show_, type (<>), + Shows, ShowListWith, ShowChar, ShowString, ShowParen, + ShowSpace, ShowCommaSpace, AppPrec, AppPrec1, + + -- * Defunctionalization symbols + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + Show_Sym0, Show_Sym1, + ShowListSym0, ShowListSym1, ShowListSym2, + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + ShowsSym0, ShowsSym1, ShowsSym2, + ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + ShowSpaceSym0, ShowSpaceSym1, + ShowCommaSpaceSym0, ShowCommaSpaceSym1, + AppPrecSym0, AppPrec1Sym0 + ) where + +import Data.Singletons.Prelude.Show diff --git a/src/Data/Promotion/Prelude/Void.hs b/src/Data/Promotion/Prelude/Void.hs new file mode 100644 --- /dev/null +++ b/src/Data/Promotion/Prelude/Void.hs @@ -0,0 +1,28 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Promotion.Prelude.Void +-- Copyright : (C) 2014 Jan Stolarek +-- License : BSD-style (see LICENSE) +-- Maintainer : jan.stolarek@p.lodz.pl +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines promoted functions and datatypes relating to 'Void', +-- including a promoted version of all the definitions in @Data.Void@. +-- +-- Because many of these definitions are produced by Template Haskell, +-- it is not possible to create proper Haddock documentation. Please look +-- up the corresponding operation in @Data.Void@. Also, please excuse +-- the apparent repeated variable names. This is due to an interaction +-- between Template Haskell and Haddock. +-- +---------------------------------------------------------------------------- +module Data.Promotion.Prelude.Void ( + -- * Promoted functions from from @Data.Void@ + Absurd, + + -- * Defunctionalization symbols + AbsurdSym0, AbsurdSym1 + ) where + +import Data.Singletons.Prelude.Void diff --git a/src/Data/Promotion/TH.hs b/src/Data/Promotion/TH.hs --- a/src/Data/Promotion/TH.hs +++ b/src/Data/Promotion/TH.hs @@ -30,6 +30,9 @@ -- ** Functions to generate @Enum@ instances promoteEnumInstances, promoteEnumInstance, + -- ** Functions to generate @Show@ instances + promoteShowInstances, promoteShowInstance, + -- ** defunctionalization TyFun, Apply, type (@@), @@ -37,13 +40,20 @@ -- | These definitions might be mentioned in code generated by Template Haskell, -- so they must be in scope. - PEq(..), If, (:&&), - POrd(..), - Any, - Proxy(..), ThenCmp, Foldl, + PEq(..), If, type (&&), + POrd(..), ThenCmp, Foldl, + PBounded(..), + PEnum(FromEnum, ToEnum), + PShow(..), + ShowString, ShowParen, ShowSpace, ShowChar, ShowCommaSpace, + (:.), + Proxy(..), - Error, ErrorSym0, + Error, ErrorSym0, ErrorSym1, + Undefined, UndefinedSym0, TrueSym0, FalseSym0, + type (==@#@$), type (==@#@$$), type (==@#@$$$), + type (>@#@$), type (>@#@$$), type (>@#@$$$), LTSym0, EQSym0, GTSym0, Tuple0Sym0, Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, @@ -52,18 +62,31 @@ Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, - ThenCmpSym0, FoldlSym0, + CompareSym0, CompareSym1, CompareSym2, + ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, + FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, + MinBoundSym0, MaxBoundSym0, + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + ShowSpaceSym0, ShowSpaceSym1, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowCommaSpaceSym0, ShowCommaSpaceSym1, + type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), + (:@#@$), (:@#@$$), (:@#@$$$), SuppressUnusedWarnings(..) ) where -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.Promote +import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Bool +import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Show import Data.Singletons.TypeLits import Data.Singletons.SuppressUnusedWarnings -import GHC.Exts diff --git a/src/Data/Singletons.hs b/src/Data/Singletons.hs --- a/src/Data/Singletons.hs +++ b/src/Data/Singletons.hs @@ -1,7 +1,13 @@ -{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds, - FlexibleContexts, FlexibleInstances, - TypeFamilies, TypeOperators, TypeFamilyDependencies, - UndecidableInstances, TypeInType, ConstraintKinds #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeInType #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | @@ -26,23 +32,23 @@ module Data.Singletons ( -- * Main singleton definitions - Sing(SLambda, applySing), - -- | See also 'Data.Singletons.Prelude.Sing' for exported constructors + Sing(SLambda, applySing), (@@), SingI(..), SingKind(..), -- * Working with singletons KindOf, SameKind, SingInstance(..), SomeSing(..), - singInstance, withSingI, withSomeSing, singByProxy, + singInstance, pattern Sing, withSingI, + withSomeSing, pattern FromSing, + singByProxy, demote, singByProxy#, withSing, singThat, -- ** Defunctionalization TyFun, type (~>), - TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8, - Apply, type (@@), + TyCon, Apply, type (@@), -- ** Defunctionalized singletons -- | When calling a higher-order singleton function, you need to use a @@ -51,6 +57,9 @@ singFun8, unSingFun1, unSingFun2, unSingFun3, unSingFun4, unSingFun5, unSingFun6, unSingFun7, unSingFun8, + -- $SLambdaPatternSynonyms + pattern SLambda2, pattern SLambda3, pattern SLambda4, pattern SLambda5, + pattern SLambda6, pattern SLambda7, pattern SLambda8, -- | These type synonyms are exported only to improve error messages; users -- should not have to mention them. @@ -58,262 +67,109 @@ SingFunction6, SingFunction7, SingFunction8, -- * Auxiliary functions - Proxy(..) - ) where - -import Data.Kind -import Unsafe.Coerce -import Data.Proxy ( Proxy(..) ) -import GHC.Exts ( Proxy#, Constraint ) - --- | Convenient synonym to refer to the kind of a type variable: --- @type KindOf (a :: k) = k@ -type KindOf (a :: k) = k - --- | Force GHC to unify the kinds of @a@ and @b@. Note that @SameKind a b@ is --- different from @KindOf a ~ KindOf b@ in that the former makes the kinds --- unify immediately, whereas the latter is a proposition that GHC considers --- as possibly false. -type SameKind (a :: k) (b :: k) = (() :: Constraint) - ----------------------------------------------------------------------- ----- Sing & friends -------------------------------------------------- ----------------------------------------------------------------------- - --- | The singleton kind-indexed data family. -data family Sing (a :: k) - --- | A 'SingI' constraint is essentially an implicitly-passed singleton. --- If you need to satisfy this constraint with an explicit singleton, please --- see 'withSingI'. -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 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 @Integer@. - type Demote k = (r :: *) | r -> k - - -- | Convert a singleton to its unrefined version. - fromSing :: Sing (a :: k) -> Demote k - - -- | Convert an unrefined type to an existentially-quantified singleton type. - toSing :: Demote k -> SomeSing k - --- | An /existentially-quantified/ singleton. This type is useful when you want a --- singleton type, but there is no way of knowing, at compile-time, what the type --- index will be. To make use of this type, you will generally have to use a --- pattern-match: --- --- > foo :: Bool -> ... --- > foo b = case toSing b of --- > SomeSing sb -> {- fancy dependently-typed code with sb -} --- --- An example like the one above may be easier to write using 'withSomeSing'. -data SomeSing k where - SomeSing :: Sing (a :: k) -> SomeSing k - ----------------------------------------------------------------------- ----- SingInstance ---------------------------------------------------- ----------------------------------------------------------------------- - --- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling. -data SingInstance (a :: k) where - SingInstance :: SingI a => SingInstance a + Proxy(..), --- dirty implementation of explicit-to-implicit conversion -newtype DI a = Don'tInstantiate (SingI a => SingInstance a) + -- * Defunctionalization symbols + DemoteSym0, DemoteSym1, + SameKindSym0, SameKindSym1, SameKindSym2, + KindOfSym0, KindOfSym1, + type (~>@#@$), type (~>@#@$$), type (~>@#@$$$), + ApplySym0, ApplySym1, ApplySym2, + type (@@@#@$), type (@@@#@$$), type (@@@#@$$$) + ) where --- | 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 +import Data.Singletons.Promote +import Data.Singletons.Internal +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Num +import Data.Singletons.ShowSing ---------------------------------------------------------------------- ----- Defunctionalization --------------------------------------------- +---- SomeSing instances ---------------------------------------------- ---------------------------------------------------------------------- --- | 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 :: * -> * -> * +instance SEq k => Eq (SomeSing k) where + SomeSing a == SomeSing b = fromSing (a %== b) + SomeSing a /= SomeSing b = fromSing (a %/= b) --- | 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 ~> +instance SOrd k => Ord (SomeSing k) where + SomeSing a `compare` SomeSing b = fromSing (a `sCompare` b) + SomeSing a < SomeSing b = fromSing (a %< b) + SomeSing a <= SomeSing b = fromSing (a %<= b) + SomeSing a > SomeSing b = fromSing (a %> b) + SomeSing a >= SomeSing b = fromSing (a %>= b) --- | 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) +instance SBounded k => Bounded (SomeSing k) where + minBound = SomeSing sMinBound + maxBound = SomeSing sMaxBound --- | 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) +instance (SEnum k, SingKind k) => Enum (SomeSing k) where + succ (SomeSing a) = SomeSing (sSucc a) + pred (SomeSing a) = SomeSing (sPred a) + toEnum n = withSomeSing (fromIntegral n) (SomeSing . sToEnum) + fromEnum (SomeSing a) = fromIntegral (fromSing (sFromEnum a)) + enumFromTo (SomeSing from) (SomeSing to) = + map toSing (fromSing (sEnumFromTo from to)) + enumFromThenTo (SomeSing from) (SomeSing then_) (SomeSing to) = + map toSing (fromSing (sEnumFromThenTo from then_ to)) --- | 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) +instance SNum k => Num (SomeSing k) where + SomeSing a + SomeSing b = SomeSing (a %+ b) + SomeSing a - SomeSing b = SomeSing (a %- b) + SomeSing a * SomeSing b = SomeSing (a %* b) + negate (SomeSing a) = SomeSing (sNegate a) + abs (SomeSing a) = SomeSing (sAbs a) + signum (SomeSing a) = SomeSing (sSignum a) + fromInteger n = withSomeSing (fromIntegral n) (SomeSing . sFromInteger) --- | An infix synonym for `Apply` -type a @@ b = Apply a b -infixl 9 @@ +instance ShowSing k => Show (SomeSing k) where + showsPrec p (SomeSing s) = + showParen (p > 10) $ showString "SomeSing " . showsSingPrec 11 s ---------------------------------------------------------------------- ----- Defunctionalized Sing instance and utilities -------------------- +---- Defunctionalization symbols ------------------------------------- ---------------------------------------------------------------------- -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 Demote (k1 ~> k2) = Demote k1 -> Demote 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 need visible type application --- to get this to work. For example: --- --- > falses = sMap (singFun1 @NotSym0 sNot) --- > (STrue `SCons` STrue `SCons` SNil) --- --- There are a family of @singFun...@ functions, keyed by the number --- of parameters of the function. -singFun1 :: forall f. SingFunction1 f -> Sing f -singFun1 f = SLambda f - -type SingFunction2 f = forall t. Sing t -> SingFunction1 (f @@ t) -singFun2 :: forall f. SingFunction2 f -> Sing f -singFun2 f = SLambda (\x -> singFun1 (f x)) - -type SingFunction3 f = forall t. Sing t -> SingFunction2 (f @@ t) -singFun3 :: forall f. SingFunction3 f -> Sing f -singFun3 f = SLambda (\x -> singFun2 (f x)) - -type SingFunction4 f = forall t. Sing t -> SingFunction3 (f @@ t) -singFun4 :: forall f. SingFunction4 f -> Sing f -singFun4 f = SLambda (\x -> singFun3 (f x)) - -type SingFunction5 f = forall t. Sing t -> SingFunction4 (f @@ t) -singFun5 :: forall f. SingFunction5 f -> Sing f -singFun5 f = SLambda (\x -> singFun4 (f x)) - -type SingFunction6 f = forall t. Sing t -> SingFunction5 (f @@ t) -singFun6 :: forall f. SingFunction6 f -> Sing f -singFun6 f = SLambda (\x -> singFun5 (f x)) - -type SingFunction7 f = forall t. Sing t -> SingFunction6 (f @@ t) -singFun7 :: forall f. SingFunction7 f -> Sing f -singFun7 f = SLambda (\x -> singFun6 (f x)) - -type SingFunction8 f = forall t. Sing t -> SingFunction7 (f @@ t) -singFun8 :: forall f. SingFunction8 f -> Sing f -singFun8 f = SLambda (\x -> singFun7 (f x)) - --- | This is the inverse of 'singFun1', and likewise for the other --- @unSingFun...@ functions. -unSingFun1 :: forall f. Sing f -> SingFunction1 f -unSingFun1 sf = applySing sf - -unSingFun2 :: forall f. Sing f -> SingFunction2 f -unSingFun2 sf x = unSingFun1 (sf `applySing` x) - -unSingFun3 :: forall f. Sing f -> SingFunction3 f -unSingFun3 sf x = unSingFun2 (sf `applySing` x) - -unSingFun4 :: forall f. Sing f -> SingFunction4 f -unSingFun4 sf x = unSingFun3 (sf `applySing` x) - -unSingFun5 :: forall f. Sing f -> SingFunction5 f -unSingFun5 sf x = unSingFun4 (sf `applySing` x) - -unSingFun6 :: forall f. Sing f -> SingFunction6 f -unSingFun6 sf x = unSingFun5 (sf `applySing` x) - -unSingFun7 :: forall f. Sing f -> SingFunction7 f -unSingFun7 sf x = unSingFun6 (sf `applySing` x) +$(genDefunSymbols [''Demote, ''SameKind, ''KindOf, ''(~>), ''Apply, ''(@@)]) +-- SingFunction1 et al. are not defunctionalizable at the moment due to #198 -unSingFun8 :: forall f. Sing f -> SingFunction8 f -unSingFun8 sf x = unSingFun7 (sf `applySing` x) +{- $SLambdaPatternSynonyms ----------------------------------------------------------------------- ----- Convenience ----------------------------------------------------- ----------------------------------------------------------------------- +@SLambda{2...8}@ are explicitly bidirectional pattern synonyms for +defunctionalized singletons (@'Sing' (f :: k '~>' k' '~>' k'')@). --- | 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 +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])@: --- | 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' +@ +>>> import Data.Singletons.Prelude.List +>>> :set -XTypeApplications +>>> +>>> :t 'SLambda2' +'SLambda2' :: 'SingFunction2' f -> 'Sing' f +>>> :t 'SLambda2' \@TakeSym0 +'SLambda2' :: 'SingFunction2' TakeSym0 -> 'Sing' TakeSym0 +>>> :t 'SLambda2' \@TakeSym0 sTake +'SLambda2' :: 'Sing' TakeSym0 +@ --- | 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 +This is useful for functions on singletons that expect a defunctionalized +singleton as an argument, such as @sZipWith :: 'SingFunction3' ZipWithSym0@: --- | A convenience function that names a singleton satisfying a certain --- property. If the singleton does not satisfy the property, then the function --- returns 'Nothing'. The property is expressed in terms of the underlying --- representation of the singleton. -singThat :: forall (a :: k). (SingKind k, SingI a) - => (Demote k -> Bool) -> Maybe (Sing a) -singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing +@ +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]]) +@ --- | Allows creation of a singleton when a proxy is at hand. -singByProxy :: SingI a => proxy a -> Sing a -singByProxy _ = sing +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: --- | Allows creation of a singleton when a @proxy#@ is at hand. -singByProxy# :: SingI a => Proxy# a -> Sing a -singByProxy# _ = sing +@ +applySing2 :: 'Sing' (f :: k '~>' k' '~>' k'') -> 'SingFunction2' f +@ +-} diff --git a/src/Data/Singletons/CustomStar.hs b/src/Data/Singletons/CustomStar.hs --- a/src/Data/Singletons/CustomStar.hs +++ b/src/Data/Singletons/CustomStar.hs @@ -20,12 +20,15 @@ singletonStar, module Data.Singletons.Prelude.Eq, - module Data.Singletons.Prelude.Bool + module Data.Singletons.Prelude.Bool, + module Data.Singletons.TH ) where import Language.Haskell.TH import Data.Singletons.Util +import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Ord +import Data.Singletons.Deriving.Show import Data.Singletons.Promote import Data.Singletons.Promote.Monad import Data.Singletons.Single.Monad @@ -33,6 +36,7 @@ import Data.Singletons.Single import Data.Singletons.Syntax import Data.Singletons.Names +import Data.Singletons.TH import Control.Monad import Data.Maybe import Language.Haskell.TH.Desugar @@ -51,7 +55,7 @@ -- -- generates the following: -- --- > data Rep = Nat | Bool | Maybe Rep deriving (Eq, Show, Read) +-- > data Rep = Nat | Bool | Maybe Rep deriving (Eq, Ord, Read, Show) -- -- and its singleton. However, because @Rep@ is promoted to @*@, the singleton -- is perhaps slightly unexpected: @@ -59,7 +63,7 @@ -- > data instance Sing (a :: *) where -- > SNat :: Sing Nat -- > SBool :: Sing Bool --- > SMaybe :: SingRep a => Sing a -> Sing (Maybe a) +-- > SMaybe :: Sing a -> Sing (Maybe a) -- -- The unexpected part is that @Nat@, @Bool@, and @Maybe@ above are the real @Nat@, -- @Bool@, and @Maybe@, not just promoted data constructors. @@ -72,16 +76,24 @@ kinds <- mapM getKind names ctors <- zipWithM (mkCtor True) names kinds let repDecl = DDataD Data [] repName [] ctors - [DDerivClause Nothing [DConPr ''Eq, DConPr ''Show, DConPr ''Read]] + [DDerivClause Nothing (map DConPr [''Eq, ''Ord, ''Read, ''Show])] 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 + [DConPr ''Show, DConPr ''Read] + -- We opt to infer the constraints for the Eq instance here so that when it's + -- promoted, Rep will be promoted to Type. + dataDeclEqCxt <- inferConstraints (DConPr ''Eq) (DConT repName) fakeCtors + let dataDeclEqInst = DerivedDecl (Just dataDeclEqCxt) (DConT repName) fakeCtors + ordInst <- mkOrdInstance Nothing (DConT repName) fakeCtors + showInst <- mkShowInstance ForPromotion Nothing (DConT repName) fakeCtors + (pInsts, promDecls) <- promoteM [] $ do promoteDataDec dataDecl + promoteDerivedEqDec dataDeclEqInst + traverse (promoteInstanceDec mempty) + [ordInst, showInst] singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl - dec2 <- singInstD pOrdInst - return (dec2 : decs1) + decs2 <- singDerivedEqDecs dataDeclEqInst + decs3 <- traverse singInstD pInsts + return (decs1 ++ decs2 ++ decs3) return $ decsToTH $ repDecl : promDecls ++ singletonDecls @@ -108,7 +120,7 @@ (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)) + (DNormalC False (map (\ty -> (noBang, ty)) types)) Nothing where noBang = Bang NoSourceUnpackedness NoSourceStrictness diff --git a/src/Data/Singletons/Decide.hs b/src/Data/Singletons/Decide.hs --- a/src/Data/Singletons/Decide.hs +++ b/src/Data/Singletons/Decide.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators, TypeInType, TypeFamilies, FlexibleContexts, UndecidableInstances, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +24,8 @@ ) where import Data.Kind -import Data.Singletons +import Data.Singletons.Internal +import Data.Type.Coercion import Data.Type.Equality import Data.Void @@ -48,9 +49,16 @@ class SDecide k where -- | Compute a proof or disproof of equality, given two singletons. (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b) + infix 4 %~ instance SDecide k => TestEquality (Sing :: k -> Type) where testEquality a b = case a %~ b of Proved Refl -> Just Refl + Disproved _ -> Nothing + +instance SDecide k => TestCoercion (Sing :: k -> Type) where + testCoercion a b = + case a %~ b of + Proved Refl -> Just Coercion Disproved _ -> Nothing diff --git a/src/Data/Singletons/Deriving/Bounded.hs b/src/Data/Singletons/Deriving/Bounded.hs --- a/src/Data/Singletons/Deriving/Bounded.hs +++ b/src/Data/Singletons/Deriving/Bounded.hs @@ -13,7 +13,6 @@ 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 @@ -24,8 +23,8 @@ -- monadic only for failure and parallelism with other functions -- that make instances -mkBoundedInstance :: Quasi q => DType -> [DCon] -> q UInstDecl -mkBoundedInstance ty cons = do +mkBoundedInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl +mkBoundedInstance mb_ctxt ty cons = do -- We can derive instance of Bounded if datatype is an enumeration (all -- constructors must be nullary) or has only one constructor. See Section 11 -- of Haskell 2010 Language Report. @@ -50,7 +49,8 @@ in (minEqnRHS, maxEqnRHS) mk_rhs rhs = UFunction [DClause [] rhs] - return $ InstDecl { id_cxt = inferConstraints (DConPr boundedName) cons + constraints <- inferConstraintsDef mb_ctxt (DConPr boundedName) ty cons + return $ InstDecl { id_cxt = constraints , id_name = boundedName , id_arg_tys = [ty] , id_meths = [ (minBoundName, mk_rhs minRHS) diff --git a/src/Data/Singletons/Deriving/Enum.hs b/src/Data/Singletons/Deriving/Enum.hs --- a/src/Data/Singletons/Deriving/Enum.hs +++ b/src/Data/Singletons/Deriving/Enum.hs @@ -23,8 +23,8 @@ import Data.Maybe -- monadic for failure only -mkEnumInstance :: Quasi q => DType -> [DCon] -> q UInstDecl -mkEnumInstance ty cons = do +mkEnumInstance :: Quasi q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl +mkEnumInstance mb_ctxt ty cons = do when (null cons || any (\(DCon tvbs cxt _ f rty) -> or [ not $ null $ tysOfConFields f , not $ null tvbs @@ -43,7 +43,7 @@ from_enum = UFunction (zipWith (\i con -> DClause [DConPa (extractName con) []] (DLitE (IntegerL i))) [0..] cons) - return (InstDecl { id_cxt = [] + return (InstDecl { id_cxt = fromMaybe [] mb_ctxt , id_name = singletonsEnumName -- need to use singletons's Enum class to get the types -- to use Nat instead of Int diff --git a/src/Data/Singletons/Deriving/Infer.hs b/src/Data/Singletons/Deriving/Infer.hs --- a/src/Data/Singletons/Deriving/Infer.hs +++ b/src/Data/Singletons/Deriving/Infer.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Infer @@ -11,14 +13,103 @@ -- ---------------------------------------------------------------------------- -module Data.Singletons.Deriving.Infer ( inferConstraints ) where +module Data.Singletons.Deriving.Infer ( inferConstraints, inferConstraintsDef ) where import Language.Haskell.TH.Desugar import Data.Singletons.Util import Data.List import Data.Generics.Twins -inferConstraints :: DPred -> [DCon] -> DCxt -inferConstraints pr = nubBy geq . concatMap infer_ct +-- @inferConstraints cls inst_ty cons@ infers the instance context for a +-- derived type class instance of @cls@ for @inst_ty@, using the constructors +-- @cons@. For instance, if @cls@ is 'Ord' and @inst_ty@ is @Either a b@, then +-- that means we are attempting to derive the instance: +-- +-- @ +-- instance ??? => Ord (Either a b) +-- @ +-- +-- The role of 'inferConstraints' is to determine what @???@ should be in that +-- derived instance. To accomplish this, the list of @cons@ (in this example, +-- @cons@ would be @[Left a, Right b]@) is used as follows: +-- +-- 1. For each @con@ in @cons@, find the types of each of its fields +-- (call these @field_tys@), perhaps after renaming the type variables of +-- @field_tys@. +-- 2. For each @field_ty@ in @field_tys@, apply @cls@ to @field_ty@ to obtain +-- a constraint. +-- 3. The final instance context is the set of all such constraints obtained +-- in step 2. +-- +-- To complete the running example, this algorithm would produce the instance +-- context @(Ord a, Ord b)@, since @Left a@ has one field of type @a@, and +-- @Right b@ has one field of type @b@. +-- +-- This algorithm is a crude approximation of what GHC actually does when +-- deriving instances. It is crude in the sense that one can end up with +-- redundant constraints. For instance, if the data type for which an 'Ord' +-- instance is being derived is @data Foo = MkFoo Bool Foo@, then the +-- inferred constraints would be @(Ord Bool, Ord Foo)@. Technically, neither +-- constraint is necessary, but it is not simple in general to eliminate +-- redundant constraints like these, so we do not attept to do so. (This is +-- one reason why @singletons@ requires the use of the @UndecidableInstances@ +-- GHC extension.) +-- +-- Observant readers will notice that the phrase \"perhaps afer renaming the +-- type variables\" was casually dropped in step 1 of the above algorithm. +-- For more information on what this means, refer to the documentation for +-- infer_ct below. +inferConstraints :: forall q. DsMonad q => DPred -> DType -> [DCon] -> q DCxt +inferConstraints pr inst_ty = fmap (nubBy geq) . concatMapM infer_ct where - infer_ct (DCon _ _ _ fields _) = map (pr `DAppPr`) (tysOfConFields fields) + -- A thorny situation arises when attempting to infer an instance context + -- for a GADT. Consider the following example: + -- + -- newtype Bar a where + -- MkBar :: b -> Bar b + -- deriving Show + -- + -- If we blindly apply 'Show' to the field type of @MkBar@, we will end up + -- with a derived instance of: + -- + -- instance Show b => Show (Bar a) + -- + -- This is completely wrong, since the type variable @b@ is never used in + -- the instance head! This reveals that we need a slightly more nuanced + -- strategy for gathering constraints for GADT constructors. To account + -- for this, when gathering @field_tys@ (from step 1 in the above algorithm) + -- we perform the following extra steps: + -- + -- 1(a). Take the return type of @con@ and match it with @inst_ty@ (e.g., + -- match @Bar b@ with @Bar a@). Doing so will produce a substitution + -- that maps the universally quantified type variables in the GADT + -- (i.e., @b@) to the corresponding type variables in the data type + -- constructor (i.e., @a@). + -- 1(b). Use the resulting substitution to rename the universally + -- quantified type variables of @con@ as necessary. + -- + -- After this renaming, the algorithm will produce an instance context of + -- @Show a@ (since @b@ was renamed to @a@), as expected. + infer_ct :: DCon -> q DCxt + infer_ct (DCon _ _ _ fields mb_res_ty) = do + let field_tys = tysOfConFields fields + field_tys' <- case mb_res_ty of + Nothing -> pure field_tys + Just res_ty -> do + res_ty' <- expandType res_ty + inst_ty' <- expandType inst_ty + case matchTy YesIgnore res_ty' inst_ty of + Nothing -> fail $ showString "Unable to match type " + . showsPrec 11 res_ty' + . showString " with " + . showsPrec 11 inst_ty' + $ "" + Just subst -> traverse (substTy subst) field_tys + pure $ map (pr `DAppPr`) field_tys' + +-- For @inferConstraintsDef mb_cxt@, if @mb_cxt@ is 'Just' a context, then it will +-- simply return that context. Otherwise, if @mb_cxt@ is 'Nothing', then +-- 'inferConstraintsDef' will infer an instance context (using 'inferConstraints'). +inferConstraintsDef :: DsMonad q => Maybe DCxt -> DPred -> DType -> [DCon] -> q DCxt +inferConstraintsDef mb_ctxt pr inst_ty cons = + maybe (inferConstraints pr inst_ty cons) pure mb_ctxt diff --git a/src/Data/Singletons/Deriving/Ord.hs b/src/Data/Singletons/Deriving/Ord.hs --- a/src/Data/Singletons/Deriving/Ord.hs +++ b/src/Data/Singletons/Deriving/Ord.hs @@ -21,9 +21,9 @@ 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 +mkOrdInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl +mkOrdInstance mb_ctxt ty cons = do + constraints <- inferConstraintsDef mb_ctxt (DConPr ordName) ty cons compare_eq_clauses <- mapM mk_equal_clause cons let compare_noneq_clauses = map (uncurry mk_nonequal_clause) [ (con1, con2) @@ -31,12 +31,12 @@ , con2 <- zip cons [1..] , extractName (fst con1) /= extractName (fst con2) ] + clauses | null cons = [mk_empty_clause] + | otherwise = compare_eq_clauses ++ compare_noneq_clauses return (InstDecl { id_cxt = constraints , id_name = ordName , id_arg_tys = [ty] - , id_meths = [( compareName - , UFunction (compare_eq_clauses ++ - compare_noneq_clauses) )] }) + , id_meths = [(compareName, UFunction clauses)] }) mk_equal_clause :: Quasi q => DCon -> q DClause mk_equal_clause (DCon _tvbs _cxt name fields _rty) = do @@ -63,3 +63,7 @@ where pat1 = DConPa name1 (map (const DWildPa) (tysOfConFields fields1)) pat2 = DConPa name2 (map (const DWildPa) (tysOfConFields fields2)) + +-- A variant of mk_equal_clause tailored to empty datatypes +mk_empty_clause :: DClause +mk_empty_clause = DClause [DWildPa, DWildPa] (DConE cmpEQName) diff --git a/src/Data/Singletons/Deriving/Show.hs b/src/Data/Singletons/Deriving/Show.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Deriving/Show.hs @@ -0,0 +1,205 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Deriving.Show +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Implements deriving of Show instances +-- +---------------------------------------------------------------------------- +{-# LANGUAGE ScopedTypeVariables #-} +module Data.Singletons.Deriving.Show ( + mkShowInstance + , ShowMode(..) + , mkShowContext + ) where + +import Language.Haskell.TH.Syntax hiding (showName) +import Language.Haskell.TH.Desugar +import Data.Singletons.Names +import Data.Singletons.Util +import Data.Singletons.Syntax +import Data.Singletons.Deriving.Infer +import Data.Maybe (fromMaybe) +import GHC.Lexeme (startsConSym, startsVarSym) +import GHC.Show (appPrec, appPrec1) + +mkShowInstance :: DsMonad q + => ShowMode -> Maybe DCxt -> DType -> [DCon] + -> q UInstDecl +mkShowInstance mode mb_ctxt ty cons = do + clauses <- mk_showsPrec mode cons + constraints <- inferConstraintsDef (fmap (mkShowContext mode) mb_ctxt) + (DConPr (mk_Show_name mode)) + ty cons + return $ InstDecl { id_cxt = constraints + , id_name = mk_Show_name mode + , id_arg_tys = [ty] + , id_meths = [ (mk_showsPrec_name mode, UFunction clauses) ] } + +mk_showsPrec :: DsMonad q => ShowMode -> [DCon] -> q [DClause] +mk_showsPrec mode cons = do + p <- newUniqueName "p" -- The precedence argument (not always used) + if null cons + then do v <- newUniqueName "v" + pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] + else mapM (mk_showsPrec_clause mode p) cons + +mk_showsPrec_clause :: forall q. DsMonad q + => ShowMode -> Name -> DCon + -> q DClause +mk_showsPrec_clause mode p (DCon _ _ con_name con_fields _) = go con_fields + where + con_name' :: Name + con_name' = case mode of + ForPromotion -> con_name + ForShowSing -> singDataConName con_name + + go :: DConFields -> q DClause + + -- No fields: print just the constructor name, with no parentheses + go (DNormalC _ []) = return $ + DClause [DWildPa, DConPa con_name' []] $ + DVarE showStringName `DAppE` dStringE (parenInfixConName con_name' "") + + -- Infix constructors have special Show treatment. + go (DNormalC True tys@[_, _]) + -- Although the (:) constructor is infix, its singled counterpart SCons + -- is not, which matters if we're deriving a ShowSing instance. + -- Unless we remove this special case (see #234), we will simply + -- shunt it along as if we were dealing with a prefix constructor. + | ForShowSing <- mode + , con_name == consName + = go (DNormalC False tys) + + | otherwise + = do argL <- newUniqueName "argL" + argR <- newUniqueName "argR" + fi <- fromMaybe defaultFixity <$> reifyFixityWithLocals con_name' + let con_prec = case fi of Fixity prec _ -> prec + op_name = nameBase con_name' + infixOpE = DAppE (DVarE showStringName) . dStringE $ + if isInfixDataCon op_name + then " " ++ op_name ++ " " + -- Make sure to handle infix data constructors + -- like (Int `Foo` Int) + else " `" ++ op_name ++ "` " + return $ DClause [DVarPa p, DConPa con_name' [DVarPa argL, DVarPa argR]] $ + (DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p + `DAppE` dIntegerE con_prec)) + `DAppE` (DVarE composeName + `DAppE` showsPrecE mode (con_prec + 1) argL + `DAppE` (DVarE composeName + `DAppE` infixOpE + `DAppE` showsPrecE mode (con_prec + 1) argR)) + + go (DNormalC _ tys) = do + args <- mapM (const $ newUniqueName "arg") tys + let show_args = map (showsPrecE mode appPrec1) args + composed_args = foldr1 (\v q -> DVarE composeName + `DAppE` v + `DAppE` (DVarE composeName + `DAppE` DVarE showSpaceName + `DAppE` q)) show_args + named_args = DVarE composeName + `DAppE` (DVarE showStringName + `DAppE` dStringE (parenInfixConName con_name' " ")) + `DAppE` composed_args + return $ DClause [DVarPa p, DConPa con_name' $ map DVarPa args] $ + DVarE showParenName + `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec) + `DAppE` named_args + + -- We show a record constructor with no fields the same way we'd show a + -- normal constructor with no fields. + go (DRecC []) = go (DNormalC False []) + + go (DRecC tys) = do + args <- mapM (const $ newUniqueName "arg") tys + let show_args = + concatMap (\((arg_name, _, _), arg) -> + let arg_name' = case mode of + ForPromotion -> arg_name + ForShowSing -> singValName arg_name + arg_nameBase = nameBase arg_name' + infix_rec = showParen (isSym arg_nameBase) + (showString arg_nameBase) "" + in [ DVarE showStringName `DAppE` dStringE (infix_rec ++ " = ") + , showsPrecE mode 0 arg + , DVarE showCommaSpaceName + ]) + (zip tys args) + brace_comma_args = (DVarE showCharName `DAppE` dCharE mode '{') + : take (length show_args - 1) show_args + composed_args = foldr (\x y -> DVarE composeName `DAppE` x `DAppE` y) + (DVarE showCharName `DAppE` dCharE mode '}') + brace_comma_args + named_args = DVarE composeName + `DAppE` (DVarE showStringName + `DAppE` dStringE (parenInfixConName con_name' " ")) + `DAppE` composed_args + return $ DClause [DVarPa p, DConPa con_name' $ map DVarPa args] $ + DVarE showParenName + `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec) + `DAppE` named_args + +-- | Parenthesize an infix constructor name if it is being applied as a prefix +-- function (e.g., data Amp a = (:&) a a) +parenInfixConName :: Name -> ShowS +parenInfixConName conName = + let conNameBase = nameBase conName + in showParen (isInfixDataCon conNameBase) $ showString conNameBase + +showsPrecE :: ShowMode -> Int -> Name -> DExp +showsPrecE mode prec n = DVarE (mk_showsPrec_name mode) `DAppE` dIntegerE prec `DAppE` DVarE n + +dCharE :: ShowMode -> Char -> DExp +dCharE mode = DLitE . to_lit + where + to_lit :: Char -> Lit + to_lit c = case mode of + ForPromotion -> StringL [c] -- There aren't type-level characters yet, + -- so fake it with a string + ForShowSing -> CharL c + +dStringE :: String -> DExp +dStringE = DLitE . StringL + +dIntegerE :: Int -> DExp +dIntegerE = DLitE . IntegerL . fromIntegral + +isSym :: String -> Bool +isSym "" = False +isSym (c : _) = startsVarSym c || startsConSym c + +----- +-- ShowMode +----- + +-- | Is a 'Show' instance being generated to be promoted/singled, or is it +-- being generated to create a @ShowSing@/'Show' instance for a singleton type? +data ShowMode = ForPromotion -- ^ For promotion/singling + | ForShowSing -- ^ For a @ShowSing@/'Show' instance + +-- | Turn a context like @('Show' a, 'Show' b)@ into @('ShowSing' a, 'ShowSing' b)@. +-- This is necessary for standalone-derived instances. +mkShowContext :: ShowMode -> DCxt -> DCxt +mkShowContext ForPromotion = id +mkShowContext ForShowSing = map show_to_SingShow + where + show_to_SingShow :: DPred -> DPred + show_to_SingShow = modifyConNameDPred $ \n -> + if n == showName + then showSingName + else n + +mk_Show_name :: ShowMode -> Name +mk_Show_name ForPromotion = showName +mk_Show_name ForShowSing = showSingName + +mk_showsPrec_name :: ShowMode -> Name +mk_showsPrec_name ForPromotion = showsPrecName +mk_showsPrec_name ForShowSing = showsSingPrecName diff --git a/src/Data/Singletons/Internal.hs b/src/Data/Singletons/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Internal.hs @@ -0,0 +1,409 @@ +{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds, + FlexibleContexts, FlexibleInstances, + TypeFamilies, TypeOperators, TypeFamilyDependencies, + UndecidableInstances, TypeInType, ConstraintKinds, + ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes, + PatternSynonyms, ViewPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Internal +-- Copyright : (C) 2013 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- This module exports the basic definitions to use singletons. This module +-- exists since we need to define instances for 'SomeSing' in +-- "Data.Singletons", as defining them elsewhere would almost inevitably lead +-- to import cycles. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Internal ( + module Data.Singletons.Internal + , Proxy(..) + ) where + +import Data.Kind +import Unsafe.Coerce +import Data.Proxy ( Proxy(..) ) +import GHC.Exts ( Proxy#, Constraint ) + +-- | Convenient synonym to refer to the kind of a type variable: +-- @type KindOf (a :: k) = k@ +type KindOf (a :: k) = k + +-- | Force GHC to unify the kinds of @a@ and @b@. Note that @SameKind a b@ is +-- different from @KindOf a ~ KindOf b@ in that the former makes the kinds +-- unify immediately, whereas the latter is a proposition that GHC considers +-- as possibly false. +type SameKind (a :: k) (b :: k) = (() :: Constraint) + +---------------------------------------------------------------------- +---- Sing & friends -------------------------------------------------- +---------------------------------------------------------------------- + +-- | The singleton kind-indexed data family. +data family Sing (a :: k) + +-- | A 'SingI' constraint is essentially an implicitly-passed singleton. +-- If you need to satisfy this constraint with an explicit singleton, please +-- see 'withSingI' or the 'Sing' pattern synonym. +class SingI (a :: k) where + -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ + -- extension to use this method the way you want. + sing :: Sing a + +-- | An explicitly bidirectional pattern synonym for implicit singletons. +-- +-- As an __expression__: Constructs a singleton @Sing a@ given a +-- implicit singleton constraint @SingI a@. +-- +-- As a __pattern__: Matches on an explicit @Sing a@ witness bringing +-- an implicit @SingI a@ constraint into scope. +pattern Sing :: forall (a :: k). () => SingI a => Sing a +pattern Sing <- (singInstance -> SingInstance) + where Sing = sing + +-- | The 'SingKind' class is a /kind/ class. It classifies all kinds +-- for which singletons are defined. The class supports converting between a singleton +-- type and the base (unrefined) type which it is built from. +-- +-- For a 'SingKind' instance to be well behaved, it should obey the following laws: +-- +-- @ +-- 'toSing' . 'fromSing' ≡ 'SomeSing' +-- (\\x -> 'withSomeSing' x 'fromSing') ≡ 'id' +-- @ +-- +-- The final law can also be expressed in terms of the 'FromSing' pattern +-- synonym: +-- +-- @ +-- (\\('FromSing' sing) -> 'FromSing' sing) ≡ 'id' +-- @ +class SingKind k where + -- | Get a base type from the promoted kind. For example, + -- @Demote Bool@ will be the type @Bool@. Rarely, the type and kind do not + -- match. For example, @Demote Nat@ is @Natural@. + type Demote k = (r :: *) | r -> k + + -- | Convert a singleton to its unrefined version. + fromSing :: Sing (a :: k) -> Demote k + + -- | Convert an unrefined type to an existentially-quantified singleton type. + toSing :: Demote k -> SomeSing k + +-- | An /existentially-quantified/ singleton. This type is useful when you want a +-- singleton type, but there is no way of knowing, at compile-time, what the type +-- index will be. To make use of this type, you will generally have to use a +-- pattern-match: +-- +-- > foo :: Bool -> ... +-- > foo b = case toSing b of +-- > SomeSing sb -> {- fancy dependently-typed code with sb -} +-- +-- An example like the one above may be easier to write using 'withSomeSing'. +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k + +-- | An explicitly bidirectional pattern synonym for going between a +-- singleton and the corresponding demoted term. +-- +-- As an __expression__: this takes a singleton to its demoted (base) +-- type. +-- +-- >>> :t FromSing \@Bool +-- FromSing \@Bool :: Sing a -> Bool +-- >>> FromSing SFalse +-- False +-- +-- As a __pattern__: It extracts a singleton from its demoted (base) +-- type. +-- +-- @ +-- singAnd :: 'Bool' -> 'Bool' -> 'SomeSing' 'Bool' +-- singAnd ('FromSing' singBool1) ('FromSing' singBool2) = +-- 'SomeSing' (singBool1 %&& singBool2) +-- @ +-- +-- instead of writing it with 'withSomeSing': +-- +-- @ +-- singAnd bool1 bool2 = +-- 'withSomeSing' bool1 $ \singBool1 -> +-- 'withSomeSing' bool2 $ \singBool2 -> +-- 'SomeSing' (singBool1 %&& singBool2) +-- @ +pattern FromSing :: SingKind k => forall (a :: k). Sing a -> Demote k +pattern FromSing sng <- ((\demotedVal -> withSomeSing demotedVal SomeSing) -> SomeSing sng) + where FromSing sng = fromSing sng + +---------------------------------------------------------------------- +---- SingInstance ---------------------------------------------------- +---------------------------------------------------------------------- + +-- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling. +data SingInstance (a :: k) where + SingInstance :: SingI a => SingInstance a + +-- dirty implementation of explicit-to-implicit conversion +newtype DI a = Don'tInstantiate (SingI a => SingInstance a) + +-- | Get an implicit singleton (a 'SingI' instance) from an explicit one. +singInstance :: forall (a :: k). Sing a -> SingInstance a +singInstance s = with_sing_i SingInstance + where + with_sing_i :: (SingI a => SingInstance a) -> SingInstance a + with_sing_i si = unsafeCoerce (Don'tInstantiate si) s + +---------------------------------------------------------------------- +---- Defunctionalization --------------------------------------------- +---------------------------------------------------------------------- + +-- | Representation of the kind of a type-level function. The difference +-- between term-level arrows and this type-level arrow is that at the term +-- level applications can be unsaturated, whereas at the type level all +-- applications have to be fully saturated. +data TyFun :: * -> * -> * + +-- | Something of kind `a ~> b` is a defunctionalized type function that is +-- not necessarily generative or injective. +type a ~> b = TyFun a b -> * +infixr 0 ~> + +-- | Type level function application +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 + +-- | An infix synonym for `Apply` +type a @@ b = Apply a b +infixl 9 @@ + +-- | 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 (TyCon Succ) [Zero, Succ Zero] +data family TyCon :: (k1 -> k2) -> unmatchable_fun +-- That unmatchable_fun should really be a function of k1 and k2, +-- but GHC 8.4 doesn't support type family calls in the result kind +-- of a data family. It should. See GHC#14645. + +-- The result kind of this is also a bit wrong; it should line +-- up with unmatchable_fun above. However, we can't do that +-- because GHC is too stupid to remember that f's kind can't +-- have more than one argument when kind-checking the RHS of +-- the second equation. Note that this infelicity is independent +-- of the problem in the kind of TyCon. There is no GHC ticket +-- here because dealing with inequality like this is hard, and +-- I (Richard) wasn't sure what concrete value the ticket would +-- have, given that we don't know how to begin fixing it. +type family ApplyTyCon (f :: k1 -> k2) (x :: k1) :: k3 where + ApplyTyCon (f :: k1 -> k2 -> k3) x = TyCon (f x) + ApplyTyCon f x = f x + +type instance Apply (TyCon f) x = ApplyTyCon f x + +---------------------------------------------------------------------- +---- Defunctionalized Sing instance and utilities -------------------- +---------------------------------------------------------------------- + +newtype instance Sing (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } + +-- | An infix synonym for `applySing` +(@@) :: forall (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t) +(@@) = applySing + +-- | Note that this instance's 'toSing' implementation crucially relies on the fact +-- that the 'SingKind' instances for 'k1' and 'k2' both satisfy the 'SingKind' laws. +-- If they don't, 'toSing' might produce strange results! +instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where + type Demote (k1 ~> k2) = Demote k1 -> Demote k2 + fromSing sFun x = withSomeSing x (fromSing . applySing sFun) + toSing f = SomeSing slam + where + -- Here, we are essentially "manufacturing" a type-level version of the + -- function f. As long as k1 and k2 obey the SingKind laws, this is a + -- perfectly fine thing to do, since the computational content of Sing f + -- will be isomorphic to that of the function f. + slam :: forall (f :: k1 ~> k2). Sing f + slam = singFun1 @f lam + where + -- Here's the tricky part. We need to demote the argument Sing, apply the + -- term-level function f to it, and promote it back to a Sing. However, + -- we don't have a way to convince the typechecker that for all argument + -- types t, f @@ t should be the same thing as res, which motivates the + -- use of unsafeCoerce. + lam :: forall (t :: k1). Sing t -> Sing (f @@ t) + lam x = withSomeSing (f (fromSing x)) (\(r :: Sing res) -> unsafeCoerce r) + +type SingFunction1 f = forall t. Sing t -> Sing (f @@ t) + +-- | Use this function when passing a function on singletons as +-- a higher-order function. You will need visible type application +-- to get this to work. For example: +-- +-- > falses = sMap (singFun1 @NotSym0 sNot) +-- > (STrue `SCons` STrue `SCons` SNil) +-- +-- There are a family of @singFun...@ functions, keyed by the number +-- of parameters of the function. +singFun1 :: forall f. SingFunction1 f -> Sing f +singFun1 f = SLambda f + +type SingFunction2 f = forall t. Sing t -> SingFunction1 (f @@ t) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> singFun1 (f x)) + +type SingFunction3 f = forall t. Sing t -> SingFunction2 (f @@ t) +singFun3 :: forall f. SingFunction3 f -> Sing f +singFun3 f = SLambda (\x -> singFun2 (f x)) + +type SingFunction4 f = forall t. Sing t -> SingFunction3 (f @@ t) +singFun4 :: forall f. SingFunction4 f -> Sing f +singFun4 f = SLambda (\x -> singFun3 (f x)) + +type SingFunction5 f = forall t. Sing t -> SingFunction4 (f @@ t) +singFun5 :: forall f. SingFunction5 f -> Sing f +singFun5 f = SLambda (\x -> singFun4 (f x)) + +type SingFunction6 f = forall t. Sing t -> SingFunction5 (f @@ t) +singFun6 :: forall f. SingFunction6 f -> Sing f +singFun6 f = SLambda (\x -> singFun5 (f x)) + +type SingFunction7 f = forall t. Sing t -> SingFunction6 (f @@ t) +singFun7 :: forall f. SingFunction7 f -> Sing f +singFun7 f = SLambda (\x -> singFun6 (f x)) + +type SingFunction8 f = forall t. Sing t -> SingFunction7 (f @@ t) +singFun8 :: forall f. SingFunction8 f -> Sing f +singFun8 f = SLambda (\x -> singFun7 (f x)) + +-- | This is the inverse of 'singFun1', and likewise for the other +-- @unSingFun...@ functions. +unSingFun1 :: forall f. Sing f -> SingFunction1 f +unSingFun1 sf = applySing sf + +unSingFun2 :: forall f. Sing f -> SingFunction2 f +unSingFun2 sf x = unSingFun1 (sf @@ x) + +unSingFun3 :: forall f. Sing f -> SingFunction3 f +unSingFun3 sf x = unSingFun2 (sf @@ x) + +unSingFun4 :: forall f. Sing f -> SingFunction4 f +unSingFun4 sf x = unSingFun3 (sf @@ x) + +unSingFun5 :: forall f. Sing f -> SingFunction5 f +unSingFun5 sf x = unSingFun4 (sf @@ x) + +unSingFun6 :: forall f. Sing f -> SingFunction6 f +unSingFun6 sf x = unSingFun5 (sf @@ x) + +unSingFun7 :: forall f. Sing f -> SingFunction7 f +unSingFun7 sf x = unSingFun6 (sf @@ x) + +unSingFun8 :: forall f. Sing f -> SingFunction8 f +unSingFun8 sf x = unSingFun7 (sf @@ x) + +{-# COMPLETE SLambda2 #-} +pattern SLambda2 :: forall f. SingFunction2 f -> Sing f +pattern SLambda2 {applySing2} <- (unSingFun2 -> applySing2) + where SLambda2 lam2 = singFun2 lam2 + +{-# COMPLETE SLambda3 #-} +pattern SLambda3 :: forall f. SingFunction3 f -> Sing f +pattern SLambda3 {applySing3} <- (unSingFun3 -> applySing3) + where SLambda3 lam3 = singFun3 lam3 + +{-# COMPLETE SLambda4 #-} +pattern SLambda4 :: forall f. SingFunction4 f -> Sing f +pattern SLambda4 {applySing4} <- (unSingFun4 -> applySing4) + where SLambda4 lam4 = singFun4 lam4 + +{-# COMPLETE SLambda5 #-} +pattern SLambda5 :: forall f. SingFunction5 f -> Sing f +pattern SLambda5 {applySing5} <- (unSingFun5 -> applySing5) + where SLambda5 lam5 = singFun5 lam5 + +{-# COMPLETE SLambda6 #-} +pattern SLambda6 :: forall f. SingFunction6 f -> Sing f +pattern SLambda6 {applySing6} <- (unSingFun6 -> applySing6) + where SLambda6 lam6 = singFun6 lam6 + +{-# COMPLETE SLambda7 #-} +pattern SLambda7 :: forall f. SingFunction7 f -> Sing f +pattern SLambda7 {applySing7} <- (unSingFun7 -> applySing7) + where SLambda7 lam7 = singFun7 lam7 + +{-# COMPLETE SLambda8 #-} +pattern SLambda8 :: forall f. SingFunction8 f -> Sing f +pattern SLambda8 {applySing8} <- (unSingFun8 -> applySing8) + where SLambda8 lam8 = singFun8 lam8 + +---------------------------------------------------------------------- +---- Convenience ----------------------------------------------------- +---------------------------------------------------------------------- + +-- | Convenience function for creating a context with an implicit singleton +-- available. +withSingI :: Sing n -> (SingI n => r) -> r +withSingI sn r = + case singInstance sn of + SingInstance -> r + +-- | Convert a normal datatype (like 'Bool') to a singleton for that datatype, +-- passing it into a continuation. +withSomeSing :: forall k r + . SingKind k + => Demote k -- ^ The original datatype + -> (forall (a :: k). Sing a -> r) -- ^ Function expecting a singleton + -> r +withSomeSing x f = + case toSing x of + SomeSing x' -> f x' + +-- | A convenience function useful when we need to name a singleton value +-- multiple times. Without this function, each use of 'sing' could potentially +-- refer to a different singleton, and one has to use type signatures (often +-- with @ScopedTypeVariables@) to ensure that they are the same. +withSing :: SingI a => (Sing a -> b) -> b +withSing f = f sing + +-- | A convenience function that names a singleton satisfying a certain +-- property. If the singleton does not satisfy the property, then the function +-- returns 'Nothing'. The property is expressed in terms of the underlying +-- representation of the singleton. +singThat :: forall (a :: k). (SingKind k, SingI a) + => (Demote k -> Bool) -> Maybe (Sing a) +singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing + +-- | Allows creation of a singleton when a proxy is at hand. +singByProxy :: SingI a => proxy a -> Sing a +singByProxy _ = sing + +-- | Allows creation of a singleton when a @proxy#@ is at hand. +singByProxy# :: SingI a => Proxy# a -> Sing a +singByProxy# _ = sing + +-- | A convenience function that takes a type as input and demotes it to its +-- value-level counterpart as output. This uses 'SingKind' and 'SingI' behind +-- the scenes, so @'demote' = 'fromSing' 'sing'@. +-- +-- This function is intended to be used with @TypeApplications@. For example: +-- +-- >>> demote @True +-- True +-- +-- >>> demote @(Nothing :: Maybe Ordering) +-- Nothing +demote :: forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a) +demote = fromSing (sing @(KindOf a) @a) diff --git a/src/Data/Singletons/Names.hs b/src/Data/Singletons/Names.hs --- a/src/Data/Singletons/Names.hs +++ b/src/Data/Singletons/Names.hs @@ -10,24 +10,25 @@ module Data.Singletons.Names where -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.Decide import Language.Haskell.TH.Syntax import Language.Haskell.TH.Desugar import GHC.TypeLits ( Nat, Symbol ) -import GHC.Exts ( Any, Constraint ) +import GHC.Exts ( Constraint ) +import GHC.Show ( showCommaSpace, showSpace ) import Data.Typeable ( TypeRep ) import Data.Singletons.Util import Control.Monad -anyTypeName, boolName, andName, tyEqName, compareName, minBoundName, +boolName, andName, tyEqName, compareName, minBoundName, maxBoundName, repName, nilName, consName, listName, tyFunName, - applyName, natName, symbolName, undefinedName, typeRepName, stringName, + applyName, natName, symbolName, typeRepName, stringName, eqName, ordName, boundedName, orderingName, singFamilyName, singIName, singMethName, demoteName, - singKindClassName, sEqClassName, sEqMethName, sconsName, snilName, + singKindClassName, sEqClassName, sEqMethName, sconsName, snilName, strueName, sIfName, someSingTypeName, someSingDataName, sListName, sDecideClassName, sDecideMethName, @@ -37,14 +38,16 @@ sameKindName, tyFromIntegerName, tyNegateName, sFromIntegerName, sNegateName, errorName, foldlName, cmpEQName, cmpLTName, cmpGTName, singletonsToEnumName, singletonsFromEnumName, enumName, singletonsEnumName, - equalsName, constraintName :: Name -anyTypeName = ''Any + equalsName, constraintName, + showName, showCharName, showCommaSpaceName, showParenName, showsPrecName, + showSpaceName, showStringName, showSingName, showsSingPrecName, + composeName, gtName, tyFromStringName, sFromStringName :: Name boolName = ''Bool andName = '(&&) compareName = 'compare minBoundName = 'minBound maxBoundName = 'maxBound -tyEqName = mk_name_tc "Data.Singletons.Prelude.Eq" ":==" +tyEqName = mk_name_tc "Data.Singletons.Prelude.Eq" "==" repName = mkName "Rep" -- this is actually defined in client code! nilName = '[] consName = '(:) @@ -53,7 +56,6 @@ applyName = ''Apply symbolName = ''Symbol natName = ''Nat -undefinedName = 'undefined typeRepName = ''TypeRep stringName = ''String eqName = ''Eq @@ -68,10 +70,11 @@ demoteName = ''Demote singKindClassName = ''SingKind sEqClassName = mk_name_tc "Data.Singletons.Prelude.Eq" "SEq" -sEqMethName = mk_name_v "Data.Singletons.Prelude.Eq" "%:==" +sEqMethName = mk_name_v "Data.Singletons.Prelude.Eq" "%==" sIfName = mk_name_v "Data.Singletons.Prelude.Bool" "sIf" sconsName = mk_name_d "Data.Singletons.Prelude.Instances" "SCons" snilName = mk_name_d "Data.Singletons.Prelude.Instances" "SNil" +strueName = mk_name_d "Data.Singletons.Prelude.Instances" "STrue" someSingTypeName = ''SomeSing someSingDataName = 'SomeSing sListName = mk_name_tc "Data.Singletons.Prelude.Instances" "SList" @@ -101,6 +104,19 @@ singletonsEnumName = mk_name_tc "Data.Singletons.Prelude.Enum" "Enum" equalsName = '(==) constraintName = ''Constraint +showName = ''Show +showCharName = 'showChar +showParenName = 'showParen +showSpaceName = 'showSpace +showsPrecName = 'showsPrec +showStringName = 'showString +showSingName = mk_name_tc "Data.Singletons.ShowSing" "ShowSing" +showsSingPrecName = mk_name_v "Data.Singletons.ShowSing" "showsSingPrec" +composeName = '(.) +gtName = '(>) +showCommaSpaceName = 'showCommaSpace +tyFromStringName = mk_name_tc "Data.Singletons.Prelude.IsString" "FromString" +sFromStringName = mk_name_v "Data.Singletons.Prelude.IsString" "sFromString" singPkg :: String singPkg = $( (LitE . StringL . loc_package) `liftM` location ) @@ -125,12 +141,26 @@ -- used when a value name appears in a pattern context -- works only for proper variables (lower-case names) promoteValNameLhs :: Name -> Name -promoteValNameLhs = upcase +promoteValNameLhs = promoteValNameLhsPrefix noPrefix -- like promoteValNameLhs, but adds a prefix to the promoted name promoteValNameLhsPrefix :: (String, String) -> Name -> Name -promoteValNameLhsPrefix pres n = mkName $ toUpcaseStr pres n +promoteValNameLhsPrefix pres@(alpha, symb) n + | nameBase n == "." + = mkName $ symb ++ ":." + | nameBase n == "!" + = mkName $ symb ++ ":!" + -- See Note [Special cases for (.) and (!)] + -- We can't promote promote idenitifers beginning with underscores to + -- type names, so we work around the issue by prepending "US" at the + -- front of the name (#229). + | Just (us, rest) <- splitUnderscores (nameBase n) + = mkName $ alpha ++ "US" ++ us ++ rest + + | otherwise + = mkName $ toUpcaseStr pres n + -- used when a value name appears in an expression context -- works for both variables and datacons promoteValRhs :: Name -> DType @@ -147,8 +177,14 @@ -- names. promoteTySym :: Name -> Int -> Name promoteTySym name sat - | name == undefinedName - = anyTypeName + | nameBase name == ":." + = default_case (mkName ".") + | nameBase name == ":!" + = default_case (mkName "!") + -- Although (:.) and (:!) are special cases, we need not have a colon in + -- front of their defunctionalization symbols, since only the names + -- (.) and (!) are problematic for the parser. + -- See Note [Special cases for (.) and (!)] | name == nilName = mkName $ "NilSym" ++ (show sat) @@ -160,13 +196,18 @@ "Tuple" ++ show degree ++ "Sym" ++ (show sat) | otherwise - = let capped = toUpcaseStr noPrefix name in + = default_case name + where + default_case :: Name -> Name + default_case name' = + let capped = toUpcaseStr noPrefix name' in if isHsLetter (head capped) then mkName (capped ++ "Sym" ++ (show sat)) - else mkName (capped ++ (replicate (sat + 1) '$')) + else mkName (capped ++ "@#@" -- See Note [Defunctionalization symbol suffixes] + ++ (replicate (sat + 1) '$')) promoteClassName :: Name -> Name -promoteClassName = prefixUCName "P" "#" +promoteClassName = prefixName "P" "#" mkTyName :: Quasi q => Name -> q Name mkTyName tmName = do @@ -194,24 +235,26 @@ | nm == consName = sconsName | Just degree <- tupleNameDegree_maybe nm = mkTupleDataName degree | Just degree <- unboxedTupleNameDegree_maybe nm = mkTupleDataName degree - | otherwise = prefixUCName "S" ":%" nm + | otherwise = prefixConName "S" "%" nm singTyConName :: Name -> Name singTyConName name | name == listName = sListName | Just degree <- tupleNameDegree_maybe name = mkTupleTypeName degree | Just degree <- unboxedTupleNameDegree_maybe name = mkTupleTypeName degree - | otherwise = prefixUCName "S" ":%" name + | otherwise = prefixName "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 + -- Push the 's' past the underscores, as this lets us avoid some unused + -- variable warnings (#229). + | Just (us, rest) <- splitUnderscores (nameBase n) + = prefixName (us ++ "s") "%" $ mkName rest + | otherwise + = prefixName "s" "%" $ upcase n singFamily :: DType singFamily = DConT singFamilyName @@ -237,3 +280,57 @@ -- make and equality predicate mkEqPred :: DType -> DType -> DPred mkEqPred ty1 ty2 = foldl DAppPr (DConPr equalityName) [ty1, ty2] + +-- | If a 'String' begins with one or more underscores, return +-- @'Just' (us, rest)@, where @us@ contain all of the underscores at the +-- beginning of the 'String' and @rest@ contains the remainder of the 'String'. +-- Otherwise, return 'Nothing'. +splitUnderscores :: String -> Maybe (String, String) +splitUnderscores s = case span (== '_') s of + ([], _) -> Nothing + res -> Just res + +-- Walk a DPred, applying a function to all occurrences of constructor names. +modifyConNameDPred :: (Name -> Name) -> DPred -> DPred +modifyConNameDPred mod_con_name = go + where + go (DAppPr p t) = DAppPr (go p) t + go (DSigPr p k) = DSigPr (go p) k + go p@(DVarPr _) = p + go (DConPr n) = DConPr (mod_con_name n) + go p@DWildCardPr = p + +{- +Note [Defunctionalization symbol suffixes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before, we used to denote defunctionalization symbols by simply appending dollar +signs at the end (e.g., (+$) and (+$$)). But this can lead to ambiguity when you +have function names that consist of solely $ characters. For instance, if you +tried to promote ($) and ($$) simultaneously, you'd get these promoted types: + +$ +$$ + +And these defunctionalization symbols: + +$$ +$$$ + +But now there's a name clash between the promoted type for ($) and the +defunctionalization symbol for ($$)! The solution is to use a precede these +defunctionalization dollar signs with another string (we choose @#@). +So now the new defunctionalization symbols would be: + +$@#@$ +$@#@$$ + +And there is no conflict. + +Note [Special cases for (.) and (!)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Almost every infix value name can be promoted trivially. For example, (+) works +both at the value- and type-level. The two exceptions to this rule are (.) and (!), +which we promote to the special type names (:.) and (:!), respectively. +This is necessary since one cannot define or apply (.) or (!) at the type level -- +they simply won't parse. Bummer. +-} diff --git a/src/Data/Singletons/Partition.hs b/src/Data/Singletons/Partition.hs --- a/src/Data/Singletons/Partition.hs +++ b/src/Data/Singletons/Partition.hs @@ -20,64 +20,56 @@ import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum +import Data.Singletons.Deriving.Show import Data.Singletons.Names -import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Syntax hiding (showName) import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar import Data.Singletons.Util -import Data.Monoid import Control.Monad +import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe +import Data.Semigroup (Semigroup(..)) data PartitionedDecs = PDecs { pd_let_decs :: [DLetDec] , pd_class_decs :: [UClassDecl] , pd_instance_decs :: [UInstDecl] , pd_data_decs :: [DataDecl] + , pd_derived_eq_decs :: [DerivedEqDecl] + , pd_derived_show_decs :: [DerivedShowDecl] } +instance Semigroup PartitionedDecs where + PDecs a1 b1 c1 d1 e1 f1 <> PDecs a2 b2 c2 d2 e2 f2 = + PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) (e1 <> e2) (f1 <> f2) + instance Monoid PartitionedDecs where - mempty = PDecs [] [] [] [] - mappend (PDecs a1 b1 c1 d1) (PDecs a2 b2 c2 d2) = - PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) + mempty = PDecs [] [] [] [] [] [] + mappend = (<>) -- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances -- from deriving clauses -partitionDecs :: Quasi m => [DDec] -> m PartitionedDecs +partitionDecs :: DsMonad m => [DDec] -> m PartitionedDecs partitionDecs = concatMapM partitionDec -partitionDec :: Quasi m => DDec -> m PartitionedDecs +partitionDec :: DsMonad m => DDec -> m PartitionedDecs partitionDec (DLetDec (DPragmaD {})) = return mempty partitionDec (DLetDec letdec) = return $ mempty { pd_let_decs = [letdec] } partitionDec (DDataD nd _cxt name tvbs cons derivings) = do - (derivings', derived_instances) <- partitionWithM part_derivings - $ concatMap flatten_clause derivings - return $ mempty { pd_data_decs = [DataDecl nd name tvbs cons derivings'] - , pd_instance_decs = derived_instances } + derived_decs + <- mapM (\(strat, deriv_pred) -> partitionDeriving strat deriv_pred Nothing ty cons) + $ concatMap flatten_clause derivings + return $ mconcat $ data_dec : derived_decs where + data_dec = mempty { pd_data_decs = [DataDecl nd name tvbs cons []] } ty = foldType (DConT name) (map tvbToType tvbs) - flatten_clause :: DDerivClause -> [(Maybe DerivStrategy, DPred)] - flatten_clause (DDerivClause strat preds) = map (strat,) preds - - part_derivings :: Quasi m => (Maybe DerivStrategy, DPred) - -> m (Either DPred UInstDecl) - part_derivings (strat, deriv) = case deriv of - DConPr deriv_name - | stock, deriv_name == ordName - -> Right <$> mkOrdInstance ty cons - | stock, deriv_name == boundedName - -> Right <$> mkBoundedInstance ty cons - | stock, deriv_name == enumName - -> Right <$> mkEnumInstance ty cons - where - stock = case strat of - Nothing -> True - Just StockStrategy -> True - Just _ -> False - _ -> return (Left deriv) + flatten_clause :: DDerivClause -> [(Maybe DerivStrategy, DType)] + flatten_clause (DDerivClause strat preds) = + map (\p -> (strat, predToType p)) preds partitionDec (DClassD cxt name tvbs fds decs) = do env <- concatMapM partitionClassDec decs @@ -102,6 +94,25 @@ partitionDec (DTySynD {}) = return mempty -- ignore type synonyms; -- promotion is a no-op, and -- singling expands all syns +partitionDec (DStandaloneDerivD mb_strat ctxt ty) = + case unfoldType ty of + cls_pred_ty :| cls_tys + | not (null cls_tys) -- We can't handle zero-parameter type classes + , let cls_arg_tys = init cls_tys + data_ty = last cls_tys + data_ty_head = case unfoldType data_ty of ty_head :| _ -> ty_head + , DConT data_tycon <- data_ty_head -- We can't handle deriving an instance for something + -- other than a type constructor application + -> do let cls_pred = foldType cls_pred_ty cls_arg_tys + dinfo <- dsReify data_tycon + case dinfo of + Just (DTyConI (DDataD _ _ _ _ cons _) _) -> do + partitionDeriving mb_strat cls_pred (Just ctxt) data_ty cons + Just _ -> + fail $ "Standalone derived instance for something other than a datatype: " + ++ show data_ty + _ -> fail $ "Cannot find " ++ show data_ty + _ -> return mempty partitionDec dec = fail $ "Declaration cannot be promoted: " ++ pprint (decToTH dec) @@ -125,3 +136,86 @@ partitionInstanceDec (DLetDec (DPragmaD {})) = return Nothing partitionInstanceDec _ = fail "Only method bodies can be promoted within an instance." + +partitionDeriving :: DsMonad m => Maybe DerivStrategy -> DType -> Maybe DCxt -> DType -> [DCon] + -> m PartitionedDecs +partitionDeriving mb_strat deriv_pred mb_ctxt ty cons = + case unfoldType deriv_pred of + DConT deriv_name :| arg_tys + -- Here, we are more conservative than GHC: DeriveAnyClass only kicks + -- in if the user explicitly chooses to do so with the anyclass + -- deriving strategy + | Just AnyclassStrategy <- mb_strat + -> return $ mk_derived_inst + InstDecl { id_cxt = fromMaybe [] mb_ctxt + -- For now at least, there's no point in attempting to + -- infer an instance context for DeriveAnyClass, since + -- the other language feature that requires it, + -- DefaultSignatures, can't be singled. Thus, inferring an + -- empty context will Just Work for all currently supported + -- default implementations. + -- + -- (Of course, if a user specifies a context with + -- StandaloneDeriving, use that.) + + , id_name = deriv_name + , id_arg_tys = arg_tys ++ [ty] + , id_meths = [] } + + | Just NewtypeStrategy <- mb_strat + -> do qReportWarning "GeneralizedNewtypeDeriving is ignored by `singletons`." + return mempty + + -- Stock classes. These are derived only if `singletons` supports them + -- (and, optionally, if an explicit stock deriving strategy is used) + DConT deriv_name :| [] -- For now, all stock derivable class supported in + -- singletons take just one argument (the data + -- type itself) + | stock_or_default + , deriv_name == ordName + -> mk_derived_inst <$> mkOrdInstance mb_ctxt ty cons + + | stock_or_default + , deriv_name == boundedName + -> mk_derived_inst <$> mkBoundedInstance mb_ctxt ty cons + + | stock_or_default + , deriv_name == enumName + -> mk_derived_inst <$> mkEnumInstance mb_ctxt ty cons + + -- See Note [DerivedDecl] in Data.Singletons.Syntax + | stock_or_default + , deriv_name == eqName + -> return $ mk_derived_eq_inst $ mk_derived_decl mb_ctxt ty cons + + -- See Note [DerivedDecl] in Data.Singletons.Syntax + | stock_or_default + , deriv_name == showName + -> do -- This will become PShow/SShow instances... + inst_for_promotion <- mkShowInstance ForPromotion mb_ctxt ty cons + -- ...and this will become ShowSing/Show instances. + let inst_for_ShowSing = mk_derived_decl mb_ctxt ty cons + pure $ mempty { pd_instance_decs = [inst_for_promotion] + , pd_derived_show_decs = [inst_for_ShowSing] } + + -- If we can't find a stock class, but the user bothered to use an + -- explicit stock keyword, we can at least warn them about it. + | Just StockStrategy <- mb_strat + -> do qReportWarning $ "`singletons` doesn't recognize the stock class " + ++ nameBase deriv_name + return mempty + + _ -> return mempty -- singletons doesn't support deriving this instance + where + mk_derived_inst dec = mempty { pd_instance_decs = [dec] } + mk_derived_eq_inst dec = mempty { pd_derived_eq_decs = [dec] } + mk_derived_decl mb_ctxt' ty' cons' = DerivedDecl { ded_mb_cxt = mb_ctxt' + , ded_type = ty' + , ded_cons = cons' } + stock_or_default = isStockOrDefault mb_strat + +-- Is this being used with an explicit stock strategy, or no strategy at all? +isStockOrDefault :: Maybe DerivStrategy -> Bool +isStockOrDefault Nothing = True +isStockOrDefault (Just StockStrategy) = True +isStockOrDefault (Just _) = False diff --git a/src/Data/Singletons/Prelude.hs b/src/Data/Singletons/Prelude.hs --- a/src/Data/Singletons/Prelude.hs +++ b/src/Data/Singletons/Prelude.hs @@ -33,10 +33,11 @@ STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, -- * Functions working with 'Bool' - If, sIf, Not, sNot, (:&&), (:||), (%:&&), (%:||), Otherwise, sOtherwise, + If, sIf, Not, sNot, type (&&), type (||), (%&&), (%||), Otherwise, sOtherwise, -- * Error reporting - Error, ErrorSym0, sError, + Error, sError, + Undefined, sUndefined, -- * Singleton equality module Data.Singletons.Prelude.Eq, @@ -53,27 +54,39 @@ -- * Singletons numbers module Data.Singletons.Prelude.Num, + type (^), (%^), + -- * Singleton 'Show' + PShow(..), SShow(..), ShowS, SChar, type (<>), (%<>), + Shows, sShows, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen, + -- ** Miscellaneous functions - Id, sId, Const, sConst, (:.), (%:.), type ($), (%$), type ($!), (%$!), + Id, sId, Const, sConst, (:.), (%.), type ($), (%$), type ($!), (%$!), Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * List operations - Map, sMap, (:++), (%:++), Head, sHead, Last, sLast, Tail, sTail, + Map, sMap, type (++), (%++), Head, sHead, Last, sLast, Tail, sTail, Init, sInit, Null, sNull, Reverse, sReverse, -- ** Reducing lists (folds) Foldl, sFoldl, Foldl1, sFoldl1, Foldr, sFoldr, Foldr1, sFoldr1, -- *** Special folds - And, sAnd, Or, sOr, Any_, sAny_, All, sAll, + And, sAnd, Or, sOr, Any, sAny, All, sAll, Concat, sConcat, ConcatMap, sConcatMap, -- *** Scans Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1, + -- *** Infinite lists + Replicate, sReplicate, + -- ** Sublists + Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, + Span, sSpan, Break, sBreak, -- ** Searching lists Elem, sElem, NotElem, sNotElem, Lookup, sLookup, -- ** Zipping and unzipping lists Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3, Unzip, sUnzip, Unzip3, sUnzip3, + -- ** Functions on 'Symbol's + Unlines, sUnlines, Unwords, sUnwords, -- * Other datatypes Maybe_, sMaybe_, @@ -85,11 +98,13 @@ either_, -- reimplementation of either to be used with singletons library maybe_, bool_, - any_, + show_, -- * Defunctionalization symbols FalseSym0, TrueSym0, - NotSym0, NotSym1, (:&&$), (:&&$$), (:&&$$$), (:||$), (:||$$), (:||$$$), + NotSym0, NotSym1, + type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), + type (||@#@$), type (||@#@$$), type (||@#@$$$), OtherwiseSym0, NothingSym0, JustSym0, JustSym1, @@ -109,16 +124,29 @@ CurrySym0, CurrySym1, CurrySym2, CurrySym3, UncurrySym0, UncurrySym1, UncurrySym2, + ErrorSym0, ErrorSym1, UndefinedSym0, + + type (^@#@$), type (^@#@$$), type (^@#@$$$), + + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + Show_Sym0, Show_Sym1, + ShowListSym0, ShowListSym1, ShowListSym2, + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + ShowsSym0, ShowsSym1, ShowsSym2, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - (:.$), (:.$$), (:.$$$), - type ($$), type ($$$), type ($$$$), - type ($!$), type ($!$$), type ($!$$$), + type (.@#@$), type (.@#@$$), type (.@#@$$$), + type ($@#@$), type ($@#@$$), type ($@#@$$$), + type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), FlipSym0, FlipSym1, FlipSym2, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2, - (:$), (:$$), (:$$$), NilSym0, + (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, - (:++$$), (:++$), HeadSym0, HeadSym1, LastSym0, LastSym1, + type (++@#@$$), type (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, @@ -129,7 +157,7 @@ ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, - Any_Sym0, Any_Sym1, Any_Sym2, + AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, @@ -137,6 +165,17 @@ ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, + ReplicateSym0, ReplicateSym1, ReplicateSym2, + + TakeSym0, TakeSym1, TakeSym2, + DropSym0, DropSym1, DropSym2, + SplitAtSym0, SplitAtSym1, SplitAtSym2, + TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, + DropWhileSym0, DropWhileSym1, DropWhileSym2, + DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, + SpanSym0, SpanSym1, SpanSym2, + BreakSym0, BreakSym1, BreakSym2, + ElemSym0, ElemSym1, ElemSym2, NotElemSym0, NotElemSym1, NotElemSym2, @@ -144,7 +183,9 @@ Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, - UnzipSym0, UnzipSym1 + UnzipSym0, UnzipSym1, + + UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1 ) where import Data.Singletons @@ -160,4 +201,5 @@ import Data.Singletons.Prelude.Enum hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred) import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Show import Data.Singletons.TypeLits diff --git a/src/Data/Singletons/Prelude/Base.hs b/src/Data/Singletons/Prelude/Base.hs --- a/src/Data/Singletons/Prelude/Base.hs +++ b/src/Data/Singletons/Prelude/Base.hs @@ -23,21 +23,21 @@ module Data.Singletons.Prelude.Base ( -- * Basic functions - Foldr, sFoldr, Map, sMap, (:++), (%:++), Otherwise, sOtherwise, - Id, sId, Const, sConst, (:.), (%:.), type ($), type ($!), (%$), (%$!), + Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise, + Id, sId, Const, sConst, (:.), (%.), type ($), type ($!), (%$), (%$!), Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * Defunctionalization symbols FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, MapSym0, MapSym1, MapSym2, - (:++$), (:++$$), (:++$$$), + type (++@#@$), type (++@#@$$), type (++@#@$$$), OtherwiseSym0, IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - (:.$), (:.$$), (:.$$$), (:.$$$$), - type ($$), type ($$$), type ($$$$), - type ($!$), type ($!$$), type ($!$$$), + type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), + type ($@#@$), type ($@#@$$), type ($@#@$$$), + type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), FlipSym0, FlipSym1, FlipSym2, FlipSym3, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2 @@ -45,7 +45,6 @@ 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 @@ -84,45 +83,17 @@ asTypeOf :: a -> a -> a asTypeOf = const + ($) :: (a -> b) -> a -> b + f $ x = f x + infixr 0 $ + + ($!) :: (a -> b) -> a -> b + f $! x = let {-!-}vx = x in f vx + infixr 0 $! + -- This is not part of GHC.Base, but we need to emulate seq and this is a good -- place to do it. seq :: a -> b -> b seq _ x = x infixr 0 `seq` |]) - --- ($) 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 %$! diff --git a/src/Data/Singletons/Prelude/Bool.hs b/src/Data/Singletons/Prelude/Bool.hs --- a/src/Data/Singletons/Prelude/Bool.hs +++ b/src/Data/Singletons/Prelude/Bool.hs @@ -38,7 +38,7 @@ If, sIf, -- * Singletons from @Data.Bool@ - Not, sNot, (:&&), (:||), (%:&&), (%:||), + Not, sNot, type (&&), type (||), (%&&), (%||), -- | The following are derived from the function 'bool' in @Data.Bool@. The extra -- underscore is to avoid name clashes with the type 'Bool'. @@ -48,16 +48,17 @@ TrueSym0, FalseSym0, NotSym0, NotSym1, - (:&&$), (:&&$$), (:&&$$$), - (:||$), (:||$$), (:||$$$), + type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), + type (||@#@$), type (||@#@$$), type (||@#@$$$), Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3, OtherwiseSym0 ) where -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.Prelude.Instances +import Data.Singletons.Promote import Data.Singletons.Single -import Data.Type.Bool ( If ) +import Data.Type.Bool ( If, type (&&), type (||), Not ) $(singletons [d| bool_ :: a -> a -> Bool -> a @@ -66,23 +67,29 @@ |]) $(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 |]) + +-- | Conjunction of singletons +(%&&) :: Sing a -> Sing b -> Sing (a && b) +SFalse %&& _ = SFalse +STrue %&& a = a +infixr 3 %&& +$(genDefunSymbols [''(&&)]) + +-- | Disjunction of singletons +(%||) :: Sing a -> Sing b -> Sing (a || b) +SFalse %|| a = a +STrue %|| _ = STrue +infixr 2 %|| +$(genDefunSymbols [''(||)]) + +-- | Negation of a singleton +sNot :: Sing a -> Sing (Not a) +sNot SFalse = STrue +sNot STrue = SFalse +$(genDefunSymbols [''Not]) -- | Conditional over singletons sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c) diff --git a/src/Data/Singletons/Prelude/Eq.hs b/src/Data/Singletons/Prelude/Eq.hs --- a/src/Data/Singletons/Prelude/Eq.hs +++ b/src/Data/Singletons/Prelude/Eq.hs @@ -17,7 +17,8 @@ module Data.Singletons.Prelude.Eq ( PEq(..), SEq(..), - (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$) + type (==@#@$), type (==@#@$$), type (==@#@$$$), + type (/=@#@$), type (/=@#@$$), type (/=@#@$$$) ) where import Data.Singletons.Prelude.Bool @@ -25,38 +26,38 @@ import Data.Singletons.Prelude.Instances import Data.Singletons.Util import Data.Singletons.Promote -import Data.Type.Equality +import qualified Data.Type.Equality as DTE -- NB: These must be defined by hand because of the custom handling of the --- default for (:==) to use Data.Type.Equality.== +-- 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@. +-- | The promoted analogue of 'Eq'. If you supply no definition for '(==)', +-- then it defaults to a use of '(DTE.==)', from "Data.Type.Equality". class PEq a where - type (:==) (x :: a) (y :: a) :: Bool - type (:/=) (x :: a) (y :: a) :: Bool + type (==) (x :: a) (y :: a) :: Bool + type (/=) (x :: a) (y :: a) :: Bool - type (x :: a) :== (y :: a) = x == y - type (x :: a) :/= (y :: a) = Not (x :== y) + type (x :: a) == (y :: a) = x DTE.== y + type (x :: a) /= (y :: a) = Not (x == y) -infix 4 :== -infix 4 :/= +infix 4 == +infix 4 /= -$(genDefunSymbols [''(:==), ''(:/=)]) +$(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 '(%:/=)'. +-- 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 %:== + (%==) :: 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 %:/= + (%/=) :: 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) diff --git a/src/Data/Singletons/Prelude/Function.hs b/src/Data/Singletons/Prelude/Function.hs --- a/src/Data/Singletons/Prelude/Function.hs +++ b/src/Data/Singletons/Prelude/Function.hs @@ -22,17 +22,17 @@ module Data.Singletons.Prelude.Function ( -- * "Prelude" re-exports - Id, sId, Const, sConst, (:.), (%:.), Flip, sFlip, type ($), (%$) + Id, sId, Const, sConst, (:.), (%.), Flip, sFlip, type ($), (%$) -- * Other combinators - , (:&), (%:&), On, sOn + , type (&), (%&), On, sOn -- * Defunctionalization symbols , IdSym0, IdSym1 , ConstSym0, ConstSym1, ConstSym2 - , (:.$), (:.$$), (:.$$$), (:.$$$$) + , type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$) , FlipSym0, FlipSym1, FlipSym2, FlipSym3 - , type ($$), type ($$$), type ($$$$) - , (:&$), (:&$$), (:&$$$) + , type ($@#@$), type ($@#@$$), type ($@#@$$$) + , type (&@#@$), type (&@#@$$), type (&@#@$$$) , OnSym0, OnSym1, OnSym2, OnSym3, OnSym4 ) where @@ -102,7 +102,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c (.*.) `on` f = \x y -> f x .*. f y - + infixl 0 `on` -- -| '&' is a reverse application operator. This provides notational -- convenience. Its precedence is one higher than that of the forward @@ -111,5 +111,5 @@ -- @since 4.8.0.0 (&) :: a -> (a -> b) -> b x & f = f x - + infixl 1 & |]) diff --git a/src/Data/Singletons/Prelude/Instances.hs b/src/Data/Singletons/Prelude/Instances.hs --- a/src/Data/Singletons/Prelude/Instances.hs +++ b/src/Data/Singletons/Prelude/Instances.hs @@ -8,10 +8,10 @@ -} -{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies, +{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies, EmptyCase, FlexibleContexts, TemplateHaskell, ScopedTypeVariables, UndecidableInstances, TypeOperators, FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.Prelude.Instances where diff --git a/src/Data/Singletons/Prelude/IsString.hs b/src/Data/Singletons/Prelude/IsString.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/IsString.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.IsString +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines and exports a promoted and singled version of the 'IsString' +-- type class from "Data.String". +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.IsString ( + PIsString(..), SIsString(..), + + -- ** Defunctionalization symbols + FromStringSym0, FromStringSym1 + ) where + +import Data.Singletons.Single +import Data.Singletons.TypeLits () -- for the IsString instance! +import GHC.TypeLits (Symbol) + +$(singletonsOnly [d| + -- -| Class for string-like datastructures; used by the overloaded string + -- extension (-XOverloadedStrings in GHC). + class IsString a where + fromString :: Symbol -> a + |]) + +-- PIsString instance +instance PIsString Symbol where + type FromString a = a + +-- SIsString instance +instance SIsString Symbol where + sFromString x = x diff --git a/src/Data/Singletons/Prelude/List.hs b/src/Data/Singletons/Prelude/List.hs --- a/src/Data/Singletons/Prelude/List.hs +++ b/src/Data/Singletons/Prelude/List.hs @@ -36,7 +36,7 @@ -- | 'SList' is a kind-restricted synonym for 'Sing': @type SList (a :: [k]) = Sing a@ -- * Basic functions - (:++), (%:++), Head, sHead, Last, sLast, Tail, sTail, Init, sInit, + type (++), (%++), Head, sHead, Last, sLast, Tail, sTail, Init, sInit, Null, sNull, Length, sLength, -- * List transformations @@ -50,10 +50,9 @@ -- ** Special folds Concat, sConcat, ConcatMap, sConcatMap, - And, sAnd, Or, sOr, Any_, sAny_, All, sAll, + 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 @@ -89,7 +88,7 @@ Find, sFind, Filter, sFilter, Partition, sPartition, -- * Indexing lists - (:!!), (%:!!), + type (!!), (%!!), ElemIndex, sElemIndex, ElemIndices, sElemIndices, FindIndex, sFindIndex, FindIndices, sFindIndices, @@ -100,8 +99,12 @@ -- * Special lists + -- ** Functions on 'Symbol's + Unlines, sUnlines, + Unwords, sUnwords, + -- ** \"Set\" operations - Nub, sNub, Delete, sDelete, (:\\), (%:\\), + Nub, sNub, Delete, sDelete, type (\\), (%\\), Union, sUnion, Intersect, sIntersect, -- ** Ordered lists @@ -130,9 +133,10 @@ -- * Defunctionalization symbols NilSym0, - (:$), (:$$), (:$$$), + (:@#@$), (:@#@$$), (:@#@$$$), - (:++$$$), (:++$$), (:++$), HeadSym0, HeadSym1, LastSym0, LastSym1, + type (++@#@$$$), type (++@#@$$), type (++@#@$), + HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, LengthSym0, LengthSym1, @@ -153,7 +157,7 @@ ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, - Any_Sym0, Any_Sym1, Any_Sym2, + AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, SumSym0, SumSym1, ProductSym0, ProductSym1, @@ -195,7 +199,7 @@ FilterSym0, FilterSym1, FilterSym2, PartitionSym0, PartitionSym1, PartitionSym2, - (:!!$), (:!!$$), (:!!$$$), + type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ElemIndexSym0, ElemIndexSym1, ElemIndexSym2, ElemIndicesSym0, ElemIndicesSym1, ElemIndicesSym2, FindIndexSym0, FindIndexSym1, FindIndexSym2, @@ -212,9 +216,12 @@ Unzip6Sym0, Unzip6Sym1, Unzip7Sym0, Unzip7Sym1, + UnlinesSym0, UnlinesSym1, + UnwordsSym0, UnwordsSym1, + NubSym0, NubSym1, DeleteSym0, DeleteSym1, DeleteSym2, - (:\\$), (:\\$$), (:\\$$$), + type (\\@#@$), type (\\@#@$$), type (\\@#@$$$), UnionSym0, UnionSym1, UnionSym2, IntersectSym0, IntersectSym1, IntersectSym2, @@ -236,7 +243,7 @@ GenericLengthSym0, GenericLengthSym1 ) where -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Singletons.TypeLits @@ -249,12 +256,6 @@ 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 @@ -359,6 +360,10 @@ all _ [] = True all p (x:xs) = p x && all p xs + any :: (a -> Bool) -> [a] -> Bool + any _ [] = False + any p (x:xs) = p x || any p xs + scanl :: (b -> a -> b) -> b -> [a] -> [b] scanl f q ls = q : (case ls of [] -> [] @@ -424,15 +429,17 @@ isSuffixOf x y = reverse x `isPrefixOf` reverse y isInfixOf :: (Eq a) => [a] -> [a] -> Bool - isInfixOf needle haystack = any_ (isPrefixOf needle) (tails haystack) + isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) elem :: (Eq a) => a -> [a] -> Bool elem _ [] = False elem x (y:ys) = x==y || elem x ys + infix 4 `elem` notElem :: (Eq a) => a -> [a] -> Bool notElem _ [] = True notElem x (y:ys) = x /= y && notElem x ys + infix 4 `notElem` zip :: [a] -> [b] -> [(a,b)] zip (x:xs) (y:ys) = (x,y) : zip xs ys @@ -506,20 +513,24 @@ -- 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 + unlines :: [Symbol] -> Symbol + unlines [] = "" + unlines (l:ls) = l <> "\n" <> unlines ls + + unwords :: [Symbol] -> Symbol + unwords [] = "" + unwords (w:ws) = w <> go ws + where + go [] = "" + go (v:vs) = " " <> (v <> go vs) + delete :: (Eq a) => a -> [a] -> [a] delete = deleteBy (==) @@ -602,13 +613,13 @@ -- intersectBy _ [] [] = [] -- intersectBy _ [] (_:_) = [] -- intersectBy _ (_:_) [] = [] --- intersectBy eq xs ys = [x | x <- xs, any_ (eq x) ys] +-- 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 + intersectBy eq xs@(_:_) ys@(_:_) = filter (\x -> any (eq x) ys) xs takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] @@ -775,6 +786,7 @@ (!!) :: [a] -> Nat -> a [] !! _ = error "Data.Singletons.List.!!: index too large" (x:xs) !! n = if n == 0 then x else xs !! (n-1) + infixl 9 !! nub :: forall a. (Eq a) => [a] -> [a] nub l = nub' l [] diff --git a/src/Data/Singletons/Prelude/List/NonEmpty.hs b/src/Data/Singletons/Prelude/List/NonEmpty.hs --- a/src/Data/Singletons/Prelude/List/NonEmpty.hs +++ b/src/Data/Singletons/Prelude/List/NonEmpty.hs @@ -50,7 +50,7 @@ Tail, sTail, Last, sLast, Init, sInit, - (:<|), (%:<|), + type (<|), (%<|), Cons, sCons, Uncons, sUncons, Unfoldr, sUnfoldr, @@ -80,7 +80,7 @@ IsPrefixOf, sIsPrefixOf, Nub, sNub, NubBy, sNubBy, - (:!!), (%:!!), + type (!!), (%!!), Zip, sZip, ZipWith, sZipWith, Unzip, sUnzip, @@ -90,7 +90,7 @@ Xor, sXor, -- * Defunctionalization symbols - (:|$), (:|$$), (:|$$$), + (:|@#@$), (:|@#@$$), (:|@#@$$$), MapSym0, MapSym1, MapSym2, IntersperseSym0, IntersperseSym1, IntersperseSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, @@ -105,7 +105,7 @@ TailSym0, TailSym1, LastSym0, LastSym1, InitSym0, InitSym1, - (:<|$), (:<|$$), (:<|$$$), + type (<|@#@$), type (<|@#@$$), type (<|@#@$$$), ConsSym0, ConsSym1, ConsSym2, UnconsSym0, UnconsSym1, UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, @@ -135,7 +135,7 @@ IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, NubSym0, NubSym1, NubBySym0, NubBySym1, NubBySym2, - (:!!$), (:!!$$), (:!!$$$), + type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ZipSym0, ZipSym1, ZipSym2, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, UnzipSym0, UnzipSym1, diff --git a/src/Data/Singletons/Prelude/Maybe.hs b/src/Data/Singletons/Prelude/Maybe.hs --- a/src/Data/Singletons/Prelude/Maybe.hs +++ b/src/Data/Singletons/Prelude/Maybe.hs @@ -56,7 +56,7 @@ ) where import Data.Singletons.Prelude.Instances -import Data.Singletons.TH +import Data.Singletons.Single import Data.Singletons.TypeLits $(singletons [d| diff --git a/src/Data/Singletons/Prelude/Num.hs b/src/Data/Singletons/Prelude/Num.hs --- a/src/Data/Singletons/Prelude/Num.hs +++ b/src/Data/Singletons/Prelude/Num.hs @@ -15,15 +15,18 @@ -- Defines and exports promoted and singleton versions of definitions from -- GHC.Num. -- +-- Be warned that some of the associated type families in the 'PNum' class +-- (@(+)@, @(-)@, and @(*)@) clash with their counterparts for 'Nat' in the +-- "GHC.TypeLits" module. ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Num ( PNum(..), SNum(..), Subtract, sSubtract, -- ** Defunctionalization symbols - (:+$), (:+$$), (:+$$$), - (:-$), (:-$$), (:-$$$), - (:*$), (:*$$), (:*$$$), + type (+@#@$), type (+@#@$$), type (+@#@$$$), + type (-@#@$), type (-@#@$$), type (-@#@$$$), + type (*@#@$), type (*@#@$$), type (*@#@$$$), NegateSym0, NegateSym1, AbsSym0, AbsSym1, SignumSym0, SignumSym1, @@ -32,10 +35,11 @@ ) where import Data.Singletons.Single -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.TypeLits.Internal import Data.Singletons.Decide -import GHC.TypeLits +import qualified GHC.TypeNats as TN +import GHC.TypeNats (Nat, SomeNat(..), someNatVal) import Unsafe.Coerce $(singletonsOnly [d| @@ -73,9 +77,9 @@ SignumNat x = 1 instance PNum Nat where - type a :+ b = a + b - type a :- b = a - b - type a :* b = a * b + type a + b = a TN.+ b + type a - b = a TN.- b + type a * b = a TN.* b type Negate (a :: Nat) = Error "Cannot negate a natural number" type Abs (a :: Nat) = a type Signum a = SignumNat a @@ -83,34 +87,29 @@ -- SNum instance instance SNum Nat where - sa %:+ sb = + 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?" + SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) - sa %:- sb = + 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." + SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) - sa %:* sb = + 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?" + SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) sNegate _ = error "Cannot call sNegate on a natural number singleton." diff --git a/src/Data/Singletons/Prelude/Ord.hs b/src/Data/Singletons/Prelude/Ord.hs --- a/src/Data/Singletons/Prelude/Ord.hs +++ b/src/Data/Singletons/Prelude/Ord.hs @@ -31,10 +31,10 @@ ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, LTSym0, EQSym0, GTSym0, CompareSym0, CompareSym1, CompareSym2, - (:<$), (:<$$), (:<$$$), - (:<=$), (:<=$$), (:<=$$$), - (:>$), (:>$$), (:>$$$), - (:>=$), (:>=$$), (:>=$$$), + type (<@#@$), type (<@#@$$), type (<@#@$$$), + type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), + type (>@#@$), type (>@#@$$), type (>@#@$$$), + type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), MaxSym0, MaxSym1, MaxSym2, MinSym0, MinSym1, MinSym2, ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3 diff --git a/src/Data/Singletons/Prelude/Show.hs b/src/Data/Singletons/Prelude/Show.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Show.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Show +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the SShow singleton version of the Show type class. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Show ( + PShow(..), SShow(..), SymbolS, SChar, show_, + type (<>), (%<>), + Shows, sShows, + ShowListWith, sShowListWith, + ShowChar, sShowChar, + ShowString, sShowString, + ShowParen, sShowParen, + ShowSpace, sShowSpace, + ShowCommaSpace, sShowCommaSpace, + AppPrec, sAppPrec, + AppPrec1, sAppPrec1, + + -- * Defunctionalization symbols + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + Show_Sym0, Show_Sym1, + ShowListSym0, ShowListSym1, ShowListSym2, + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + ShowsSym0, ShowsSym1, ShowsSym2, + ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + ShowSpaceSym0, ShowSpaceSym1, + ShowCommaSpaceSym0, ShowCommaSpaceSym1, + AppPrecSym0, AppPrec1Sym0 + ) where + +import Data.List.NonEmpty (NonEmpty) +import Data.Proxy +import Data.Singletons.Internal +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.List +import Data.Singletons.Prelude.Ord +import Data.Singletons.Promote +import Data.Singletons.Single +import Data.Singletons.TypeLits +import qualified Data.Text as T +import Data.Void + +import GHC.TypeLits + +import qualified Prelude as P +import Prelude hiding (Show(..)) + +import Unsafe.Coerce (unsafeCoerce) + +-- | The @shows@ functions return a function that prepends the +-- output 'Symbol' to an existing 'Symbol'. This allows constant-time +-- concatenation of results using function composition. +type SymbolS = Symbol -> Symbol + +-- | GHC currently has no notion of type-level 'Char's, so we fake them with +-- single-character 'Symbol's. +type SChar = Symbol + +$(singletonsOnly [d| + class Show a where + showsPrec :: Nat -> a -> SymbolS + show_ :: a -> Symbol + showList :: [a] -> SymbolS + + showsPrec _ x s = show_ x <> s + show_ x = shows x "" + showList ls s = showListWith shows ls s + + shows :: Show a => a -> SymbolS + shows s = showsPrec 0 s + + showListWith :: (a -> SymbolS) -> [a] -> SymbolS + showListWith _ [] s = "[]" <> s + showListWith showx (x:xs) s = "[" <> showx x (showl xs) + where + showl [] = "]" <> s + showl (y:ys) = "," <> showx y (showl ys) + + showChar :: SChar -> SymbolS + showChar = (<>) + + showString :: Symbol -> SymbolS + showString = (<>) + + showParen :: Bool -> SymbolS -> SymbolS + showParen b p = if b then showChar "(" . p . showChar ")" else p + + showSpace :: SymbolS + showSpace = \xs -> " " <> xs + + showCommaSpace :: SymbolS + showCommaSpace = showString ", " + + appPrec, appPrec1 :: Nat + appPrec = 10 + appPrec1 = 11 + + instance Show a => Show [a] where + showsPrec _ = showList + + -- -| This is not an ideal Show instance for Symbol, since the Show instance + -- for String escapes special characters. Unfortunately, GHC lacks the ability + -- to case on individual characters in a Symbol (at least, not without GHC + -- plugins), so this is the best we can do for the time being. + instance Show Symbol where + showsPrec _ = showString + + show_tuple :: [SymbolS] -> SymbolS + show_tuple ss = showChar "(" + . foldr1 (\s r -> s . showChar "," . r) ss + . showChar ")" + + instance (Show a, Show b) => Show (a,b) where + showsPrec _ (a,b) s = show_tuple [shows a, shows b] s + + instance (Show a, Show b, Show c) => Show (a, b, c) where + showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s + + instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where + showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s + + instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where + showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s + + instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where + showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s + + instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) + => Show (a,b,c,d,e,f,g) where + showsPrec _ (a,b,c,d,e,f,g) s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s + |]) + +$(promoteOnly [d| + showsNat :: Nat -> SymbolS + showsNat 0 = showChar "0" + showsNat 1 = showChar "1" + showsNat 2 = showChar "2" + showsNat 3 = showChar "3" + showsNat 4 = showChar "4" + showsNat 5 = showChar "5" + showsNat 6 = showChar "6" + showsNat 7 = showChar "7" + showsNat 8 = showChar "8" + showsNat 9 = showChar "9" + showsNat n = showsNat (n `div` 10) . showsNat (n `mod` 10) + |]) + +-- | Note that this instance is really, really slow, since it uses an inefficient, +-- inductive definition of division behind the hood. +instance PShow Nat where + type ShowsPrec _ n x = ShowsNat n x + +instance SShow Nat where + sShowsPrec _ sn sx = + let n = fromSing sn + x = fromSing sx + ex = someSymbolVal (P.show n ++ T.unpack x) + in + case ex of + SomeSymbol (_ :: Proxy s) -> unsafeCoerce (SSym :: Sing s) + +-- | 'P.show', but with an extra underscore so that its promoted counterpart +-- ('Show_') will not clash with the 'Show' class. +show_ :: P.Show a => a -> String +show_ = P.show + +$(singShowInstances [ ''(), ''Maybe, ''Either, ''NonEmpty, ''Bool, + ''Ordering, ''Void ]) diff --git a/src/Data/Singletons/Prelude/Tuple.hs b/src/Data/Singletons/Prelude/Tuple.hs --- a/src/Data/Singletons/Prelude/Tuple.hs +++ b/src/Data/Singletons/Prelude/Tuple.hs @@ -47,7 +47,7 @@ ) where import Data.Singletons.Prelude.Instances -import Data.Singletons.TH +import Data.Singletons.Single $(singletonsOnly [d| -- -| Extract the first component of a pair. diff --git a/src/Data/Singletons/Prelude/Void.hs b/src/Data/Singletons/Prelude/Void.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Void.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Void +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines functions and datatypes relating to the singleton for 'Void', +-- including a singleton version of all the definitions in @Data.Void@. +-- +-- Because many of these definitions are produced by Template Haskell, +-- it is not possible to create proper Haddock documentation. Please look +-- up the corresponding operation in @Data.Void@. Also, please excuse +-- the apparent repeated variable names. This is due to an interaction +-- between Template Haskell and Haddock. +-- +---------------------------------------------------------------------------- +module Data.Singletons.Prelude.Void ( + -- * The 'Void' singleton + Sing, + -- | Just as 'Void' has no constructors, the 'Sing' instance above also has + -- no constructors. + + SVoid, + -- | 'SVoid' is a kind-restricted synonym for 'Sing': + -- @type SVoid (a :: Void) = Sing a@ + + -- * Singletons from @Data.Void@ + Absurd, sAbsurd, + + -- * Defunctionalization symbols + AbsurdSym0, AbsurdSym1 + ) where + +import Data.Singletons.Internal +import Data.Singletons.Prelude.Instances +import Data.Singletons.Single +import Data.Void + +$(singletonsOnly [d| + -- -| Since 'Void' values logically don't exist, this witnesses the + -- logical reasoning tool of \"ex falso quodlibet\". + absurd :: Void -> a + absurd a = case a of {} + |]) diff --git a/src/Data/Singletons/Promote.hs b/src/Data/Singletons/Promote.hs --- a/src/Data/Singletons/Promote.hs +++ b/src/Data/Singletons/Promote.hs @@ -22,14 +22,19 @@ import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum +import Data.Singletons.Deriving.Show import Data.Singletons.Partition import Data.Singletons.Util import Data.Singletons.Syntax import Prelude hiding (exp) +import Control.Applicative (Alternative(..)) import Control.Monad +import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad.Trans.Maybe import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import Data.Maybe +import qualified GHC.LanguageExtensions.Type as LangExt -- | Generate promoted definitions from a type that is already defined. -- This is generally only useful with classes. @@ -67,7 +72,7 @@ decs <- promoteMDecs [] $ concatMapM defunInfo infos return $ decsToTH decs --- | Produce instances for '(:==)' (type-level equality) from the given types +-- | Produce instances for @(==)@ (type-level equality) from the given types promoteEqInstances :: DsMonad q => [Name] -> q [Dec] promoteEqInstances = concatMapM promoteEqInstance @@ -95,24 +100,32 @@ promoteEnumInstance :: DsMonad q => Name -> q [Dec] promoteEnumInstance = promoteInstance mkEnumInstance "Enum" --- | Produce an instance for '(:==)' (type-level equality) from the given type +-- | Produce instances for 'PShow' from the given types +promoteShowInstances :: DsMonad q => [Name] -> q [Dec] +promoteShowInstances = concatMapM promoteShowInstance + +-- | Produce an instance for 'PShow' from the given type +promoteShowInstance :: DsMonad q => Name -> q [Dec] +promoteShowInstance = promoteInstance (mkShowInstance ForPromotion) "Show" + +-- | Produce an instance for @(==)@ (type-level equality) from the given type promoteEqInstance :: DsMonad q => Name -> q [Dec] promoteEqInstance name = do - (_tvbs, cons) <- getDataD "I cannot make an instance of (:==) for it." name + (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)) + tvbs' <- mapM dsTvb tvbs + kind <- promoteType (foldType (DConT name) (map tvbToType tvbs')) inst_decs <- mkEqTypeInstance kind cons' return $ decsToTH inst_decs -promoteInstance :: DsMonad q => (DType -> [DCon] -> q UInstDecl) +promoteInstance :: DsMonad q => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl) -> String -> Name -> q [Dec] promoteInstance mk_inst class_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ class_name ++ " for it.") name cons' <- concatMapM dsCon cons tvbs' <- mapM dsTvb tvbs - raw_inst <- mk_inst (foldType (DConT name) (map tvbToType tvbs')) cons' + raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType tvbs')) cons' decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst return $ decsToTH decs @@ -168,16 +181,18 @@ 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 + PDecs { pd_let_decs = let_decs + , pd_class_decs = classes + , pd_instance_decs = insts + , pd_data_decs = datas + , pd_derived_eq_decs = derived_eq_decs } <- partitionDecs decls -- promoteLetDecs returns LetBinds, which we don't need at top level _ <- promoteLetDecs noPrefix let_decs mapM_ promoteClassDec classes let all_meth_sigs = foldMap (lde_types . cd_lde) classes mapM_ (promoteInstanceDec all_meth_sigs) insts + mapM_ promoteDerivedEqDec derived_eq_decs promoteDataDecs datas promoteDataDecs :: [DataDecl] -> PrM () @@ -208,7 +223,7 @@ 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 of data types to kinds is automatic (see "Giving Haskell a -- Promotion" paper for more details). Here we "plug into" the promotion -- mechanism to add some extra stuff to the promotion: -- @@ -222,15 +237,7 @@ -- -- * 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 - +promoteDataDec (DataDecl _nd name tvbs ctors _derivings) = do ctorSyms <- buildDefunSymsDataD name tvbs ctors emitDecs ctorSyms @@ -322,24 +329,59 @@ lookup_cls_tvb_names :: PrM [Name] lookup_cls_tvb_names = do - mb_info <- dsReify pClsName + let mk_tvb_names = extract_tvb_names (dsReifyTypeNameInfo pClsName) + <|> extract_tvb_names (dsReifyTypeNameInfo cls_name) + -- See Note [Using dsReifyTypeNameInfo when promoting instances] + mb_tvb_names <- runMaybeT mk_tvb_names + case mb_tvb_names of + Just tvb_names -> pure tvb_names + Nothing -> fail $ "Cannot find class declaration annotation for " ++ show cls_name + + extract_tvb_names :: PrM (Maybe DInfo) -> MaybeT PrM [Name] + extract_tvb_names reify_info = do + mb_info <- lift reify_info case mb_info of - Just (DTyConI (DClassD _ _ tvbs _ _) _) -> return (map extractTvbName 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 + Just (DTyConI (DClassD _ _ tvbs _ _) _) + -> pure $ map extractTvbName tvbs + _ -> empty --- 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. +{- +Note [Using dsReifyTypeNameInfo when promoting instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +During the promotion of a class instance, it becomes necessary to reify the +original promoted class's info to learn various things. It's tempting to think +that just calling dsReify on the class name will be sufficient, but it's not. +Consider this class and its promotion: + class Eq a where + (==) :: a -> a -> Bool + + class PEq a where + type (==) (x :: a) (y :: a) :: Bool + +Notice how both of these classes have an identifier named (==), one at the +value level, and one at the type level. Now imagine what happens when you +attempt to promote this Template Haskell declaration: + + [d| f :: Bool + f = () == () |] + +When promoting ==, singletons will come up with its promoted equivalent (which also +happens to be ==). However, this promoted name is a raw Name, since it is created +with mkName. This becomes an issue when we call dsReify the raw "==" Name, as +Template Haskell has to arbitrarily choose between reifying the info for the +value-level (==) and the type-level (==), and in this case, it happens to pick the +value-level (==) info. We want the type-level (==) info, however, because we care +about the promoted version of (==). + +Fortunately, there's a serviceable workaround. Instead of dsReify, we can use +dsReifyTypeNameInfo, which first calls lookupTypeName (to ensure we can find a Name +that's in the type namespace) and _then_ reifies it. +-} + promoteMethod :: Maybe (Map Name DKind) -- ^ instantiations for class tyvars (Nothing for default decls) + -- See Note [Promoted class method kinds] -> Map Name DType -- method types -> (Name, ULetDecRHS) -> PrM (DDec, ALetDecRHS, DType) @@ -349,18 +391,31 @@ ((_, _, _, 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 + let -- If we're dealing with an associated type family instance, substitute + -- in the kind of the instance for better kind information in the RHS + -- helper function. If we're dealing with a default family implementation + -- (m_subst = Nothing), there's no need for a substitution. + -- See Note [Promoted class method kinds] + do_subst = maybe id substKind m_subst meth_arg_kis' = map do_subst arg_kis meth_res_ki' = do_subst res_ki helperNameBase = case nameBase proName of first:_ | not (isHsLetter first) -> "TFHelper" alpha -> alpha - family_args - -- 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' + + -- family_args are the type variables in a promoted class's + -- associated type family instance (or default implementation), e.g., + -- + -- class C k where + -- type T (a :: k) (b :: Bool) + -- type T a b = THelper1 a b -- family_args = [a, b] + -- + -- instance C Bool where + -- type T a b = THelper2 a b -- family_args = [a, b] + -- + -- We could annotate these variables with explicit kinds, but it's not + -- strictly necessary, as kind inference can figure them out just as well. + family_args = map DVarT meth_arg_tvs helperName <- newUniqueName helperNameBase emitDecs [DClosedTypeFamilyD (DTypeFamilyHead helperName @@ -381,18 +436,51 @@ lookup_meth_ty :: PrM ([DKind], DKind) lookup_meth_ty = case Map.lookup meth_name sigs_map of Nothing -> do - mb_info <- dsReify proName + mb_info <- dsReifyTypeNameInfo proName + -- See Note [Using dsReifyTypeNameInfo when promoting instances] case mb_info of Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _) -> let arg_kis = map (default_to_star . extractTvbKind) tvbs res_ki = default_to_star (resultSigToMaybeKind mb_res_ki) - in return (arg_kis, res_ki) + in return (arg_kis, res_ki) _ -> fail $ "Cannot find type annotation for " ++ show proName Just ty -> promoteUnraveled ty default_to_star Nothing = DStarT default_to_star (Just k) = k +{- +Note [Promoted class method kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this example of a type class (and instance): + + class C a where + m :: a -> Bool -> Bool + m _ x = x + + instance C [a] where + m l _ = null l + +The promoted version of these declarations would be: + + class PC a where + type M (x :: a) (y :: Bool) (z :: Bool) + type M x y z = MHelper1 x y z + + instance PC [a] where + type M x y z = MHelper2 x y z + + type family MHelper1 (x :: a) (y :: Bool) (z :: Bool) where ... + type family MHelper2 (x :: [a]) (y :: Bool) (z :: Bool) where ... + +Getting the kind signature for MHelper1 (the promoted default implementation of +M) is quite simple, as it corresponds exactly to the kind of M. We might even +choose to make that the kind of MHelper2, but then it would be overly general +(and more difficult to find in -ddump-splices output). For this reason, we +substitute in the kinds of the instance itself to determine the kinds of +promoted method implementations like MHelper2. +-} + promoteLetDecEnv :: (String, String) -> ULetDecEnv -> PrM ([DDec], ALetDecEnv) promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env , lde_types = type_env @@ -423,8 +511,12 @@ promoteInfixDecl :: Fixity -> Name -> Maybe DDec promoteInfixDecl fixity name - | isUpcase name = Nothing -- no need to promote the decl - | otherwise = Just $ DLetDec $ DInfixD fixity (promoteValNameLhs name) + | isDataConName name || not (isHsLetter (head (nameBase name))) + = Nothing -- No need to promote fixity declarations for constructor names or + -- infix names, as those fixity declarations apply to both + -- the value and type namespaces. + | otherwise + = Just $ DLetDec $ DInfixD fixity (promoteValNameLhs name) -- This function is used both to promote class method defaults and normal -- let bindings. Thus, it can't quite do all the work locally and returns @@ -555,10 +647,7 @@ promoted <- promotePat pat ki <- promoteType ty return $ DSigT promoted ki -promotePat DWildPa = do - name <- newUniqueName "_z" - tyName <- mkTyName name - return $ DVarT tyName +promotePat DWildPa = return DWildCardT promoteExp :: DExp -> PrM (DType, ADExp) promoteExp (DVarE name) = fmap (, ADVarE name) $ lookupVarE name @@ -608,7 +697,7 @@ , ADCaseE ann_exp ann_matches applied_case ) promoteExp (DLetE decs exp) = do unique <- qNewUnique - let letPrefixes = uniquePrefixes "Let" ":<<<" unique + 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) @@ -618,12 +707,17 @@ 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 :: Quasi q => Lit -> q DType promoteLitExp (IntegerL n) | n >= 0 = return $ (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit n)) | otherwise = return $ (DConT tyNegateName `DAppT` (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit (-n)))) -promoteLitExp (StringL str) = return $ DLitT (StrTyLit str) +promoteLitExp (StringL str) = do + let prom_str_lit = DLitT (StrTyLit str) + os_enabled <- qIsExtEnabled LangExt.OverloadedStrings + pure $ if os_enabled + then DConT tyFromStringName `DAppT` prom_str_lit + else prom_str_lit promoteLitExp lit = fail ("Only string and natural number literals can be promoted: " ++ show lit) @@ -636,3 +730,10 @@ promoteLitPat (StringL str) = return $ DLitT (StrTyLit str) promoteLitPat lit = fail ("Only string and natural number literals can be promoted: " ++ show lit) + +-- See Note [DerivedDecl] +promoteDerivedEqDec :: DerivedEqDecl -> PrM () +promoteDerivedEqDec (DerivedDecl { ded_type = ty, ded_cons = cons }) = do + kind <- promoteType ty + inst_decs <- mkEqTypeInstance kind cons + emitDecs inst_decs diff --git a/src/Data/Singletons/Promote/Defun.hs b/src/Data/Singletons/Promote/Defun.hs --- a/src/Data/Singletons/Promote/Defun.hs +++ b/src/Data/Singletons/Promote/Defun.hs @@ -91,8 +91,8 @@ -- 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.) +-- an instance of a dummy class. (See Data.Singletons.SuppressUnusedWarnings +-- for the class, which should never be seen by anyone, ever.) -- -- The defunctionalize function takes Maybe DKinds so that the caller can -- indicate which kinds are known and which need to be inferred. @@ -127,7 +127,7 @@ extra_name <- qNewName "arg" let data_name = promoteTySym name n next_name = promoteTySym name (n+1) - con_name = suffixName "KindInference" "###" (toDataConName data_name) + con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name m_tyfun = buildTyFun_maybe m_arg m_result arg_params = zipWith mk_tvb rest_names (reverse m_args) tyfun_param = mk_tvb fst_name m_tyfun @@ -140,7 +140,7 @@ con_decl = DCon [DPlainTV extra_name] [con_eq_ct] con_name - (DNormalC []) + (DNormalC False []) Nothing data_decl = DDataD Data [] data_name params [con_decl] [] app_eqn = DTySynEqn [ foldType (DConT data_name) @@ -151,7 +151,7 @@ suppress = DInstanceD Nothing [] (DConT suppressClassName `DAppT` DConT data_name) [DLetDec $ DFunD suppressMethodName - [DClause [DWildPa] + [DClause [] ((DVarE 'snd) `DAppE` mkTupleDExp [DConE con_name, mkTupleDExp []])]] diff --git a/src/Data/Singletons/Promote/Eq.hs b/src/Data/Singletons/Promote/Eq.hs --- a/src/Data/Singletons/Promote/Eq.hs +++ b/src/Data/Singletons/Promote/Eq.hs @@ -16,22 +16,28 @@ import Control.Monad -- produce a closed type family helper and the instance --- for (:==) over the given list of ctors +-- 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 + let null_branch = catch_all_case trueName + false_branch = catch_all_case falseName + branches | null cons = [null_branch] + | otherwise = true_branches ++ [false_branch] + closedFam = DClosedTypeFamilyD (DTypeFamilyHead helperName + -- We opt to give explicit kinds for the tyvars + -- in the helper type family. + -- See Note [Promoted class method kinds] + -- in Data.Singletons.Promote. [ DKindedTV aName kind , DKindedTV bName kind ] (DKindSig boolKi) Nothing) - (true_branches ++ [false_branch]) - eqInst = DTySynInstD tyEqName (DTySynEqn [ DSigT (DVarT aName) kind - , DSigT (DVarT bName) kind ] + branches + eqInst = DTySynInstD tyEqName (DTySynEqn [DVarT aName, DVarT bName] (foldType (DConT helperName) [DVarT aName, DVarT bName])) inst = DInstanceD Nothing [] ((DConT $ promoteClassName eqName) `DAppT` @@ -52,12 +58,10 @@ 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) + catch_all_case :: Name -> DTySynEqn + catch_all_case returned_val_name = + DTySynEqn [DSigT DWildCardT kind, DSigT DWildCardT kind] + (promoteValRhs returned_val_name) tyAll :: [DType] -> DType -- "all" at the type level tyAll [] = (promoteValRhs trueName) diff --git a/src/Data/Singletons/Promote/Monad.hs b/src/Data/Singletons/Promote/Monad.hs --- a/src/Data/Singletons/Promote/Monad.hs +++ b/src/Data/Singletons/Promote/Monad.hs @@ -46,7 +46,7 @@ newtype PrM a = PrM (ReaderT PrEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad, Quasi , MonadReader PrEnv, MonadWriter [DDec] - , MonadFail ) + , MonadFail, MonadIO ) instance DsMonad PrM where localDeclarations = asks pr_local_decls diff --git a/src/Data/Singletons/ShowSing.hs b/src/Data/Singletons/ShowSing.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/ShowSing.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.ShowSing +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the class 'ShowSing', allowing for conversion of 'Sing' values to +-- readable 'String's. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.ShowSing ( + -- * The 'ShowSing' class + ShowSing(..), + ) where + +import Data.Singletons.Internal +import Data.Singletons.Prelude.Instances +import Data.Singletons.Single +import Data.Singletons.TypeLits.Internal +import Data.Singletons.Util + +import GHC.Show (appPrec, appPrec1) +import GHC.TypeLits (symbolVal) +import qualified GHC.TypeNats as TN (natVal) + +---------------------------------------------------------------------- +---- ShowSing -------------------------------------------------------- +---------------------------------------------------------------------- + +-- | Members of the 'ShowSing' kind class can have their 'Sing' values +-- converted to 'String's in a fashion similar to that of the 'Show' class. +-- (In fact, this class only exists because one cannot write 'Show' instances +-- for 'Sing's of the form +-- @instance (forall z. Show (Sing (z :: k))) => Show (Sing (x :: [k]))@.) +-- +-- This class should not be confused with the promoted or singled versions of +-- 'Show' from "Data.Singletons.Prelude.Show" (@PShow@ and @SShow@, respectively). +-- The output of 'ShowSing' is intended to reflect the singleton type, whereas +-- the output of @PShow@ and @SShow@ reflects the original type. That is, showing +-- @SFalse@ with 'ShowSing' would yield @\"SFalse\"@, whereas @PShow@ and @SShow@ +-- would yield @\"False\"@. +-- +-- Instances of this class are generated alongside singleton definitions for +-- datatypes that derive a 'Show' instance. Moreover, having a 'ShowSing' +-- instances makes it simple to define a 'Show' instance. For instance: +-- +-- @ +-- instance 'ShowSing' a => 'ShowSing' [a] where +-- 'showsSingPrec' = ... +-- instance 'ShowSing' a => 'Show' ('Sing' (x :: [a])) where +-- 'showsPrec' = 'showsSingPrec' +-- @ +-- +-- As a result, singleton definitions for datatypes that derive a 'Show' +-- instance also get a 'Show' instance for the singleton type as well +-- (in addition to promoted and singled 'Show' instances). +-- +-- To recap: 'singletons' will give you all of these for a datatype that derives +-- a 'Show' instance: +-- +-- * A promoted (@PShow@) instance +-- * A singled (@SShow@) instance +-- * A 'ShowSing' instance for the singleton type +-- * A 'Show' instance for the singleton type +-- +-- What a bargain! +class ShowSing k where + -- | @'showsSingPrec' p s@ convert a 'Sing' value @p@ to a readable 'String' + -- with precedence @p@. + showsSingPrec :: Int -> Sing (a :: k) -> ShowS + +------------------------------------------------------------ +-- TypeLits instances +------------------------------------------------------------ + +-- These are a bit special because the singleton constructor does not uniquely +-- determine the type being used in the constructor's return type (e.g., all Nats +-- have the same singleton constructor, SNat). To compensate for this, we display +-- the type being used using visible type application. (Thanks to @cumber on #179 +-- for suggesting this implementation.) + +instance ShowSing Nat where + showsSingPrec p n@SNat + = showParen (p > appPrec) + ( showString "SNat @" + . showsPrec appPrec1 (TN.natVal n) + ) +instance Show (SNat n) where + showsPrec = showsSingPrec + +instance ShowSing Symbol where + showsSingPrec p s@SSym + = showParen (p > appPrec) + ( showString "SSym @" + . showsPrec appPrec1 (symbolVal s) + ) +instance Show (SSymbol s) where + showsPrec = showsSingPrec + +------------------------------------------------------------ +-- Template Haskell-generated instances +------------------------------------------------------------ + +$(showSingInstances basicTypes) diff --git a/src/Data/Singletons/Sigma.hs b/src/Data/Singletons/Sigma.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Sigma.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeInType #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Sigma +-- Copyright : (C) 2017 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines 'Sigma', a dependent pair data type, and related functions. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Sigma + ( Sigma(..), Σ + , projSigma1, projSigma2 + , mapSigma, zipSigma + ) where + +import Data.Kind +import Data.Singletons.Internal + +-- | A dependent pair. +data Sigma (s :: Type) :: (s ~> Type) -> Type where + (:&:) :: forall s t fst. Sing (fst :: s) -> t @@ fst -> Sigma s t +infixr 4 :&: + +-- | Unicode shorthand for 'Sigma'. +type Σ (s :: Type) (t :: s ~> Type) = Sigma s t +-- We can't define defunctionalization symbols for this at the moment due +-- to #216 + +-- | Project the first element out of a dependent pair. +projSigma1 :: forall s t. SingKind s => Sigma s t -> Demote s +projSigma1 (a :&: _) = fromSing a + +-- | Project the second element out of a dependent pair. +-- +-- In an ideal setting, the type of 'projSigma2' would be closer to: +-- +-- @ +-- 'projSigma2' :: 'Sing' (sig :: 'Sigma' s t) -> t @@ ProjSigma1 sig +-- @ +-- +-- But promoting 'projSigma1' to a type family is not a simple task. Instead, +-- we do the next-best thing, which is to use Church-style elimination. +projSigma2 :: forall s t r. (forall (fst :: s). t @@ fst -> r) -> Sigma s t -> r +projSigma2 f ((_ :: Sing (fst :: s)) :&: b) = f @fst b + +-- | Map across a 'Sigma' value in a dependent fashion. +mapSigma :: Sing (f :: a ~> b) -> (forall (x :: a). p @@ x -> q @@ (f @@ x)) + -> Sigma a p -> Sigma b q +mapSigma f g ((x :: Sing (fst :: a)) :&: y) = (f @@ x) :&: (g @fst y) + +-- | Zip two 'Sigma' values together in a dependent fashion. +zipSigma :: Sing (f :: a ~> b ~> c) + -> (forall (x :: a) (y :: b). p @@ x -> q @@ y -> r @@ (f @@ x @@ y)) + -> Sigma a p -> Sigma b q -> Sigma c r +zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) = + (f @@ a @@ b) :&: (g @fstA @fstB p q) diff --git a/src/Data/Singletons/Single.hs b/src/Data/Singletons/Single.hs --- a/src/Data/Singletons/Single.hs +++ b/src/Data/Singletons/Single.hs @@ -13,9 +13,11 @@ import Prelude hiding ( exp ) import Language.Haskell.TH hiding ( cxt ) import Language.Haskell.TH.Syntax (Quasi(..)) +import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum +import Data.Singletons.Deriving.Show import Data.Singletons.Util import Data.Singletons.Promote import Data.Singletons.Promote.Monad ( promoteM ) @@ -34,6 +36,7 @@ import Data.Maybe import Control.Monad import Data.List +import qualified GHC.LanguageExtensions.Type as LangExt {- How singletons works @@ -98,23 +101,23 @@ singletonsOnly :: DsMonad q => q [Dec] -> q [Dec] singletonsOnly = (>>= wrapDesugar singTopLevelDecs) --- | Create instances of 'SEq' and type-level '(:==)' for each type in the list +-- | 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 +-- | 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 +-- | 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 +-- | 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 @@ -129,17 +132,15 @@ -- generalized function for creating equality instances singEqualityInstance :: DsMonad q => EqualityClassDesc q -> Name -> q [Dec] -singEqualityInstance desc@(_, className, _) name = do +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 + (scons, _) <- singM [] $ mapM singCtor dcons + eqInstance <- mkEqualityInstance Nothing kind dcons scons desc return $ decToTH eqInstance -- | Create instances of 'SOrd' for the given types @@ -166,15 +167,52 @@ singEnumInstance :: DsMonad q => Name -> q [Dec] singEnumInstance = singInstance mkEnumInstance "Enum" +-- | Create instance of 'SShow' for the given type +-- +-- (Not to be confused with 'showShowInstance'.) +singShowInstance :: DsMonad q => Name -> q [Dec] +singShowInstance = singInstance (mkShowInstance ForPromotion) "Show" + +-- | Create instances of 'SShow' for the given types +-- +-- (Not to be confused with 'showSingInstances'.) +singShowInstances :: DsMonad q => [Name] -> q [Dec] +singShowInstances = concatMapM singShowInstance + +-- | Create instance of 'ShowSing' for the given type +-- +-- (Not to be confused with 'singShowInstance'.) + +-- (We can't simply use singInstance to create ShowSing instances, because +-- there's no promoted counterpart. So we use this instead.) +showSingInstance :: DsMonad q => Name -> q [Dec] +showSingInstance name = do + (tvbs, cons) <- getDataD ("I cannot make an instance of ShowSing for it.") name + dtvbs <- mapM dsTvb tvbs + dcons <- concatMapM dsCon cons + let tyvars = map (DVarT . extractTvbName) dtvbs + kind = foldType (DConT name) tyvars + deriv_show_decl = DerivedDecl { ded_mb_cxt = Nothing + , ded_type = kind + , ded_cons = dcons } + (show_insts, _) <- singM [] $ singDerivedShowDecs deriv_show_decl + pure $ decsToTH show_insts + +-- | Create instances of 'ShowSing' for the given types +-- +-- (Not to be confused with 'singShowInstances'.) +showSingInstances :: DsMonad q => [Name] -> q [Dec] +showSingInstances = concatMapM showSingInstance + singInstance :: DsMonad q - => (DType -> [DCon] -> q UInstDecl) + => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl) -> String -> Name -> q [Dec] singInstance mk_inst inst_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ inst_name ++ " for it.") name dtvbs <- mapM dsTvb tvbs dcons <- concatMapM dsCon cons - raw_inst <- mk_inst (foldType (DConT name) (map tvbToType dtvbs)) dcons + raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType dtvbs)) dcons (a_inst, decs) <- promoteM [] $ promoteInstanceDec Map.empty raw_inst decs' <- singDecsM [] $ (:[]) <$> singInstD a_inst @@ -193,12 +231,14 @@ fail "Singling of pattern synonym 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 +singTopLevelDecs locals raw_decls = withLocalDeclarations locals $ do + decls <- expand raw_decls -- expand type synonyms + PDecs { pd_let_decs = letDecls + , pd_class_decs = classes + , pd_instance_decs = insts + , pd_data_decs = datas + , pd_derived_eq_decs = derivedEqDecs + , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls ((letDecEnv, classes', insts'), promDecls) <- promoteM locals $ do promoteDataDecs datas @@ -206,6 +246,7 @@ classes' <- mapM promoteClassDec classes let meth_sigs = foldMap (lde_types . cd_lde) classes insts' <- mapM (promoteInstanceDec meth_sigs) insts + mapM_ promoteDerivedEqDec derivedEqDecs return (letDecEnv, classes', insts') singDecsM locals $ do @@ -216,7 +257,12 @@ newDataDecls <- concatMapM singDataD datas newClassDecls <- mapM singClassD classes' newInstDecls <- mapM singInstD insts' - return (newDataDecls ++ newClassDecls ++ newInstDecls) + newDerivedEqDecs <- concatMapM singDerivedEqDecs derivedEqDecs + newDerivedShowDecs <- concatMapM singDerivedShowDecs derivedShowDecs + return $ newDataDecls ++ newClassDecls + ++ newInstDecls + ++ newDerivedEqDecs + ++ newDerivedShowDecs return $ promDecls ++ (map DLetDec newLetDecls) ++ newDecls -- see comment at top of file @@ -265,7 +311,7 @@ sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names) res_ki_map)) (Map.toList default_defns) - let fixities' = map (uncurry singInfixDecl) fixities + fixities' <- traverse (uncurry singInfixDecl) fixities cls_cxt' <- mapM singPred cls_cxt return $ DClassD cls_cxt' (singClassName cls_name) @@ -351,9 +397,9 @@ 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 ] + infix_decls' <- traverse (uncurry singInfixDecl) infix_decls + let res_ki_map = Map.fromList [ (name, res_ki) | ((name, _), Just res_ki) + <- zip prom_list res_kis ] bindLets letBinds $ do let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames) res_ki_map)) (Map.toList defns) @@ -434,7 +480,7 @@ fail $ "Function being promoted to " ++ (pprint (typeToTH prom_fun)) ++ " has too many arguments." - sPats <- mapM (singPat (Map.fromList var_proms) Parameter) pats + sPats <- mapM (singPat (Map.fromList var_proms)) pats sBody <- singExp exp res_ki -- when calling unSingFun, the promoted pats aren't in scope, so we use the -- bound_names instead @@ -444,45 +490,29 @@ (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!)" - singPat :: Map Name Name -- from term-level names to type-level names - -> PatternContext -> DPat -> SgM DPat -singPat _var_proms _patCxt (DLitPa _lit) = +singPat _var_proms (DLitPa _lit) = fail "Singling of literal patterns not yet supported" -singPat var_proms _patCxt (DVarPa name) = do +singPat var_proms (DVarPa name) = do tyname <- case Map.lookup name var_proms of Nothing -> fail "Internal error: unknown variable when singling pattern" Just tyname -> return tyname return $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname) -singPat var_proms patCxt (DConPa name pats) = do - checkIfBrainWillExplode patCxt - pats' <- mapM (singPat var_proms patCxt) pats +singPat var_proms (DConPa name pats) = do + pats' <- mapM (singPat var_proms) pats return $ DConPa (singDataConName name) pats' -singPat var_proms patCxt (DTildePa pat) = do +singPat var_proms (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' <- singPat var_proms patCxt pat + singPat var_proms pat +singPat var_proms (DBangPa pat) = do + pat' <- singPat var_proms pat return $ DBangPa pat' -singPat _var_proms _patCxt (DSigPa _pat _ty) = error "TODO: Handle SigPa. See Issue #183." -singPat _var_proms _patCxt DWildPa = return DWildPa +singPat _var_proms (DSigPa _pat _ty) = error "TODO: Handle SigPa. See Issue #183." +singPat _var_proms DWildPa = return DWildPa -- Note [Annotate case return type] @@ -522,9 +552,9 @@ 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. + -- out the type of `undefined`. So we don't emit `applySing` there. if isException e1' - then return e1' + then return $ e1' `DAppE` e2' else return $ (DVarE applySingName) `DAppE` e1' `DAppE` e2' singExp (ADLamE ty_names prom_lam names exp) _res_ki = do let sNames = map singValName names @@ -546,8 +576,71 @@ singExp (ADSigE {}) _ = fail "Singling of explicit type annotations not yet supported." +-- See Note [DerivedDecl] +singDerivedEqDecs :: DerivedEqDecl -> SgM [DDec] +singDerivedEqDecs (DerivedDecl { ded_mb_cxt = mb_ctxt + , ded_type = ty + , ded_cons = cons }) = do + (scons, _) <- singM [] $ mapM singCtor cons + mb_sctxt <- mapM (mapM singPred) mb_ctxt + kind <- promoteType ty + sEqInst <- mkEqualityInstance mb_sctxt kind cons scons sEqClassDesc + -- Beware! The user might have specified an instance context like this: + -- + -- deriving instance Eq a => Eq (T a Int) + -- + -- When we single the context, it will become (SEq a). But we do *not* want + -- this for the SDecide instance! The simplest solution is to simply replace + -- all occurrences of SEq with SDecide in the context. + let mb_sctxtDecide = fmap (map sEqToSDecide) mb_sctxt + sDecideInst <- mkEqualityInstance mb_sctxtDecide kind cons scons sDecideClassDesc + return [sEqInst, sDecideInst] + +-- Walk a DPred, replacing all occurrences of SEq with SDecide. +sEqToSDecide :: DPred -> DPred +sEqToSDecide = modifyConNameDPred $ \n -> + -- Why don't we directly compare n to sEqClassName? Because n is almost certainly + -- produced from a call to singClassName, which uses unqualified Names. Ugh. + if nameBase n == nameBase sEqClassName + then sDecideClassName + else n + +-- See Note [DerivedDecl] +singDerivedShowDecs :: DerivedShowDecl -> SgM [DDec] +singDerivedShowDecs (DerivedDecl { ded_mb_cxt = mb_cxt + , ded_type = ty + , ded_cons = cons }) = do + -- First, generate the ShowSing instance. + show_sing_inst <- mkShowInstance ForShowSing mb_cxt ty cons + z <- qNewName "z" + -- Next, the Show instance for the singleton type, like this: + -- + -- instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b)) where + -- showsPrec = showsSingPrec + -- + -- Be careful: we want to generate an instance context that uses ShowSing, + -- not Show, because we are reusing the ShowSing instance. + show_cxt <- inferConstraintsDef (fmap (mkShowContext ForShowSing) mb_cxt) + (DConPr showSingName) + ty cons + let show_inst = DInstanceD Nothing show_cxt + (DConT showName `DAppT` (singFamily `DAppT` DSigT (DVarT z) ty)) + [DLetDec (DFunD showsPrecName + [DClause [] (DVarE showsSingPrecName)])] + pure [toInstanceD show_sing_inst, show_inst] + where + toInstanceD :: UInstDecl -> DDec + toInstanceD (InstDecl { id_cxt = cxt, id_name = inst_name + , id_arg_tys = inst_tys, id_meths = ann_meths }) = + DInstanceD Nothing cxt (foldType (DConT inst_name) inst_tys) + (map (DLetDec . toFunD) ann_meths) + + toFunD :: (Name, ULetDecRHS) -> DLetDec + toFunD (fun_name, UFunction clauses) = DFunD fun_name clauses + toFunD (val_name, UValue rhs) = DValD (DVarPa val_name) rhs + isException :: DExp -> Bool -isException (DVarE n) = n == undefinedName +isException (DVarE n) = nameBase n == "sUndefined" isException (DConE {}) = False isException (DLitE {}) = False isException (DAppE (DVarE fun) _) | nameBase fun == "sError" = True @@ -562,7 +655,7 @@ singMatch :: Maybe DKind -- ^ the result kind, if known -> ADMatch -> SgM DMatch singMatch res_ki (ADMatch var_proms pat exp) = do - sPat <- singPat (Map.fromList var_proms) CaseStatement pat + sPat <- singPat (Map.fromList var_proms) pat sExp <- singExp exp res_ki return $ DMatch sPat sExp @@ -574,9 +667,15 @@ (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) +singLit (StringL str) = do + let sing_str_lit = DVarE singMethName `DSigE` + (singFamily `DAppT` DLitT (StrTyLit str)) + os_enabled <- qIsExtEnabled LangExt.OverloadedStrings + pure $ if os_enabled + then DVarE sFromStringName `DAppE` sing_str_lit + else sing_str_lit +singLit lit = + fail ("Only string and natural number literals can be singled: " ++ show lit) maybeSigT :: DType -> Maybe DKind -> DType maybeSigT ty Nothing = ty diff --git a/src/Data/Singletons/Single/Data.hs b/src/Data/Singletons/Single/Data.hs --- a/src/Data/Singletons/Single/Data.hs +++ b/src/Data/Singletons/Single/Data.hs @@ -16,7 +16,6 @@ import Data.Singletons.Single.Type import Data.Singletons.Single.Fixity import Data.Singletons.Promote.Type -import Data.Singletons.Single.Eq import Data.Singletons.Util import Data.Singletons.Names import Data.Singletons.Syntax @@ -25,12 +24,11 @@ -- 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 +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 + ctors' <- mapM singCtor ctors ctorFixities <- -- try to reify the fixity declarations for the constructors and then -- singletonize them. In case the reification fails, we default to an @@ -43,8 +41,10 @@ -- here, look for other invocations of 'singInfixDecl') singFixityDeclarations [ n | DCon _ _ n _ _ <- ctors ] -- instance for SingKind - fromSingClauses <- mapM mkFromSingClause ctors - toSingClauses <- mapM mkToSingClause ctors + fromSingClauses <- mapM mkFromSingClause ctors + emptyFromSingClause <- mkEmptyFromSingClause + toSingClauses <- mapM mkToSingClause ctors + emptyToSingClause <- mkEmptyToSingClause let singKindInst = DInstanceD Nothing (map (singKindConstraint . DVarT) tvbNames) @@ -53,13 +53,10 @@ [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 [] + , DLetDec $ DFunD fromSingName + (fromSingClauses `orIfEmpty` [emptyFromSingClause]) + , DLetDec $ DFunD toSingName + (toSingClauses `orIfEmpty` [emptyToSingClause]) ] -- e.g. type SNat = Sing :: Nat -> * let kindedSynInst = @@ -67,10 +64,9 @@ [] (singFamily `DSigT` (DArrowT `DAppT` k `DAppT` DStarT)) - return $ (DDataInstD Data [] singFamilyName [DSigT a k] ctors' []) : + return $ (DDataInstD Data [] singFamilyName [DSigT (DVarT aName) k] ctors' []) : kindedSynInst : singKindInst : - sEqInsts ++ ctorFixities where -- in the Rep case, the names of the constructors are in the wrong scope -- (they're types, not datacons), so we have to reinterpret them. @@ -96,9 +92,10 @@ svarNames <- mapM (const $ qNewName "c") types promoted <- mapM promoteType types cname' <- mkConName cname - let recursiveCalls = zipWith mkRecursiveCall varNames promoted + let varPats = zipWith mkToSingVarPat varNames promoted + recursiveCalls = zipWith mkRecursiveCall varNames promoted return $ - DClause [DConPa cname' (map DVarPa varNames)] + DClause [DConPa cname' varPats] (multiCase recursiveCalls (map (DConPa someSingDataName . listify . DVarPa) svarNames) @@ -106,21 +103,33 @@ (foldExp (DConE (singDataConName cname)) (map DVarE svarNames)))) + mkToSingVarPat :: Name -> DKind -> DPat + mkToSingVarPat varName ki = + DSigPa (DVarPa varName) (DAppT (DConT demoteName) ki) + mkRecursiveCall :: Name -> DKind -> DExp mkRecursiveCall var_name ki = DSigE (DAppE (DVarE toSingName) (DVarE var_name)) (DAppT (DConT someSingTypeName) ki) - emptyMethod :: Name -> [DClause] - emptyMethod n = [DClause [DVarPa n] (DCaseE (DVarE n) emptyMatches)] + mkEmptyFromSingClause :: SgM DClause + mkEmptyFromSingClause = do + x <- qNewName "x" + pure $ DClause [DVarPa x] + $ DCaseE (DVarE x) [] --- refine a constructor. the first parameter is the type variable that --- the singleton GADT is parameterized by -singCtor :: DType -> DCon -> SgM DCon + mkEmptyToSingClause :: SgM DClause + mkEmptyToSingClause = do + x <- qNewName "x" + pure $ DClause [DVarPa x] + $ DConE someSingDataName `DAppE` DCaseE (DVarE x) [] + +-- refine a constructor. +singCtor :: DCon -> SgM DCon -- polymorphic constructors are handled just -- like monomorphic ones -- the polymorphism in -- the kind is automatic -singCtor a (DCon _tvbs cxt name fields _rty) +singCtor (DCon _tvbs cxt name fields _rty) | not (null (filter (not . isEqPred) cxt)) = fail "Singling of constrained constructors not yet supported" | otherwise @@ -147,16 +156,16 @@ let noBang = Bang NoSourceUnpackedness NoSourceStrictness conFields = case fields of - DNormalC _ -> DNormalC $ map (noBang,) args + DNormalC dInfix _ -> DNormalC dInfix $ map (noBang,) args DRecC rec_fields -> DRecC [ (singValName field_name, noBang, arg) | (field_name, _, _) <- rec_fields | arg <- args ] return $ DCon tvbs - [mkEqPred a (foldType pCon indices)] + [] sName conFields - Nothing + (Just (DConT singFamilyName `DAppT` foldType pCon indices)) where buildArgType :: DType -> DType -> SgM DType buildArgType ty index = do (ty', _, _, _) <- singType index ty diff --git a/src/Data/Singletons/Single/Eq.hs b/src/Data/Singletons/Single/Eq.hs --- a/src/Data/Singletons/Single/Eq.hs +++ b/src/Data/Singletons/Single/Eq.hs @@ -10,43 +10,33 @@ import Language.Haskell.TH.Syntax import Language.Haskell.TH.Desugar +import Data.Singletons.Deriving.Infer import Data.Singletons.Util import Data.Singletons.Names import Control.Monad -- making the SEq instance and the SDecide instance are rather similar, -- so we generalize -type EqualityClassDesc q = ((DCon, DCon) -> q DClause, Name, Name) +type EqualityClassDesc q = ((DCon, DCon) -> q DClause, q DClause, Name, Name) sEqClassDesc, sDecideClassDesc :: Quasi q => EqualityClassDesc q -sEqClassDesc = (mkEqMethClause, sEqClassName, sEqMethName) -sDecideClassDesc = (mkDecideMethClause, sDecideClassName, sDecideMethName) +sEqClassDesc = (mkEqMethClause, mkEmptyEqMethClause, sEqClassName, sEqMethName) +sDecideClassDesc = (mkDecideMethClause, mkEmptyDecideMethClause, sDecideClassName, sDecideMethName) --- pass the *singleton* constructors, not the originals -mkEqualityInstance :: Quasi q => DKind -> [DCon] +mkEqualityInstance :: DsMonad q => Maybe DCxt -> DKind + -> [DCon] -- ^ The /original/ constructors (for inferring the instance context) + -> [DCon] -- ^ The /singletons/ constructors -> 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 +mkEqualityInstance mb_ctxt k ctors sctors (mkMeth, mkEmpty, className, methName) = do + let sctorPairs = [ (sc1, sc2) | sc1 <- sctors, sc2 <- sctors ] + methClauses <- if null sctors + then (:[]) <$> mkEmpty + else mapM mkMeth sctorPairs + constraints <- inferConstraintsDef mb_ctxt (DConPr className) k ctors return $ DInstanceD Nothing - (map (DAppPr (DConPr className)) (getKindVars k)) + constraints (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 @@ -73,6 +63,11 @@ (lname, lNumArgs) = extractNameArgs c1 (rname, rNumArgs) = extractNameArgs c2 +mkEmptyEqMethClause :: Applicative q => q DClause +mkEmptyEqMethClause = + pure $ DClause [DWildPa, DWildPa] + $ DConE strueName + mkDecideMethClause :: Quasi q => (DCon, DCon) -> q DClause mkDecideMethClause (c1, c2) | lname == rname = @@ -112,8 +107,14 @@ return $ DClause [DConPa lname (replicate lNumArgs DWildPa), DConPa rname (replicate rNumArgs DWildPa)] - (DAppE (DConE disprovedName) (DLamE [x] (DCaseE (DVarE x) emptyMatches))) + (DAppE (DConE disprovedName) (DLamE [x] (DCaseE (DVarE x) []))) where (lname, lNumArgs) = extractNameArgs c1 (rname, rNumArgs) = extractNameArgs c2 + +mkEmptyDecideMethClause :: Quasi q => q DClause +mkEmptyDecideMethClause = do + x <- qNewName "x" + pure $ DClause [DVarPa x, DWildPa] + $ DConE provedName `DAppE` DCaseE (DVarE x) [] diff --git a/src/Data/Singletons/Single/Fixity.hs b/src/Data/Singletons/Single/Fixity.hs --- a/src/Data/Singletons/Single/Fixity.hs +++ b/src/Data/Singletons/Single/Fixity.hs @@ -2,26 +2,29 @@ import Prelude hiding ( exp ) import Language.Haskell.TH hiding ( cxt ) -import Language.Haskell.TH.Syntax (Quasi(..)) +import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..)) import Data.Singletons.Util import Data.Singletons.Names import Language.Haskell.TH.Desugar -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) +singInfixDecl :: DsMonad q => Fixity -> Name -> q DLetDec +singInfixDecl fixity name = do + mb_ns <- reifyNameSpace name + pure $ DInfixD fixity + $ case mb_ns of + Just TcClsName -> singTyConName name + Just DataName -> singDataConName name + Just VarName -> singValName name + -- If we can't find the Name for some odd reason, + -- fall back to singValName + Nothing -> singValName name singFixityDeclaration :: DsMonad q => Name -> q [DDec] singFixityDeclaration name = do mFixity <- qReifyFixity name - return $ case mFixity of - Nothing -> [] - Just fixity -> [DLetDec $ singInfixDecl fixity name] + case mFixity of + Nothing -> pure [] + Just fixity -> sequenceA [DLetDec <$> singInfixDecl fixity name] singFixityDeclarations :: DsMonad q => [Name] -> q [DDec] singFixityDeclarations = concatMapM trySingFixityDeclaration diff --git a/src/Data/Singletons/Single/Monad.hs b/src/Data/Singletons/Single/Monad.hs --- a/src/Data/Singletons/Single/Monad.hs +++ b/src/Data/Singletons/Single/Monad.hs @@ -23,7 +23,7 @@ import Data.Singletons.Promote.Monad ( emitDecs, emitDecsM ) import Data.Singletons.Names import Data.Singletons.Util -import Data.Singletons +import Data.Singletons.Internal import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar import Control.Monad.Reader @@ -46,7 +46,7 @@ newtype SgM a = SgM (ReaderT SgEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad , MonadReader SgEnv, MonadWriter [DDec] - , MonadFail ) + , MonadFail, MonadIO ) liftSgM :: Q a -> SgM a liftSgM = SgM . lift . lift @@ -73,6 +73,7 @@ qIsExtEnabled = liftSgM `comp1` qIsExtEnabled qExtsEnabled = liftSgM qExtsEnabled qAddForeignFile = liftSgM `comp2` qAddForeignFile + qAddCorePlugin = liftSgM `comp1` qAddCorePlugin qRecover (SgM handler) (SgM body) = do env <- ask diff --git a/src/Data/Singletons/SuppressUnusedWarnings.hs b/src/Data/Singletons/SuppressUnusedWarnings.hs --- a/src/Data/Singletons/SuppressUnusedWarnings.hs +++ b/src/Data/Singletons/SuppressUnusedWarnings.hs @@ -1,4 +1,4 @@ --- Data/Singletons/Hidden.hs +-- Data/Singletons/SuppressUnusedWarnings.hs -- -- (c) Richard Eisenberg 2014 -- rae@cs.brynmawr.edu @@ -7,14 +7,12 @@ -- from the user. Why would anyone ever want this? Because what is below -- is dirty, and no one wants to see it. -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE AllowAmbiguousTypes, 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 -> () + suppressUnusedWarnings :: () diff --git a/src/Data/Singletons/Syntax.hs b/src/Data/Singletons/Syntax.hs --- a/src/Data/Singletons/Syntax.hs +++ b/src/Data/Singletons/Syntax.hs @@ -8,16 +8,17 @@ -} {-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, DeriveDataTypeable, - StandaloneDeriving, FlexibleInstances #-} + StandaloneDeriving, FlexibleInstances, ConstraintKinds #-} module Data.Singletons.Syntax where import Prelude hiding ( exp ) -import Data.Monoid -import Language.Haskell.TH.Syntax +import Data.Kind +import Language.Haskell.TH.Syntax hiding (Type) import Language.Haskell.TH.Desugar import Data.Map.Strict ( Map ) import qualified Data.Map.Strict as Map +import Data.Semigroup (Semigroup(..)) type VarPromotions = [(Name, Name)] -- from term-level name to type-level name @@ -72,9 +73,9 @@ 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 +type family IfAnn (ann :: AnnotationFlag) (yes :: k) (no :: k) :: k where + IfAnn Annotated yes no = yes + IfAnn Unannotated yes no = no data family LetDecRHS (ann :: AnnotationFlag) data instance LetDecRHS Annotated @@ -99,10 +100,13 @@ type ALetDecEnv = LetDecEnv Annotated type ULetDecEnv = LetDecEnv Unannotated +instance Semigroup ULetDecEnv where + LetDecEnv defns1 types1 infx1 _ <> LetDecEnv defns2 types2 infx2 _ = + LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () + instance Monoid ULetDecEnv where mempty = LetDecEnv Map.empty Map.empty [] () - mappend (LetDecEnv defns1 types1 infx1 _) (LetDecEnv defns2 types2 infx2 _) = - LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () + mappend = (<>) valueBinding :: Name -> ULetDecRHS -> ULetDecEnv valueBinding n v = emptyLetDecEnv { lde_defns = Map.singleton n v } @@ -132,3 +136,46 @@ go acc (DInfixD f n : rest) = go (infixDecl f n <> acc) rest go acc (DPragmaD{} : rest) = go acc rest + +-- See Note [DerivedDecl] +data DerivedDecl (cls :: Type -> Constraint) = DerivedDecl + { ded_mb_cxt :: Maybe DCxt + , ded_type :: DType + , ded_cons :: [DCon] + } + +type DerivedEqDecl = DerivedDecl Eq +type DerivedShowDecl = DerivedDecl Show + +{- Note [DerivedDecl] +~~~~~~~~~~~~~~~~~~~~~ +Most derived instances are wholly handled in +Data.Singletons.Partition.partitionDecs. There are two notable exceptions to +this rule, however: + +* Eq instances (which are handled entirely outside of partitionDecs) +* Show instances (which are partially handled outside of partitionDecs) + +For these instances, we use a DerivedDecl data type to encode just enough +information to recreate the derived instance: + +1. Just the instance context, if it's standalone-derived, or Nothing if it's in + a deriving clause (ded_mb_cxt) +2. The datatype, applied to some number of type arguments, as in the + instance declaration (ded_type) +3. The datatype's constructors (ded_cons) + +Why are these instances handled outside of partitionDecs? + +* Deriving Eq in singletons not only derives PEq/SEq instances, but it also + derives SDecide instances. This additional complication makes Eq difficult + to integrate with the other deriving machinery, so we handle it specially + in Data.Singletons.Promote and Data.Singletons.Single (depending on the task + at hand). +* Deriving Show in singletons not only derives PShow/SShow instances, but it + also derives ShowSing/Sing instances for singletons types. To make this work, + we let partitionDecs handle the PShow/SShow instances, but we also stick the + relevant info into a DerivedDecl value for later use in + Data.Singletons.Single, where we additionally generate ShowSing/Show + instances. +-} diff --git a/src/Data/Singletons/TH.hs b/src/Data/Singletons/TH.hs --- a/src/Data/Singletons/TH.hs +++ b/src/Data/Singletons/TH.hs @@ -39,25 +39,38 @@ promoteEnumInstances, promoteEnumInstance, singEnumInstances, singEnumInstance, + -- ** Functions to generate 'Show' instances + promoteShowInstances, promoteShowInstance, + singShowInstances, singShowInstance, + -- ** Utility functions cases, sCases, -- * Basic singleton definitions - Sing(SFalse, STrue, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7), + Sing(SFalse, STrue, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, + SLT, SEQ, SGT), module Data.Singletons, -- * Auxiliary definitions -- | These definitions might be mentioned in code generated by Template Haskell, -- so they must be in scope. - PEq(..), If, sIf, (:&&), SEq(..), + PEq(..), If, sIf, type (&&), (%&&), SEq(..), POrd(..), SOrd(..), ThenCmp, sThenCmp, Foldl, sFoldl, - Any, SDecide(..), (:~:)(..), Void, Refuted, Decision(..), + PBounded(..), SBounded(..), + PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum), + PShow(..), SShow(..), + ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace, + ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace, + (:.), (%.), SomeSing(..), - Error, ErrorSym0, + Error, sError, ErrorSym0, ErrorSym1, + Undefined, sUndefined, UndefinedSym0, TrueSym0, FalseSym0, + type (==@#@$), type (==@#@$$), type (==@#@$$$), + type (>@#@$), type (>@#@$$), type (>@#@$$$), LTSym0, EQSym0, GTSym0, Tuple0Sym0, Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, @@ -66,7 +79,18 @@ Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, - CompareSym0, ThenCmpSym0, FoldlSym0, + CompareSym0, CompareSym1, CompareSym2, + ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, + FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, + MinBoundSym0, MaxBoundSym0, + ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, + ShowStringSym0, ShowStringSym1, ShowStringSym2, + ShowParenSym0, ShowParenSym1, ShowParenSym2, + ShowSpaceSym0, ShowSpaceSym1, + ShowCharSym0, ShowCharSym1, ShowCharSym2, + ShowCommaSpaceSym0, ShowCommaSpaceSym1, + type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), + (:@#@$), (:@#@$$), (:@#@$$$), SuppressUnusedWarnings(..) @@ -75,17 +99,19 @@ import Data.Singletons import Data.Singletons.Single import Data.Singletons.Promote +import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Bool +import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Show import Data.Singletons.Decide import Data.Singletons.TypeLits import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.Names import Language.Haskell.TH.Desugar -import GHC.Exts import Language.Haskell.TH import Data.Singletons.Util import Control.Arrow ( first ) diff --git a/src/Data/Singletons/TypeLits.hs b/src/Data/Singletons/TypeLits.hs --- a/src/Data/Singletons/TypeLits.hs +++ b/src/Data/Singletons/TypeLits.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, ConstraintKinds, - GADTs, TypeFamilies #-} + GADTs, TypeFamilies, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -14,24 +14,52 @@ -- ---------------------------------------------------------------------------- -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.TypeLits ( Nat, Symbol, Sing(SNat, SSym), SNat, SSymbol, withKnownNat, withKnownSymbol, - Error, ErrorSym0, ErrorSym1, sError, - KnownNat, KnownNatSym0, KnownNatSym1, natVal, - KnownSymbol, KnownSymbolSym0, KnownSymbolSym1, symbolVal, + Error, sError, + Undefined, sUndefined, + KnownNat, natVal, + KnownSymbol, symbolVal, - (:^), (:^$), (:^$$), (:^$$$) + type (^), (%^), + type (<>), (%<>), + + TN.Log2, sLog2, + Div, sDiv, Mod, sMod, DivMod, sDivMod, + Quot, sQuot, Rem, sRem, QuotRem, sQuotRem, + + -- * Defunctionalization symbols + ErrorSym0, ErrorSym1, UndefinedSym0, + KnownNatSym0, KnownNatSym1, + KnownSymbolSym0, KnownSymbolSym1, + type (^@#@$), type (^@#@$$), type (^@#@$$$), + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + Log2Sym0, Log2Sym1, + DivSym0, DivSym1, DivSym2, + ModSym0, ModSym1, ModSym2, + DivModSym0, DivModSym1, DivModSym2, + QuotSym0, QuotSym1, QuotSym2, + RemSym0, RemSym1, RemSym2, + QuotRemSym0, QuotRemSym1, QuotRemSym2 ) where +import Data.Singletons.Internal +import Data.Singletons.Prelude.Tuple +import Data.Singletons.Promote +import Data.Singletons.ShowSing () -- for ShowSing/Show instances import Data.Singletons.TypeLits.Internal -import Data.Singletons.Prelude.Num () -- for typelits instances -import Data.Singletons.Promote +import Data.String (IsString(..)) +import qualified GHC.TypeNats as TN +import GHC.TypeNats (Div, Mod, SomeNat(..)) +import Numeric.Natural (Natural) +import Unsafe.Coerce + -- | This bogus 'Num' instance is helpful for people who want to define -- functions over Nats that will only be used at the type level or -- as singletons. A correct SNum instance for Nat singletons exists. @@ -59,6 +87,8 @@ instance Ord Symbol where compare = no_term_level_syms +instance IsString Symbol where + fromString = no_term_level_syms no_term_level_nats :: a no_term_level_nats = error "The kind `Nat` may not be used at the term level." @@ -68,3 +98,96 @@ -- These are often useful in TypeLits-heavy code $(genDefunSymbols [''KnownNat, ''KnownSymbol]) + +------------------------------------------------------------ +-- Log2, Div, Mod, DivMod, and friends +------------------------------------------------------------ + +{- | Adapted from GHC's source code. + +Compute the logarithm of a number in the given base, rounded down to the +closest integer. -} +genLog2 :: Natural -> Natural +genLog2 x = exactLoop 0 x + where + exactLoop s i + | i == 1 = s + | i < 2 = s + | otherwise = + let s1 = s + 1 + in s1 `seq` case divMod i 2 of + (j,r) + | r == 0 -> exactLoop s1 j + | otherwise -> underLoop s1 j + + underLoop s i + | i < 2 = s + | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i 2) + + +sLog2 :: Sing x -> Sing (TN.Log2 x) +sLog2 sx = + let x = fromSing sx + in case x of + 0 -> error "log2 of 0" + _ -> case TN.someNatVal (genLog2 x) of + SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) +$(genDefunSymbols [''TN.Log2]) + +sDiv :: Sing x -> Sing y -> Sing (Div x y) +sDiv sx sy = + let x = fromSing sx + y = fromSing sy + res = TN.someNatVal (x `div` y) + in case res of + SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) +infixl 7 `sDiv` +$(genDefunSymbols [''Div]) + +sMod :: Sing x -> Sing y -> Sing (Mod x y) +sMod sx sy = + let x = fromSing sx + y = fromSing sy + res = TN.someNatVal (x `mod` y) + in case res of + SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) +infixl 7 `sMod` +$(genDefunSymbols [''Mod]) + +$(promoteOnly [d| + divMod :: Nat -> Nat -> (Nat, Nat) + divMod x y = (div x y, mod x y) + + quotRem :: Nat -> Nat -> (Nat, Nat) + quotRem = divMod + + quot :: Nat -> Nat -> Nat + quot = div + infixl 7 `quot` + + rem :: Nat -> Nat -> Nat + rem = mod + infixl 7 `rem` + |]) + +sDivMod :: Sing x -> Sing y -> Sing (DivMod x y) +sDivMod sx sy = + let x = fromSing sx + y = fromSing sy + (q,r) = x `divMod` y + qRes = TN.someNatVal q + rRes = TN.someNatVal r + in case (qRes, rRes) of + (SomeNat (_ :: Proxy q), SomeNat (_ :: Proxy r)) + -> unsafeCoerce (STuple2 (SNat :: Sing q) (SNat :: Sing r)) + +sQuotRem :: Sing x -> Sing y -> Sing (QuotRem x y) +sQuotRem = sDivMod + +sQuot :: Sing x -> Sing y -> Sing (Quot x y) +sQuot = sDiv +infixl 7 `sQuot` + +sRem :: Sing x -> Sing y -> Sing (Rem x y) +sRem = sMod +infixl 7 `sRem` diff --git a/src/Data/Singletons/TypeLits/Internal.hs b/src/Data/Singletons/TypeLits/Internal.hs --- a/src/Data/Singletons/TypeLits/Internal.hs +++ b/src/Data/Singletons/TypeLits/Internal.hs @@ -17,28 +17,38 @@ UndecidableInstances, ScopedTypeVariables, RankNTypes, GADTs, FlexibleContexts, TypeOperators, ConstraintKinds, TypeInType, TemplateHaskell, StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.TypeLits.Internal ( Sing(..), Nat, Symbol, SNat, SSymbol, withKnownNat, withKnownSymbol, - Error, ErrorSym0, ErrorSym1, sError, - KnownNat, natVal, KnownSymbol, symbolVal, + Error, sError, + Undefined, sUndefined, + KnownNat, TN.natVal, KnownSymbol, symbolVal, + type (^), (%^), + type (<>), (%<>), - (:^), (:^$), (:^$$), (:^$$$) + -- * Defunctionalization symbols + ErrorSym0, ErrorSym1, UndefinedSym0, + type (^@#@$), type (^@#@$$), type (^@#@$$$), + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) ) where import Data.Singletons.Promote -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord import Data.Singletons.Decide import Data.Singletons.Prelude.Bool import GHC.TypeLits as TL -import Data.Type.Equality +import qualified GHC.TypeNats as TN +import Data.Monoid ((<>)) +import qualified Data.Type.Equality as DTE +import Data.Type.Equality ((:~:)(..)) import Data.Proxy ( Proxy(..) ) +import Numeric.Natural (Natural) import Unsafe.Coerce import qualified Data.Text as T @@ -54,11 +64,10 @@ sing = SNat instance SingKind Nat where - type Demote 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" + type Demote Nat = Natural + fromSing (SNat :: Sing n) = TN.natVal (Proxy :: Proxy n) + toSing n = case TN.someNatVal n of + SomeNat (_ :: Proxy n) -> SomeSing (SNat :: Sing n) data instance Sing (n :: Symbol) = KnownSymbol n => SSym @@ -74,7 +83,7 @@ -- SDecide instances: instance SDecide Nat where (SNat :: Sing n) %~ (SNat :: Sing m) - | natVal (Proxy :: Proxy n) == natVal (Proxy :: Proxy m) + | TN.natVal (Proxy :: Proxy n) == TN.natVal (Proxy :: Proxy m) = Proved $ unsafeCoerce Refl | otherwise = Disproved (\_ -> error errStr) @@ -90,24 +99,24 @@ -- PEq instances instance PEq Nat where - type (a :: Nat) :== (b :: Nat) = a == b + type (a :: Nat) == (b :: Nat) = a DTE.== b instance PEq Symbol where - type (a :: Symbol) :== (b :: Symbol) = a == b + type (a :: Symbol) == (b :: Symbol) = a DTE.== b -- need SEq instances for TypeLits kinds instance SEq Nat where - a %:== b + a %== b | fromSing a == fromSing b = unsafeCoerce STrue | otherwise = unsafeCoerce SFalse instance SEq Symbol where - a %:== b + a %== b | fromSing a == fromSing b = unsafeCoerce STrue | otherwise = unsafeCoerce SFalse -- POrd instances instance POrd Nat where - type (a :: Nat) `Compare` (b :: Nat) = a `TL.CmpNat` b + type (a :: Nat) `Compare` (b :: Nat) = a `TN.CmpNat` b instance POrd Symbol where type (a :: Symbol) `Compare` (b :: Symbol) = a `TL.CmpSymbol` b @@ -145,39 +154,48 @@ -- | The promotion of 'error'. This version is more poly-kinded for -- easier use. -type family Error (str :: k0) :: k +type family Error (str :: k0) :: k where {} $(genDefunSymbols [''Error]) -- | The singleton for 'error' sError :: Sing (str :: Symbol) -> a sError sstr = error (T.unpack (fromSing sstr)) --- TODO: move this to a better home: -type a :^ b = a ^ b -infixr 8 :^ -$(genDefunSymbols [''(:^)]) +-- | The promotion of 'undefined'. +type family Undefined :: k where {} +$(genDefunSymbols [''Undefined]) ------------------------------------------------------------- --- TypeLits singleton non-singleton instances ------------------------------------------------------------- +-- | The singleton for 'undefined'. +sUndefined :: a +sUndefined = undefined --- Thanks to @cumber on #179 +-- | The singleton analogue of '(TL.^)' for 'Nat's. +(%^) :: Sing a -> Sing b -> Sing (a ^ b) +sa %^ sb = + let a = fromSing sa + b = fromSing sb + ex = TN.someNatVal (a ^ b) + in + case ex of + SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) +infixr 8 %^ -instance Show (SNat n) where - showsPrec p n@SNat - = showParen (p > atPrec) - ( showString "SNat @" - . showsPrec (atPrec + 1) (natVal n) - ) - where atPrec = 10 +-- Defunctionalization symbols for type-level (^) +$(genDefunSymbols [''(^)]) -instance Show (SSymbol s) where - showsPrec p s@SSym - = showParen (p > atPrec) - ( showString "SSym @" - . showsPrec (atPrec + 1) (symbolVal s) - ) - where atPrec = 10 +-- | The promoted analogue of '(<>)' for 'Symbol's. This uses the special +-- 'TL.AppendSymbol' type family from "GHC.TypeLits". +type a <> b = TL.AppendSymbol a b +infixr 6 <> -deriving instance Show (SomeSing Nat) -deriving instance Show (SomeSing Symbol) +-- | The singleton analogue of '(<>)' for 'Symbol's. +(%<>) :: Sing a -> Sing b -> Sing (a <> b) +sa %<> sb = + let a = fromSing sa + b = fromSing sb + ex = someSymbolVal $ T.unpack $ a <> b + in case ex of + SomeSymbol (_ :: Proxy ab) -> unsafeCoerce (SSym :: Sing ab) +infixr 6 %<> + +$(genDefunSymbols [''(<>)]) diff --git a/src/Data/Singletons/TypeRepStar.hs b/src/Data/Singletons/TypeRepStar.hs --- a/src/Data/Singletons/TypeRepStar.hs +++ b/src/Data/Singletons/TypeRepStar.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RankNTypes, TypeFamilies, KindSignatures, FlexibleInstances, GADTs, UndecidableInstances, ScopedTypeVariables, DataKinds, MagicHash, TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | @@ -12,75 +12,86 @@ -- Stability : experimental -- Portability : non-portable -- --- This module defines singleton instances making 'Typeable' the singleton for +-- This module defines singleton instances making 'TypeRep' the singleton for -- the kind @*@. The definitions don't fully line up with what is expected -- within the singletons library, so expect unusual results! -- ---------------------------------------------------------------------------- module Data.Singletons.TypeRepStar ( - Sing(STypeRep) + Sing(STypeRep), -- | Here is the definition of the singleton for @*@: -- - -- > data instance Sing (a :: *) where - -- > STypeRep :: Typeable a => Sing a + -- > newtype instance Sing :: Type -> Type where + -- > STypeRep :: TypeRep a -> Sing a -- -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and 'TestCoercion' are -- also supplied. + + SomeTypeRepStar(..) ) where import Data.Singletons.Prelude.Instances -import Data.Singletons +import Data.Singletons.Internal import Data.Singletons.Prelude.Eq -import Data.Typeable -import Unsafe.Coerce import Data.Singletons.Decide +import Data.Singletons.ShowSing +import Type.Reflection +import Type.Reflection.Unsafe +import Unsafe.Coerce import Data.Kind -import GHC.Exts ( Proxy# ) -import Data.Type.Coercion -import Data.Type.Equality +import Data.Type.Equality ((:~:)(..)) -data instance Sing (a :: *) where - STypeRep :: Typeable a => Sing a +newtype instance Sing :: Type -> Type where + STypeRep :: TypeRep a -> Sing a + deriving (Eq, Ord, Show) +-- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to +-- kind @*@. +data SomeTypeRepStar where + SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStar + +instance Eq SomeTypeRepStar where + SomeTypeRepStar a == SomeTypeRepStar b = + case eqTypeRep a b of + Just HRefl -> True + Nothing -> False + +instance Ord SomeTypeRepStar where + SomeTypeRepStar a `compare` SomeTypeRepStar b = + typeRepFingerprint a `compare` typeRepFingerprint b + +instance Show SomeTypeRepStar where + showsPrec p (SomeTypeRepStar ty) = showsPrec p ty + instance Typeable a => SingI (a :: *) where - sing = STypeRep + sing = STypeRep typeRep instance SingKind Type where - type Demote Type = TypeRep - fromSing (STypeRep :: Sing a) = typeOf (undefined :: a) - toSing = dirty_mk_STypeRep + type Demote Type = SomeTypeRepStar + fromSing (STypeRep tr) = SomeTypeRepStar tr + toSing (SomeTypeRepStar tr) = SomeSing $ STypeRep tr instance PEq Type where - type (a :: *) :== (b :: *) = a == b + type (a :: *) == (b :: *) = EqType a b +type family EqType (a :: Type) (b :: Type) where + EqType a a = 'True + EqType a b = 'False + instance SEq Type where - (STypeRep :: Sing a) %:== (STypeRep :: Sing b) = - case (eqT :: Maybe (a :~: b)) of - Just Refl -> STrue - Nothing -> unsafeCoerce SFalse + STypeRep tra %== STypeRep trb = + case eqTypeRep tra trb of + Just HRefl -> STrue + Nothing -> unsafeCoerce SFalse -- the Data.Typeable interface isn't strong enough -- to enable us to define this without unsafeCoerce instance SDecide Type where - (STypeRep :: 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! + STypeRep tra %~ STypeRep trb = + case eqTypeRep tra trb of + Just HRefl -> Proved Refl + Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed") -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 +instance ShowSing Type where + showsSingPrec = showsPrec diff --git a/src/Data/Singletons/Util.hs b/src/Data/Singletons/Util.hs --- a/src/Data/Singletons/Util.hs +++ b/src/Data/Singletons/Util.hs @@ -23,11 +23,12 @@ 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.List.NonEmpty (NonEmpty(..)) import Data.Map ( Map ) import Data.Foldable import Data.Traversable import Data.Generics +import Data.Void import Control.Monad.Fail ( MonadFail ) -- The list of types that singletons processes by default @@ -36,6 +37,7 @@ , ''[] , ''Either , ''NonEmpty + , ''Void ] ++ boundedBasicTypes boundedBasicTypes :: [Name] @@ -79,7 +81,7 @@ checkForRep (allNamesIn decls) tysOfConFields :: DConFields -> [DType] -tysOfConFields (DNormalC stys) = map snd stys +tysOfConFields (DNormalC _ stys) = map snd stys tysOfConFields (DRecC vstys) = map (\(_,_,ty) -> ty) vstys -- extract the name and number of arguments to a constructor @@ -93,11 +95,27 @@ extractName :: DCon -> Name extractName (DCon _ _ n _ _) = n --- is an identifier uppercase? +-- | is a valid Haskell infix data constructor (i.e., does it begin with a colon?) +isInfixDataCon :: String -> Bool +isInfixDataCon (':':_) = True +isInfixDataCon _ = False + +-- | Is an identifier a legal data constructor name in Haskell? That is, is its +-- first character an uppercase letter (prefix) or a colon (infix)? +isDataConName :: Name -> Bool +isDataConName n = let first = head (nameBase n) in isUpper first || first == ':' + +-- | Is an identifier uppercase? +-- +-- Note that this will always return 'False' for infix names, since the concept +-- of upper- and lower-case doesn't make sense for non-alphabetic characters. +-- If you want to check if a name is legal as a data constructor, use the +-- 'isDataConName' function. isUpcase :: Name -> Bool -isUpcase n = let first = head (nameBase n) in isUpper first || first == ':' +isUpcase n = let first = head (nameBase n) in isUpper first --- make an identifier uppercase +-- Make an identifier uppercase. If the identifier is infix, this acts as the +-- identity function. upcase :: Name -> Name upcase = mkName . toUpcaseStr noPrefix @@ -116,51 +134,34 @@ 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 - --- Ensures that the name is a suitable name for a data constructor -toDataConName :: Name -> Name -toDataConName n - | isUpcase n = n - | str@('$' : _) <- nameBase n = mkName (':' : str) - | otherwise = upcase n - + upcase_symb = 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) +-- Put an uppercase prefix on a constructor name. Takes two prefixes: +-- one for identifiers and one for symbols. +-- +-- This is different from 'prefixName' in that infix constructor names always +-- start with a colon, so we must insert the prefix after the colon in order +-- for the new name to be syntactically valid. +prefixConName :: String -> String -> Name -> Name +prefixConName pre tyPre n = case (nameBase n) of + (':' : rest) -> mkName (':' : tyPre ++ rest) alpha -> mkName (pre ++ alpha) --- put a lowercase prefix on a name. Takes two prefixes: one for identifiers --- and one for symbols -prefixLCName :: String -> String -> Name -> Name -prefixLCName pre tyPre n = +-- Put a prefix on a name. Takes two prefixes: one for identifiers +-- and one for symbols. +prefixName :: String -> String -> Name -> Name +prefixName pre tyPre n = let str = nameBase n first = head str in if isHsLetter first then mkName (pre ++ str) else mkName (tyPre ++ str) +-- Put a suffix on a name. Takes two suffixes: one for identifiers +-- and one for symbols. suffixName :: String -> String -> Name -> Name suffixName ident symb n = let str = nameBase n @@ -233,6 +234,14 @@ ravel [] res = res ravel (h:t) res = DAppT (DAppT DArrowT h) (ravel t res) +-- | Convert a 'DPred' to a 'DType'. +predToType :: DPred -> DType +predToType (DAppPr p t) = DAppT (predToType p) t +predToType (DSigPr p k) = DSigT (predToType p) k +predToType (DVarPr n) = DVarT n +predToType (DConPr n) = DConT n +predToType DWildCardPr = DWildCardT + -- count the number of arguments in a type countArgs :: DType -> Int countArgs ty = length args @@ -261,6 +270,8 @@ substKind :: Map Name DKind -> DKind -> DKind substKind = substType +-- | Non–capture-avoiding substitution. (If you want capture-avoiding +-- substitution, use @substTy@ from "Language.Haskell.TH.Desugar.Subst". substType :: Map Name DType -> DType -> DType substType subst ty | Map.null subst = ty substType subst (DForallT tvbs cxt inner_ty) @@ -318,6 +329,26 @@ foldType :: DType -> [DType] -> DType foldType = foldl DAppT +-- | Decompose an applied type into its individual components. For example, this: +-- +-- @ +-- Either Int Char +-- @ +-- +-- would be unfolded to this: +-- +-- @ +-- Either :| [Int, Char] +-- @ +unfoldType :: DType -> NonEmpty DType +unfoldType = go [] + where + go :: [DType] -> DType -> NonEmpty DType + go acc (DAppT t1 t2) = go (t2:acc) t1 + go acc (DSigT t _) = go acc t + go acc (DForallT _ _ t) = go acc t + go acc t = t :| acc + -- apply an expression to a list of expressions foldExp :: DExp -> [DExp] -> DExp foldExp = foldl DAppE @@ -333,10 +364,6 @@ 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 @@ -353,7 +380,7 @@ newtype QWithAux m q a = QWA { runQWA :: WriterT m q a } deriving ( Functor, Applicative, Monad, MonadTrans , MonadWriter m, MonadReader r - , MonadFail ) + , MonadFail, MonadIO ) -- make a Quasi instance for easy lifting instance (Quasi q, Monoid m) => Quasi (QWithAux m q) where @@ -378,6 +405,7 @@ qIsExtEnabled = lift `comp1` qIsExtEnabled qExtsEnabled = lift qExtsEnabled qAddForeignFile = lift `comp2` qAddForeignFile + qAddCorePlugin = lift `comp1` qAddCorePlugin qRecover exp handler = do (result, aux) <- lift $ qRecover (evalForPair exp) (evalForPair handler) @@ -414,6 +442,18 @@ -- in a computation with an auxiliar list, add an element to the list addElement :: Quasi q => elt -> QWithAux [elt] q () addElement elt = tell [elt] + +-- | Call 'lookupTypeNameWithLocals' first to ensure we have a 'Name' in the +-- type namespace, then call 'dsReify'. + +-- See also Note [Using dsReifyTypeNameInfo when promoting instances] +-- in Data.Singletons.Promote. +dsReifyTypeNameInfo :: DsMonad q => Name -> q (Maybe DInfo) +dsReifyTypeNameInfo ty_name = do + mb_name <- lookupTypeNameWithLocals (nameBase ty_name) + case mb_name of + Just n -> dsReify n + Nothing -> pure Nothing -- lift concatMap into a monad -- could this be more efficient? diff --git a/tests/SingletonsTestSuite.hs b/tests/SingletonsTestSuite.hs --- a/tests/SingletonsTestSuite.hs +++ b/tests/SingletonsTestSuite.hs @@ -63,11 +63,27 @@ , compileAndDumpStdTest "T145" , compileAndDumpStdTest "PolyKinds" , compileAndDumpStdTest "PolyKindsApp" + , compileAndDumpStdTest "T163" , compileAndDumpStdTest "T166" , compileAndDumpStdTest "T172" , compileAndDumpStdTest "T175" , compileAndDumpStdTest "T176" , compileAndDumpStdTest "T178" + , compileAndDumpStdTest "T187" + , compileAndDumpStdTest "T190" + , compileAndDumpStdTest "ShowDeriving" + , compileAndDumpStdTest "EmptyShowDeriving" + , compileAndDumpStdTest "StandaloneDeriving" + , compileAndDumpStdTest "T197" + , compileAndDumpStdTest "T197b" + , compileAndDumpStdTest "T200" + , compileAndDumpStdTest "T206" + , compileAndDumpStdTest "T209" + , compileAndDumpStdTest "T226" + , compileAndDumpStdTest "T229" + , compileAndDumpStdTest "T249" + , compileAndDumpStdTest "OverloadedStrings" + , compileAndDumpStdTest "T271" ], testCompileAndDumpGroup "Promote" [ compileAndDumpStdTest "Constructors" diff --git a/tests/SingletonsTestSuiteUtils.hs b/tests/SingletonsTestSuiteUtils.hs --- a/tests/SingletonsTestSuiteUtils.hs +++ b/tests/SingletonsTestSuiteUtils.hs @@ -14,18 +14,14 @@ import System.Exit ( ExitCode(..) ) import System.FilePath ( takeBaseName, pathSeparator ) import System.IO ( IOMode(..), hGetContents, openFile ) +import System.IO.Unsafe ( unsafePerformIO ) import System.Process ( CreateProcess(..), StdStream(..) , createProcess, proc, waitForProcess - , readProcess, callCommand ) + , callCommand ) import System.Directory ( doesFileExist ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.Golden ( goldenVsFileDiff ) -import Distribution.Package ( PackageIdentifier(..) ) -import Distribution.Text ( simpleParse ) -import Distribution.Version ( mkVersion ) -import System.IO.Unsafe ( unsafePerformIO ) - #ifndef CURRENT_PACKAGE_KEY #include "../dist/build/autogen/cabal_macros.h" #endif @@ -51,37 +47,23 @@ includePath = "../../dist/build" ghcVersion :: String -ghcVersion = ".ghc82" +ghcVersion = ".ghc84" --- 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. +-- If a cabal sandbox is present, use its package database instead of the global one. 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 = mkVersion [2,2,1] - mtlOpt | ver >= firstModernVersion = ["-DMODERN_MTL"] - | otherwise = [] - return $ ghcPackageDbOpts ++ mtlOpt - + sandboxed <- doesFileExist "cabal.sandbox.config" + if sandboxed + then do + let prefix = "package-db: " + opts_from_config config = + case find (prefix `isPrefixOf`) $ lines config of + Nothing -> [] + Just db_line -> let package_db = drop (length prefix) db_line in + [ "-no-user-package-db" + , "-package-db " ++ package_db ] + opts_from_config `liftM` readFile "cabal.sandbox.config" + else return [] -- GHC options used when running the tests ghcOpts :: [String] @@ -116,6 +98,9 @@ , "-XDefaultSignatures" , "-XCPP" , "-XTypeInType" + , "-XStandaloneDeriving" + , "-XTypeApplications" + , "-XEmptyCase" ] -- Note [-this-unit-id hack] diff --git a/tests/compile-and-dump/GradingClient/Database.ghc82.template b/tests/compile-and-dump/GradingClient/Database.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/GradingClient/Database.ghc82.template +++ /dev/null @@ -1,4784 +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_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (:==) a b - Equals_0123456789876543210 (a :: Nat) (b :: Nat) = FalseSym0 - instance PEq Nat where - type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789876543210 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. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 Zero (Succ _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (Succ _z_0123456789876543210) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Nat where - type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789876543210Sym0 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 Demote 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 (t1 :: Nat) (t2 :: Nat). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering - -> Type) - -> Type) t1 :: TyFun Nat Ordering - -> Type) t2 :: Ordering) - sCompare SZero SZero - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - instance 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_0123456789876543210 (a :: U) (b :: U) :: Bool where - Equals_0123456789876543210 BOOL BOOL = TrueSym0 - Equals_0123456789876543210 STRING STRING = TrueSym0 - Equals_0123456789876543210 NAT NAT = TrueSym0 - Equals_0123456789876543210 (VEC a a) (VEC b b) = (:&&) ((:==) a b) ((:==) a b) - Equals_0123456789876543210 (a :: U) (b :: U) = FalseSym0 - instance PEq U where - type (:==) (a :: U) (b :: U) = Equals_0123456789876543210 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. SameKind (Apply (VECSym1 l) arg) (VECSym2 l arg) => - VECSym1KindInference - type instance Apply (VECSym1 l) l = VEC l l - instance SuppressUnusedWarnings VECSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) VECSym0KindInference) GHC.Tuple.()) - data VECSym0 (l :: TyFun U (TyFun Nat U -> Type)) - = forall arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => - VECSym0KindInference - type instance Apply VECSym0 l = VECSym1 l - type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where - Equals_0123456789876543210 CA CA = TrueSym0 - Equals_0123456789876543210 CB CB = TrueSym0 - Equals_0123456789876543210 CC CC = TrueSym0 - Equals_0123456789876543210 CD CD = TrueSym0 - Equals_0123456789876543210 CE CE = TrueSym0 - Equals_0123456789876543210 CF CF = TrueSym0 - Equals_0123456789876543210 CG CG = TrueSym0 - Equals_0123456789876543210 CH CH = TrueSym0 - Equals_0123456789876543210 CI CI = TrueSym0 - Equals_0123456789876543210 CJ CJ = TrueSym0 - Equals_0123456789876543210 CK CK = TrueSym0 - Equals_0123456789876543210 CL CL = TrueSym0 - Equals_0123456789876543210 CM CM = TrueSym0 - Equals_0123456789876543210 CN CN = TrueSym0 - Equals_0123456789876543210 CO CO = TrueSym0 - Equals_0123456789876543210 CP CP = TrueSym0 - Equals_0123456789876543210 CQ CQ = TrueSym0 - Equals_0123456789876543210 CR CR = TrueSym0 - Equals_0123456789876543210 CS CS = TrueSym0 - Equals_0123456789876543210 CT CT = TrueSym0 - Equals_0123456789876543210 CU CU = TrueSym0 - Equals_0123456789876543210 CV CV = TrueSym0 - Equals_0123456789876543210 CW CW = TrueSym0 - Equals_0123456789876543210 CX CX = TrueSym0 - Equals_0123456789876543210 CY CY = TrueSym0 - Equals_0123456789876543210 CZ CZ = TrueSym0 - Equals_0123456789876543210 (a :: AChar) (b :: AChar) = FalseSym0 - instance PEq AChar where - type (:==) (a :: AChar) (b :: AChar) = Equals_0123456789876543210 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. SameKind (Apply (AttrSym1 l) arg) (AttrSym2 l arg) => - AttrSym1KindInference - type instance Apply (AttrSym1 l) l = Attr l l - instance SuppressUnusedWarnings AttrSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) AttrSym0KindInference) GHC.Tuple.()) - data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type)) - = forall arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => - AttrSym0KindInference - type instance Apply AttrSym0 l = AttrSym1 l - type SchSym1 (t :: [Attribute]) = Sch t - instance SuppressUnusedWarnings SchSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SchSym0KindInference) GHC.Tuple.()) - data SchSym0 (l :: TyFun [Attribute] Schema) - = forall arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => - SchSym0KindInference - type instance Apply SchSym0 l = Sch l - type Let0123456789876543210Scrutinee_0123456789876543210Sym4 t t t t = - Let0123456789876543210Scrutinee_0123456789876543210 t t t t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 l l l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l - type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where - Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (:==$) name) name' - type family Case_0123456789876543210 name name' u attrs t where - Case_0123456789876543210 name name' u attrs True = u - Case_0123456789876543210 name name' u attrs False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) - type LookupSym2 (t :: [AChar]) (t :: Schema) = Lookup t t - instance SuppressUnusedWarnings LookupSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LookupSym1KindInference) GHC.Tuple.()) - data LookupSym1 (l :: [AChar]) (l :: TyFun Schema U) - = forall arg. SameKind (Apply (LookupSym1 l) arg) (LookupSym2 l arg) => - LookupSym1KindInference - type instance Apply (LookupSym1 l) l = Lookup l l - instance SuppressUnusedWarnings LookupSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LookupSym0KindInference) GHC.Tuple.()) - data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type)) - = forall arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => - LookupSym0KindInference - type instance Apply LookupSym0 l = LookupSym1 l - type OccursSym2 (t :: [AChar]) (t :: Schema) = Occurs t t - instance SuppressUnusedWarnings OccursSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) OccursSym1KindInference) GHC.Tuple.()) - data OccursSym1 (l :: [AChar]) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (OccursSym1 l) arg) (OccursSym2 l arg) => - OccursSym1KindInference - type instance Apply (OccursSym1 l) l = Occurs l l - instance SuppressUnusedWarnings OccursSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) OccursSym0KindInference) GHC.Tuple.()) - data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type)) - = forall arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => - OccursSym0KindInference - type instance Apply OccursSym0 l = OccursSym1 l - type AttrNotInSym2 (t :: Attribute) (t :: Schema) = AttrNotIn t t - instance SuppressUnusedWarnings AttrNotInSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) AttrNotInSym1KindInference) GHC.Tuple.()) - data AttrNotInSym1 (l :: Attribute) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (AttrNotInSym1 l) arg) (AttrNotInSym2 l arg) => - AttrNotInSym1KindInference - type instance Apply (AttrNotInSym1 l) l = AttrNotIn l l - instance SuppressUnusedWarnings AttrNotInSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) AttrNotInSym0KindInference) GHC.Tuple.()) - data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool - -> Type)) - = forall arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => - AttrNotInSym0KindInference - type instance Apply AttrNotInSym0 l = AttrNotInSym1 l - type DisjointSym2 (t :: Schema) (t :: Schema) = Disjoint t t - instance SuppressUnusedWarnings DisjointSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DisjointSym1KindInference) GHC.Tuple.()) - data DisjointSym1 (l :: Schema) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (DisjointSym1 l) arg) (DisjointSym2 l arg) => - DisjointSym1KindInference - type instance Apply (DisjointSym1 l) l = Disjoint l l - instance SuppressUnusedWarnings DisjointSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DisjointSym0KindInference) GHC.Tuple.()) - data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type)) - = forall arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => - DisjointSym0KindInference - type instance Apply DisjointSym0 l = DisjointSym1 l - type AppendSym2 (t :: Schema) (t :: Schema) = Append t t - instance SuppressUnusedWarnings AppendSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) AppendSym1KindInference) GHC.Tuple.()) - data AppendSym1 (l :: Schema) (l :: TyFun Schema Schema) - = forall arg. SameKind (Apply (AppendSym1 l) arg) (AppendSym2 l arg) => - AppendSym1KindInference - type instance Apply (AppendSym1 l) l = Append l l - instance SuppressUnusedWarnings AppendSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) AppendSym0KindInference) GHC.Tuple.()) - data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type)) - = forall arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => - AppendSym0KindInference - type instance Apply AppendSym0 l = AppendSym1 l - type family Lookup (a :: [AChar]) (a :: Schema) :: U where - Lookup _z_0123456789876543210 (Sch '[]) = Any - Lookup name (Sch ((:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) - type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where - Occurs _z_0123456789876543210 (Sch '[]) = FalseSym0 - Occurs name (Sch ((:) (Attr name' _z_0123456789876543210) 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_0123456789876543210 (Sch '[]) = TrueSym0 - AttrNotIn (Attr name u) (Sch ((:) (Attr name' _z_0123456789876543210) 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_0123456789876543210 = 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 _ (SSch SNil) = undefined - sLookup - (sName :: Sing name) - (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u)) - (sAttrs :: Sing attrs))) - = let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) - sScrutinee_0123456789876543210 - = (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sName)) - sName' - in case sScrutinee_0123456789876543210 of - STrue -> sU - SFalse - -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName)) - ((applySing ((singFun1 @SchSym0) SSch)) sAttrs) :: - Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U) - sOccurs _ (SSch SNil) = SFalse - sOccurs - (sName :: Sing name) - (SSch (SCons (SAttr (sName' :: Sing name') _) - (sAttrs :: Sing attrs))) - = (applySing - ((applySing ((singFun2 @(:||$)) (%:||))) - ((applySing ((applySing ((singFun2 @(:==$)) (%:==))) sName)) - sName'))) - ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) - ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) - sAttrNotIn _ (SSch SNil) = STrue - sAttrNotIn - (SAttr (sName :: Sing name) (sU :: Sing u)) - (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) - = (applySing - ((applySing ((singFun2 @(:&&$)) (%:&&))) - ((applySing ((applySing ((singFun2 @(:/=$)) (%:/=))) sName)) - sName'))) - ((applySing - ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) - ((applySing ((singFun1 @SchSym0) SSch)) sT)) - sDisjoint (SSch SNil) _ = STrue - sDisjoint - (SSch (SCons (sH :: Sing h) (sT :: Sing t))) - (sS :: Sing s) - = (applySing - ((applySing ((singFun2 @(:&&$)) (%:&&))) - ((applySing - ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH)) - sS))) - ((applySing - ((applySing ((singFun2 @DisjointSym0) sDisjoint)) - ((applySing ((singFun1 @SchSym0) SSch)) sT))) - sS) - sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing ((applySing ((singFun2 @(:++$)) (%:++))) sS1)) sS2) - data instance Sing (z :: U) - = 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 Demote U = U - fromSing SBOOL = BOOL - fromSing SSTRING = STRING - fromSing SNAT = NAT - fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b) - toSing BOOL = SomeSing SBOOL - toSing STRING = SomeSing SSTRING - toSing NAT = SomeSing SNAT - toSing (VEC b 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 Demote AChar = AChar - fromSing SCA = CA - fromSing SCB = CB - fromSing SCC = CC - fromSing SCD = CD - fromSing SCE = CE - fromSing SCF = CF - fromSing SCG = CG - fromSing SCH = CH - fromSing SCI = CI - fromSing SCJ = CJ - fromSing SCK = CK - fromSing SCL = CL - fromSing SCM = CM - fromSing SCN = CN - fromSing SCO = CO - fromSing SCP = CP - fromSing SCQ = CQ - fromSing SCR = CR - fromSing SCS = CS - fromSing SCT = CT - fromSing SCU = CU - fromSing SCV = CV - fromSing SCW = CW - fromSing SCX = CX - fromSing SCY = CY - fromSing SCZ = CZ - toSing CA = SomeSing SCA - toSing CB = SomeSing SCB - toSing CC = SomeSing SCC - toSing CD = SomeSing SCD - toSing CE = SomeSing SCE - toSing CF = SomeSing SCF - toSing CG = SomeSing SCG - toSing CH = SomeSing SCH - toSing CI = SomeSing SCI - toSing CJ = SomeSing SCJ - toSing CK = SomeSing SCK - toSing CL = SomeSing SCL - toSing CM = SomeSing SCM - toSing CN = SomeSing SCN - toSing CO = SomeSing SCO - toSing CP = SomeSing SCP - toSing CQ = SomeSing SCQ - toSing CR = SomeSing SCR - toSing CS = SomeSing SCS - toSing CT = SomeSing SCT - toSing CU = SomeSing SCU - toSing CV = SomeSing SCV - toSing CW = SomeSing SCW - toSing CX = SomeSing SCX - toSing CY = SomeSing SCY - toSing CZ = SomeSing SCZ - 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 Demote 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 Demote 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 diff --git a/tests/compile-and-dump/GradingClient/Database.ghc84.template b/tests/compile-and-dump/GradingClient/Database.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Database.ghc84.template @@ -0,0 +1,2563 @@ +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = Succ l + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: Nat) + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering + -> Type) + -> Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch []) = True + attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) + = (name /= name') && (attrNotIn (Attr name u) (Sch t)) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch []) _ = True + disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch []) = False + occurs name (Sch ((Attr name' _) : attrs)) + = name == name' || occurs name (Sch attrs) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch []) = undefined + lookup name (Sch ((Attr name' u) : attrs)) + = if name == name' then u else lookup name (Sch attrs) + + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] |] + ======> + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] + append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch GHC.Types.[]) = True + attrNotIn (Attr name u) (Sch (Attr name' _ GHC.Types.: t)) + = ((name /= name') && ((attrNotIn ((Attr name) u)) (Sch t))) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch GHC.Types.[]) _ = True + disjoint (Sch (h GHC.Types.: t)) s + = (((attrNotIn h) s) && ((disjoint (Sch t)) s)) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch GHC.Types.[]) = False + occurs name (Sch (Attr name' _ GHC.Types.: attrs)) + = ((name == name') || ((occurs name) (Sch attrs))) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch GHC.Types.[]) = undefined + lookup name (Sch (Attr name' u GHC.Types.: attrs)) + = if (name == name') then u else (lookup name) (Sch attrs) + type BOOLSym0 = BOOL + type STRINGSym0 = STRING + type NATSym0 = NAT + type VECSym2 (t :: U) (t :: Nat) = VEC t t + instance SuppressUnusedWarnings VECSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) VECSym1KindInference) GHC.Tuple.()) + data VECSym1 (l :: U) (l :: TyFun Nat U) + = forall arg. SameKind (Apply (VECSym1 l) arg) (VECSym2 l arg) => + VECSym1KindInference + type instance Apply (VECSym1 l) l = VEC l l + instance SuppressUnusedWarnings VECSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) VECSym0KindInference) GHC.Tuple.()) + data VECSym0 (l :: TyFun U (TyFun Nat U -> Type)) + = forall arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => + VECSym0KindInference + type instance Apply VECSym0 l = VECSym1 l + type CASym0 = CA + type CBSym0 = CB + type CCSym0 = CC + type CDSym0 = CD + type CESym0 = CE + type CFSym0 = CF + type CGSym0 = CG + type CHSym0 = CH + type CISym0 = CI + type CJSym0 = CJ + type CKSym0 = CK + type CLSym0 = CL + type CMSym0 = CM + type CNSym0 = CN + type COSym0 = CO + type CPSym0 = CP + type CQSym0 = CQ + type CRSym0 = CR + type CSSym0 = CS + type CTSym0 = CT + type CUSym0 = CU + type CVSym0 = CV + type CWSym0 = CW + type CXSym0 = CX + type CYSym0 = CY + type CZSym0 = CZ + type AttrSym2 (t :: [AChar]) (t :: U) = Attr t t + instance SuppressUnusedWarnings AttrSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AttrSym1KindInference) GHC.Tuple.()) + data AttrSym1 (l :: [AChar]) (l :: TyFun U Attribute) + = forall arg. SameKind (Apply (AttrSym1 l) arg) (AttrSym2 l arg) => + AttrSym1KindInference + type instance Apply (AttrSym1 l) l = Attr l l + instance SuppressUnusedWarnings AttrSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AttrSym0KindInference) GHC.Tuple.()) + data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type)) + = forall arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => + AttrSym0KindInference + type instance Apply AttrSym0 l = AttrSym1 l + type SchSym1 (t :: [Attribute]) = Sch t + instance SuppressUnusedWarnings SchSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SchSym0KindInference) GHC.Tuple.()) + data SchSym0 (l :: TyFun [Attribute] Schema) + = forall arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => + SchSym0KindInference + type instance Apply SchSym0 l = Sch l + type Let0123456789876543210Scrutinee_0123456789876543210Sym4 t t t t = + Let0123456789876543210Scrutinee_0123456789876543210 t t t t + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 l l l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l + type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where + Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name' + type family Case_0123456789876543210 name name' u attrs t where + Case_0123456789876543210 name name' u attrs True = u + Case_0123456789876543210 name name' u attrs False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) + type LookupSym2 (t :: [AChar]) (t :: Schema) = Lookup t t + instance SuppressUnusedWarnings LookupSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LookupSym1KindInference) GHC.Tuple.()) + data LookupSym1 (l :: [AChar]) (l :: TyFun Schema U) + = forall arg. SameKind (Apply (LookupSym1 l) arg) (LookupSym2 l arg) => + LookupSym1KindInference + type instance Apply (LookupSym1 l) l = Lookup l l + instance SuppressUnusedWarnings LookupSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LookupSym0KindInference) GHC.Tuple.()) + data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type)) + = forall arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => + LookupSym0KindInference + type instance Apply LookupSym0 l = LookupSym1 l + type OccursSym2 (t :: [AChar]) (t :: Schema) = Occurs t t + instance SuppressUnusedWarnings OccursSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) OccursSym1KindInference) GHC.Tuple.()) + data OccursSym1 (l :: [AChar]) (l :: TyFun Schema Bool) + = forall arg. SameKind (Apply (OccursSym1 l) arg) (OccursSym2 l arg) => + OccursSym1KindInference + type instance Apply (OccursSym1 l) l = Occurs l l + instance SuppressUnusedWarnings OccursSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) OccursSym0KindInference) GHC.Tuple.()) + data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type)) + = forall arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => + OccursSym0KindInference + type instance Apply OccursSym0 l = OccursSym1 l + type AttrNotInSym2 (t :: Attribute) (t :: Schema) = AttrNotIn t t + instance SuppressUnusedWarnings AttrNotInSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AttrNotInSym1KindInference) GHC.Tuple.()) + data AttrNotInSym1 (l :: Attribute) (l :: TyFun Schema Bool) + = forall arg. SameKind (Apply (AttrNotInSym1 l) arg) (AttrNotInSym2 l arg) => + AttrNotInSym1KindInference + type instance Apply (AttrNotInSym1 l) l = AttrNotIn l l + instance SuppressUnusedWarnings AttrNotInSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AttrNotInSym0KindInference) GHC.Tuple.()) + data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool + -> Type)) + = forall arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => + AttrNotInSym0KindInference + type instance Apply AttrNotInSym0 l = AttrNotInSym1 l + type DisjointSym2 (t :: Schema) (t :: Schema) = Disjoint t t + instance SuppressUnusedWarnings DisjointSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DisjointSym1KindInference) GHC.Tuple.()) + data DisjointSym1 (l :: Schema) (l :: TyFun Schema Bool) + = forall arg. SameKind (Apply (DisjointSym1 l) arg) (DisjointSym2 l arg) => + DisjointSym1KindInference + type instance Apply (DisjointSym1 l) l = Disjoint l l + instance SuppressUnusedWarnings DisjointSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DisjointSym0KindInference) GHC.Tuple.()) + data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type)) + = forall arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => + DisjointSym0KindInference + type instance Apply DisjointSym0 l = DisjointSym1 l + type AppendSym2 (t :: Schema) (t :: Schema) = Append t t + instance SuppressUnusedWarnings AppendSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AppendSym1KindInference) GHC.Tuple.()) + data AppendSym1 (l :: Schema) (l :: TyFun Schema Schema) + = forall arg. SameKind (Apply (AppendSym1 l) arg) (AppendSym2 l arg) => + AppendSym1KindInference + type instance Apply (AppendSym1 l) l = Append l l + instance SuppressUnusedWarnings AppendSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) AppendSym0KindInference) GHC.Tuple.()) + data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type)) + = forall arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => + AppendSym0KindInference + type instance Apply AppendSym0 l = AppendSym1 l + type family Lookup (a :: [AChar]) (a :: Schema) :: U where + Lookup _ (Sch '[]) = UndefinedSym0 + Lookup name (Sch ((:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) + type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where + Occurs _ (Sch '[]) = FalseSym0 + Occurs name (Sch ((:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) + type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where + AttrNotIn _ (Sch '[]) = TrueSym0 + AttrNotIn (Attr name u) (Sch ((:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) + type family Disjoint (a :: Schema) (a :: Schema) :: Bool where + Disjoint (Sch '[]) _ = TrueSym0 + Disjoint (Sch ((:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) + type family Append (a :: Schema) (a :: Schema) :: Schema where + Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ BOOL a_0123456789876543210 = Apply (Apply ShowStringSym0 "BOOL") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: U) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: U) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun U (TyFun Symbol Symbol + -> Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun U (TyFun Symbol Symbol + -> Type) + -> Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow U where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ CA a_0123456789876543210 = Apply (Apply ShowStringSym0 "CA") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CB a_0123456789876543210 = Apply (Apply ShowStringSym0 "CB") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CC a_0123456789876543210 = Apply (Apply ShowStringSym0 "CC") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CD a_0123456789876543210 = Apply (Apply ShowStringSym0 "CD") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CE a_0123456789876543210 = Apply (Apply ShowStringSym0 "CE") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CF a_0123456789876543210 = Apply (Apply ShowStringSym0 "CF") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CG a_0123456789876543210 = Apply (Apply ShowStringSym0 "CG") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CH a_0123456789876543210 = Apply (Apply ShowStringSym0 "CH") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CI a_0123456789876543210 = Apply (Apply ShowStringSym0 "CI") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CJ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CJ") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CK a_0123456789876543210 = Apply (Apply ShowStringSym0 "CK") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CL a_0123456789876543210 = Apply (Apply ShowStringSym0 "CL") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CM a_0123456789876543210 = Apply (Apply ShowStringSym0 "CM") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CN a_0123456789876543210 = Apply (Apply ShowStringSym0 "CN") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CO a_0123456789876543210 = Apply (Apply ShowStringSym0 "CO") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CP a_0123456789876543210 = Apply (Apply ShowStringSym0 "CP") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CQ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CQ") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CR a_0123456789876543210 = Apply (Apply ShowStringSym0 "CR") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CS a_0123456789876543210 = Apply (Apply ShowStringSym0 "CS") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CT a_0123456789876543210 = Apply (Apply ShowStringSym0 "CT") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CU a_0123456789876543210 = Apply (Apply ShowStringSym0 "CU") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CV a_0123456789876543210 = Apply (Apply ShowStringSym0 "CV") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CW a_0123456789876543210 = Apply (Apply ShowStringSym0 "CW") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: AChar) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: AChar) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun AChar (TyFun Symbol Symbol + -> Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun AChar (TyFun Symbol Symbol + -> Type) + -> Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow AChar where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where + Equals_0123456789876543210 BOOL BOOL = TrueSym0 + Equals_0123456789876543210 STRING STRING = TrueSym0 + Equals_0123456789876543210 NAT NAT = TrueSym0 + Equals_0123456789876543210 (VEC a a) (VEC b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: U) (_ :: U) = FalseSym0 + instance PEq U where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where + Equals_0123456789876543210 CA CA = TrueSym0 + Equals_0123456789876543210 CB CB = TrueSym0 + Equals_0123456789876543210 CC CC = TrueSym0 + Equals_0123456789876543210 CD CD = TrueSym0 + Equals_0123456789876543210 CE CE = TrueSym0 + Equals_0123456789876543210 CF CF = TrueSym0 + Equals_0123456789876543210 CG CG = TrueSym0 + Equals_0123456789876543210 CH CH = TrueSym0 + Equals_0123456789876543210 CI CI = TrueSym0 + Equals_0123456789876543210 CJ CJ = TrueSym0 + Equals_0123456789876543210 CK CK = TrueSym0 + Equals_0123456789876543210 CL CL = TrueSym0 + Equals_0123456789876543210 CM CM = TrueSym0 + Equals_0123456789876543210 CN CN = TrueSym0 + Equals_0123456789876543210 CO CO = TrueSym0 + Equals_0123456789876543210 CP CP = TrueSym0 + Equals_0123456789876543210 CQ CQ = TrueSym0 + Equals_0123456789876543210 CR CR = TrueSym0 + Equals_0123456789876543210 CS CS = TrueSym0 + Equals_0123456789876543210 CT CT = TrueSym0 + Equals_0123456789876543210 CU CU = TrueSym0 + Equals_0123456789876543210 CV CV = TrueSym0 + Equals_0123456789876543210 CW CW = TrueSym0 + Equals_0123456789876543210 CX CX = TrueSym0 + Equals_0123456789876543210 CY CY = TrueSym0 + Equals_0123456789876543210 CZ CZ = TrueSym0 + Equals_0123456789876543210 (_ :: AChar) (_ :: AChar) = FalseSym0 + instance PEq AChar where + type (==) a b = Equals_0123456789876543210 a b + sLookup :: + forall (t :: [AChar]) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) + sOccurs :: + forall (t :: [AChar]) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) + sAttrNotIn :: + forall (t :: Attribute) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) + sDisjoint :: + forall (t :: Schema) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) + sAppend :: + forall (t :: Schema) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) + sLookup _ (SSch SNil) = sUndefined + sLookup + (sName :: Sing name) + (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u)) + (sAttrs :: Sing attrs))) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) + sName' + in case sScrutinee_0123456789876543210 of + STrue -> sU + SFalse + -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName)) + ((applySing ((singFun1 @SchSym0) SSch)) sAttrs) :: + Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U) + sOccurs _ (SSch SNil) = SFalse + sOccurs + (sName :: Sing name) + (SSch (SCons (SAttr (sName' :: Sing name') _) + (sAttrs :: Sing attrs))) + = (applySing + ((applySing ((singFun2 @(||@#@$)) (%||))) + ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) + sName'))) + ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) + ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) + sAttrNotIn _ (SSch SNil) = STrue + sAttrNotIn + (SAttr (sName :: Sing name) (sU :: Sing u)) + (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) + = (applySing + ((applySing ((singFun2 @(&&@#@$)) (%&&))) + ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) + sName'))) + ((applySing + ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) + ((applySing ((singFun1 @SchSym0) SSch)) sT)) + sDisjoint (SSch SNil) _ = STrue + sDisjoint + (SSch (SCons (sH :: Sing h) (sT :: Sing t))) + (sS :: Sing s) + = (applySing + ((applySing ((singFun2 @(&&@#@$)) (%&&))) + ((applySing + ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH)) + sS))) + ((applySing + ((applySing ((singFun2 @DisjointSym0) sDisjoint)) + ((applySing ((singFun1 @SchSym0) SSch)) sT))) + sS) + sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2) + data instance Sing (z :: U) + where + SBOOL :: Sing BOOL + SSTRING :: Sing STRING + SNAT :: Sing NAT + SVEC :: forall (n :: U) (n :: Nat). + (Sing (n :: U)) -> (Sing (n :: Nat)) -> Sing (VEC n n) + type SU = (Sing :: U -> Type) + instance SingKind U where + type Demote U = U + fromSing SBOOL = BOOL + fromSing SSTRING = STRING + fromSing SNAT = NAT + fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b) + toSing BOOL = SomeSing SBOOL + toSing STRING = SomeSing SSTRING + toSing NAT = SomeSing SNAT + toSing (VEC (b :: Demote U) (b :: Demote Nat)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) } + data instance Sing (z :: AChar) + where + SCA :: Sing CA + SCB :: Sing CB + SCC :: Sing CC + SCD :: Sing CD + SCE :: Sing CE + SCF :: Sing CF + SCG :: Sing CG + SCH :: Sing CH + SCI :: Sing CI + SCJ :: Sing CJ + SCK :: Sing CK + SCL :: Sing CL + SCM :: Sing CM + SCN :: Sing CN + SCO :: Sing CO + SCP :: Sing CP + SCQ :: Sing CQ + SCR :: Sing CR + SCS :: Sing CS + SCT :: Sing CT + SCU :: Sing CU + SCV :: Sing CV + SCW :: Sing CW + SCX :: Sing CX + SCY :: Sing CY + SCZ :: Sing CZ + type SAChar = (Sing :: AChar -> Type) + instance SingKind AChar where + type Demote AChar = AChar + fromSing SCA = CA + fromSing SCB = CB + fromSing SCC = CC + fromSing SCD = CD + fromSing SCE = CE + fromSing SCF = CF + fromSing SCG = CG + fromSing SCH = CH + fromSing SCI = CI + fromSing SCJ = CJ + fromSing SCK = CK + fromSing SCL = CL + fromSing SCM = CM + fromSing SCN = CN + fromSing SCO = CO + fromSing SCP = CP + fromSing SCQ = CQ + fromSing SCR = CR + fromSing SCS = CS + fromSing SCT = CT + fromSing SCU = CU + fromSing SCV = CV + fromSing SCW = CW + fromSing SCX = CX + fromSing SCY = CY + fromSing SCZ = CZ + toSing CA = SomeSing SCA + toSing CB = SomeSing SCB + toSing CC = SomeSing SCC + toSing CD = SomeSing SCD + toSing CE = SomeSing SCE + toSing CF = SomeSing SCF + toSing CG = SomeSing SCG + toSing CH = SomeSing SCH + toSing CI = SomeSing SCI + toSing CJ = SomeSing SCJ + toSing CK = SomeSing SCK + toSing CL = SomeSing SCL + toSing CM = SomeSing SCM + toSing CN = SomeSing SCN + toSing CO = SomeSing SCO + toSing CP = SomeSing SCP + toSing CQ = SomeSing SCQ + toSing CR = SomeSing SCR + toSing CS = SomeSing SCS + toSing CT = SomeSing SCT + toSing CU = SomeSing SCU + toSing CV = SomeSing SCV + toSing CW = SomeSing SCW + toSing CX = SomeSing SCX + toSing CY = SomeSing SCY + toSing CZ = SomeSing SCZ + data instance Sing (z :: Attribute) + where + SAttr :: forall (n :: [AChar]) (n :: U). + (Sing (n :: [AChar])) -> (Sing (n :: U)) -> Sing (Attr n n) + type SAttribute = (Sing :: Attribute -> Type) + instance SingKind Attribute where + type Demote Attribute = Attribute + fromSing (SAttr b b) = (Attr (fromSing b)) (fromSing b) + toSing (Attr (b :: Demote [AChar]) (b :: Demote U)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing [AChar])) + (toSing b :: SomeSing U) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) } + data instance Sing (z :: Schema) + where + SSch :: forall (n :: [Attribute]). + (Sing (n :: [Attribute])) -> Sing (Sch n) + type SSchema = (Sing :: Schema -> Type) + instance SingKind Schema where + type Demote Schema = Schema + fromSing (SSch b) = Sch (fromSing b) + toSing (Sch (b :: Demote [Attribute])) + = case toSing b :: SomeSing [Attribute] of { + SomeSing c -> SomeSing (SSch c) } + instance (SShow U, SShow Nat) => SShow U where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: U) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun U (TyFun Symbol Symbol + -> Type) + -> Type) + -> Type) t1) t2) t3) + sShowsPrec + _ + SBOOL + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "BOOL"))) + sA_0123456789876543210 + sShowsPrec + _ + SSTRING + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "STRING"))) + sA_0123456789876543210 + sShowsPrec + _ + SNAT + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "NAT"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SVEC (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "VEC ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance SShow AChar where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: AChar) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun AChar (TyFun Symbol Symbol + -> Type) + -> Type) + -> Type) t1) t2) t3) + sShowsPrec + _ + SCA + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CA"))) + sA_0123456789876543210 + sShowsPrec + _ + SCB + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CB"))) + sA_0123456789876543210 + sShowsPrec + _ + SCC + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CC"))) + sA_0123456789876543210 + sShowsPrec + _ + SCD + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CD"))) + sA_0123456789876543210 + sShowsPrec + _ + SCE + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CE"))) + sA_0123456789876543210 + sShowsPrec + _ + SCF + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CF"))) + sA_0123456789876543210 + sShowsPrec + _ + SCG + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CG"))) + sA_0123456789876543210 + sShowsPrec + _ + SCH + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CH"))) + sA_0123456789876543210 + sShowsPrec + _ + SCI + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CI"))) + sA_0123456789876543210 + sShowsPrec + _ + SCJ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CJ"))) + sA_0123456789876543210 + sShowsPrec + _ + SCK + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CK"))) + sA_0123456789876543210 + sShowsPrec + _ + SCL + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CL"))) + sA_0123456789876543210 + sShowsPrec + _ + SCM + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CM"))) + sA_0123456789876543210 + sShowsPrec + _ + SCN + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CN"))) + sA_0123456789876543210 + sShowsPrec + _ + SCO + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CO"))) + sA_0123456789876543210 + sShowsPrec + _ + SCP + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CP"))) + sA_0123456789876543210 + sShowsPrec + _ + SCQ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CQ"))) + sA_0123456789876543210 + sShowsPrec + _ + SCR + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CR"))) + sA_0123456789876543210 + sShowsPrec + _ + SCS + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CS"))) + sA_0123456789876543210 + sShowsPrec + _ + SCT + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CT"))) + sA_0123456789876543210 + sShowsPrec + _ + SCU + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CU"))) + sA_0123456789876543210 + sShowsPrec + _ + SCV + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CV"))) + sA_0123456789876543210 + sShowsPrec + _ + SCW + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CW"))) + sA_0123456789876543210 + sShowsPrec + _ + SCX + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CX"))) + sA_0123456789876543210 + sShowsPrec + _ + SCY + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CY"))) + sA_0123456789876543210 + sShowsPrec + _ + SCZ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CZ"))) + sA_0123456789876543210 + instance (SEq U, SEq Nat) => SEq U where + (%==) SBOOL SBOOL = STrue + (%==) SBOOL SSTRING = SFalse + (%==) SBOOL SNAT = SFalse + (%==) SBOOL (SVEC _ _) = SFalse + (%==) SSTRING SBOOL = SFalse + (%==) SSTRING SSTRING = STrue + (%==) SSTRING SNAT = SFalse + (%==) SSTRING (SVEC _ _) = SFalse + (%==) SNAT SBOOL = SFalse + (%==) SNAT SSTRING = SFalse + (%==) SNAT SNAT = STrue + (%==) SNAT (SVEC _ _) = SFalse + (%==) (SVEC _ _) SBOOL = SFalse + (%==) (SVEC _ _) SSTRING = SFalse + (%==) (SVEC _ _) SNAT = SFalse + (%==) (SVEC a a) (SVEC b b) = ((%&&) (((%==) a) b)) (((%==) a) b) + instance (SDecide U, SDecide Nat) => SDecide U where + (%~) SBOOL SBOOL = Proved Refl + (%~) SBOOL SSTRING = Disproved (\ x -> case x of) + (%~) SBOOL SNAT = Disproved (\ x -> case x of) + (%~) SBOOL (SVEC _ _) = Disproved (\ x -> case x of) + (%~) SSTRING SBOOL = Disproved (\ x -> case x of) + (%~) SSTRING SSTRING = Proved Refl + (%~) SSTRING SNAT = Disproved (\ x -> case x of) + (%~) SSTRING (SVEC _ _) = Disproved (\ x -> case x of) + (%~) SNAT SBOOL = Disproved (\ x -> case x of) + (%~) SNAT SSTRING = Disproved (\ x -> case x of) + (%~) SNAT SNAT = Proved Refl + (%~) SNAT (SVEC _ _) = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SBOOL = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SSTRING = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SNAT = Disproved (\ x -> case x of) + (%~) (SVEC a a) (SVEC b b) + = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of + GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl + GHC.Tuple.(,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq AChar where + (%==) SCA SCA = STrue + (%==) SCA SCB = SFalse + (%==) SCA SCC = SFalse + (%==) SCA SCD = SFalse + (%==) SCA SCE = SFalse + (%==) SCA SCF = SFalse + (%==) SCA SCG = SFalse + (%==) SCA SCH = SFalse + (%==) SCA SCI = SFalse + (%==) SCA SCJ = SFalse + (%==) SCA SCK = SFalse + (%==) SCA SCL = SFalse + (%==) SCA SCM = SFalse + (%==) SCA SCN = SFalse + (%==) SCA SCO = SFalse + (%==) SCA SCP = SFalse + (%==) SCA SCQ = SFalse + (%==) SCA SCR = SFalse + (%==) SCA SCS = SFalse + (%==) SCA SCT = SFalse + (%==) SCA SCU = SFalse + (%==) SCA SCV = SFalse + (%==) SCA SCW = SFalse + (%==) SCA SCX = SFalse + (%==) SCA SCY = SFalse + (%==) SCA SCZ = SFalse + (%==) SCB SCA = SFalse + (%==) SCB SCB = STrue + (%==) SCB SCC = SFalse + (%==) SCB SCD = SFalse + (%==) SCB SCE = SFalse + (%==) SCB SCF = SFalse + (%==) SCB SCG = SFalse + (%==) SCB SCH = SFalse + (%==) SCB SCI = SFalse + (%==) SCB SCJ = SFalse + (%==) SCB SCK = SFalse + (%==) SCB SCL = SFalse + (%==) SCB SCM = SFalse + (%==) SCB SCN = SFalse + (%==) SCB SCO = SFalse + (%==) SCB SCP = SFalse + (%==) SCB SCQ = SFalse + (%==) SCB SCR = SFalse + (%==) SCB SCS = SFalse + (%==) SCB SCT = SFalse + (%==) SCB SCU = SFalse + (%==) SCB SCV = SFalse + (%==) SCB SCW = SFalse + (%==) SCB SCX = SFalse + (%==) SCB SCY = SFalse + (%==) SCB SCZ = SFalse + (%==) SCC SCA = SFalse + (%==) SCC SCB = SFalse + (%==) SCC SCC = STrue + (%==) SCC SCD = SFalse + (%==) SCC SCE = SFalse + (%==) SCC SCF = SFalse + (%==) SCC SCG = SFalse + (%==) SCC SCH = SFalse + (%==) SCC SCI = SFalse + (%==) SCC SCJ = SFalse + (%==) SCC SCK = SFalse + (%==) SCC SCL = SFalse + (%==) SCC SCM = SFalse + (%==) SCC SCN = SFalse + (%==) SCC SCO = SFalse + (%==) SCC SCP = SFalse + (%==) SCC SCQ = SFalse + (%==) SCC SCR = SFalse + (%==) SCC SCS = SFalse + (%==) SCC SCT = SFalse + (%==) SCC SCU = SFalse + (%==) SCC SCV = SFalse + (%==) SCC SCW = SFalse + (%==) SCC SCX = SFalse + (%==) SCC SCY = SFalse + (%==) SCC SCZ = SFalse + (%==) SCD SCA = SFalse + (%==) SCD SCB = SFalse + (%==) SCD SCC = SFalse + (%==) SCD SCD = STrue + (%==) SCD SCE = SFalse + (%==) SCD SCF = SFalse + (%==) SCD SCG = SFalse + (%==) SCD SCH = SFalse + (%==) SCD SCI = SFalse + (%==) SCD SCJ = SFalse + (%==) SCD SCK = SFalse + (%==) SCD SCL = SFalse + (%==) SCD SCM = SFalse + (%==) SCD SCN = SFalse + (%==) SCD SCO = SFalse + (%==) SCD SCP = SFalse + (%==) SCD SCQ = SFalse + (%==) SCD SCR = SFalse + (%==) SCD SCS = SFalse + (%==) SCD SCT = SFalse + (%==) SCD SCU = SFalse + (%==) SCD SCV = SFalse + (%==) SCD SCW = SFalse + (%==) SCD SCX = SFalse + (%==) SCD SCY = SFalse + (%==) SCD SCZ = SFalse + (%==) SCE SCA = SFalse + (%==) SCE SCB = SFalse + (%==) SCE SCC = SFalse + (%==) SCE SCD = SFalse + (%==) SCE SCE = STrue + (%==) SCE SCF = SFalse + (%==) SCE SCG = SFalse + (%==) SCE SCH = SFalse + (%==) SCE SCI = SFalse + (%==) SCE SCJ = SFalse + (%==) SCE SCK = SFalse + (%==) SCE SCL = SFalse + (%==) SCE SCM = SFalse + (%==) SCE SCN = SFalse + (%==) SCE SCO = SFalse + (%==) SCE SCP = SFalse + (%==) SCE SCQ = SFalse + (%==) SCE SCR = SFalse + (%==) SCE SCS = SFalse + (%==) SCE SCT = SFalse + (%==) SCE SCU = SFalse + (%==) SCE SCV = SFalse + (%==) SCE SCW = SFalse + (%==) SCE SCX = SFalse + (%==) SCE SCY = SFalse + (%==) SCE SCZ = SFalse + (%==) SCF SCA = SFalse + (%==) SCF SCB = SFalse + (%==) SCF SCC = SFalse + (%==) SCF SCD = SFalse + (%==) SCF SCE = SFalse + (%==) SCF SCF = STrue + (%==) SCF SCG = SFalse + (%==) SCF SCH = SFalse + (%==) SCF SCI = SFalse + (%==) SCF SCJ = SFalse + (%==) SCF SCK = SFalse + (%==) SCF SCL = SFalse + (%==) SCF SCM = SFalse + (%==) SCF SCN = SFalse + (%==) SCF SCO = SFalse + (%==) SCF SCP = SFalse + (%==) SCF SCQ = SFalse + (%==) SCF SCR = SFalse + (%==) SCF SCS = SFalse + (%==) SCF SCT = SFalse + (%==) SCF SCU = SFalse + (%==) SCF SCV = SFalse + (%==) SCF SCW = SFalse + (%==) SCF SCX = SFalse + (%==) SCF SCY = SFalse + (%==) SCF SCZ = SFalse + (%==) SCG SCA = SFalse + (%==) SCG SCB = SFalse + (%==) SCG SCC = SFalse + (%==) SCG SCD = SFalse + (%==) SCG SCE = SFalse + (%==) SCG SCF = SFalse + (%==) SCG SCG = STrue + (%==) SCG SCH = SFalse + (%==) SCG SCI = SFalse + (%==) SCG SCJ = SFalse + (%==) SCG SCK = SFalse + (%==) SCG SCL = SFalse + (%==) SCG SCM = SFalse + (%==) SCG SCN = SFalse + (%==) SCG SCO = SFalse + (%==) SCG SCP = SFalse + (%==) SCG SCQ = SFalse + (%==) SCG SCR = SFalse + (%==) SCG SCS = SFalse + (%==) SCG SCT = SFalse + (%==) SCG SCU = SFalse + (%==) SCG SCV = SFalse + (%==) SCG SCW = SFalse + (%==) SCG SCX = SFalse + (%==) SCG SCY = SFalse + (%==) SCG SCZ = SFalse + (%==) SCH SCA = SFalse + (%==) SCH SCB = SFalse + (%==) SCH SCC = SFalse + (%==) SCH SCD = SFalse + (%==) SCH SCE = SFalse + (%==) SCH SCF = SFalse + (%==) SCH SCG = SFalse + (%==) SCH SCH = STrue + (%==) SCH SCI = SFalse + (%==) SCH SCJ = SFalse + (%==) SCH SCK = SFalse + (%==) SCH SCL = SFalse + (%==) SCH SCM = SFalse + (%==) SCH SCN = SFalse + (%==) SCH SCO = SFalse + (%==) SCH SCP = SFalse + (%==) SCH SCQ = SFalse + (%==) SCH SCR = SFalse + (%==) SCH SCS = SFalse + (%==) SCH SCT = SFalse + (%==) SCH SCU = SFalse + (%==) SCH SCV = SFalse + (%==) SCH SCW = SFalse + (%==) SCH SCX = SFalse + (%==) SCH SCY = SFalse + (%==) SCH SCZ = SFalse + (%==) SCI SCA = SFalse + (%==) SCI SCB = SFalse + (%==) SCI SCC = SFalse + (%==) SCI SCD = SFalse + (%==) SCI SCE = SFalse + (%==) SCI SCF = SFalse + (%==) SCI SCG = SFalse + (%==) SCI SCH = SFalse + (%==) SCI SCI = STrue + (%==) SCI SCJ = SFalse + (%==) SCI SCK = SFalse + (%==) SCI SCL = SFalse + (%==) SCI SCM = SFalse + (%==) SCI SCN = SFalse + (%==) SCI SCO = SFalse + (%==) SCI SCP = SFalse + (%==) SCI SCQ = SFalse + (%==) SCI SCR = SFalse + (%==) SCI SCS = SFalse + (%==) SCI SCT = SFalse + (%==) SCI SCU = SFalse + (%==) SCI SCV = SFalse + (%==) SCI SCW = SFalse + (%==) SCI SCX = SFalse + (%==) SCI SCY = SFalse + (%==) SCI SCZ = SFalse + (%==) SCJ SCA = SFalse + (%==) SCJ SCB = SFalse + (%==) SCJ SCC = SFalse + (%==) SCJ SCD = SFalse + (%==) SCJ SCE = SFalse + (%==) SCJ SCF = SFalse + (%==) SCJ SCG = SFalse + (%==) SCJ SCH = SFalse + (%==) SCJ SCI = SFalse + (%==) SCJ SCJ = STrue + (%==) SCJ SCK = SFalse + (%==) SCJ SCL = SFalse + (%==) SCJ SCM = SFalse + (%==) SCJ SCN = SFalse + (%==) SCJ SCO = SFalse + (%==) SCJ SCP = SFalse + (%==) SCJ SCQ = SFalse + (%==) SCJ SCR = SFalse + (%==) SCJ SCS = SFalse + (%==) SCJ SCT = SFalse + (%==) SCJ SCU = SFalse + (%==) SCJ SCV = SFalse + (%==) SCJ SCW = SFalse + (%==) SCJ SCX = SFalse + (%==) SCJ SCY = SFalse + (%==) SCJ SCZ = SFalse + (%==) SCK SCA = SFalse + (%==) SCK SCB = SFalse + (%==) SCK SCC = SFalse + (%==) SCK SCD = SFalse + (%==) SCK SCE = SFalse + (%==) SCK SCF = SFalse + (%==) SCK SCG = SFalse + (%==) SCK SCH = SFalse + (%==) SCK SCI = SFalse + (%==) SCK SCJ = SFalse + (%==) SCK SCK = STrue + (%==) SCK SCL = SFalse + (%==) SCK SCM = SFalse + (%==) SCK SCN = SFalse + (%==) SCK SCO = SFalse + (%==) SCK SCP = SFalse + (%==) SCK SCQ = SFalse + (%==) SCK SCR = SFalse + (%==) SCK SCS = SFalse + (%==) SCK SCT = SFalse + (%==) SCK SCU = SFalse + (%==) SCK SCV = SFalse + (%==) SCK SCW = SFalse + (%==) SCK SCX = SFalse + (%==) SCK SCY = SFalse + (%==) SCK SCZ = SFalse + (%==) SCL SCA = SFalse + (%==) SCL SCB = SFalse + (%==) SCL SCC = SFalse + (%==) SCL SCD = SFalse + (%==) SCL SCE = SFalse + (%==) SCL SCF = SFalse + (%==) SCL SCG = SFalse + (%==) SCL SCH = SFalse + (%==) SCL SCI = SFalse + (%==) SCL SCJ = SFalse + (%==) SCL SCK = SFalse + (%==) SCL SCL = STrue + (%==) SCL SCM = SFalse + (%==) SCL SCN = SFalse + (%==) SCL SCO = SFalse + (%==) SCL SCP = SFalse + (%==) SCL SCQ = SFalse + (%==) SCL SCR = SFalse + (%==) SCL SCS = SFalse + (%==) SCL SCT = SFalse + (%==) SCL SCU = SFalse + (%==) SCL SCV = SFalse + (%==) SCL SCW = SFalse + (%==) SCL SCX = SFalse + (%==) SCL SCY = SFalse + (%==) SCL SCZ = SFalse + (%==) SCM SCA = SFalse + (%==) SCM SCB = SFalse + (%==) SCM SCC = SFalse + (%==) SCM SCD = SFalse + (%==) SCM SCE = SFalse + (%==) SCM SCF = SFalse + (%==) SCM SCG = SFalse + (%==) SCM SCH = SFalse + (%==) SCM SCI = SFalse + (%==) SCM SCJ = SFalse + (%==) SCM SCK = SFalse + (%==) SCM SCL = SFalse + (%==) SCM SCM = STrue + (%==) SCM SCN = SFalse + (%==) SCM SCO = SFalse + (%==) SCM SCP = SFalse + (%==) SCM SCQ = SFalse + (%==) SCM SCR = SFalse + (%==) SCM SCS = SFalse + (%==) SCM SCT = SFalse + (%==) SCM SCU = SFalse + (%==) SCM SCV = SFalse + (%==) SCM SCW = SFalse + (%==) SCM SCX = SFalse + (%==) SCM SCY = SFalse + (%==) SCM SCZ = SFalse + (%==) SCN SCA = SFalse + (%==) SCN SCB = SFalse + (%==) SCN SCC = SFalse + (%==) SCN SCD = SFalse + (%==) SCN SCE = SFalse + (%==) SCN SCF = SFalse + (%==) SCN SCG = SFalse + (%==) SCN SCH = SFalse + (%==) SCN SCI = SFalse + (%==) SCN SCJ = SFalse + (%==) SCN SCK = SFalse + (%==) SCN SCL = SFalse + (%==) SCN SCM = SFalse + (%==) SCN SCN = STrue + (%==) SCN SCO = SFalse + (%==) SCN SCP = SFalse + (%==) SCN SCQ = SFalse + (%==) SCN SCR = SFalse + (%==) SCN SCS = SFalse + (%==) SCN SCT = SFalse + (%==) SCN SCU = SFalse + (%==) SCN SCV = SFalse + (%==) SCN SCW = SFalse + (%==) SCN SCX = SFalse + (%==) SCN SCY = SFalse + (%==) SCN SCZ = SFalse + (%==) SCO SCA = SFalse + (%==) SCO SCB = SFalse + (%==) SCO SCC = SFalse + (%==) SCO SCD = SFalse + (%==) SCO SCE = SFalse + (%==) SCO SCF = SFalse + (%==) SCO SCG = SFalse + (%==) SCO SCH = SFalse + (%==) SCO SCI = SFalse + (%==) SCO SCJ = SFalse + (%==) SCO SCK = SFalse + (%==) SCO SCL = SFalse + (%==) SCO SCM = SFalse + (%==) SCO SCN = SFalse + (%==) SCO SCO = STrue + (%==) SCO SCP = SFalse + (%==) SCO SCQ = SFalse + (%==) SCO SCR = SFalse + (%==) SCO SCS = SFalse + (%==) SCO SCT = SFalse + (%==) SCO SCU = SFalse + (%==) SCO SCV = SFalse + (%==) SCO SCW = SFalse + (%==) SCO SCX = SFalse + (%==) SCO SCY = SFalse + (%==) SCO SCZ = SFalse + (%==) SCP SCA = SFalse + (%==) SCP SCB = SFalse + (%==) SCP SCC = SFalse + (%==) SCP SCD = SFalse + (%==) SCP SCE = SFalse + (%==) SCP SCF = SFalse + (%==) SCP SCG = SFalse + (%==) SCP SCH = SFalse + (%==) SCP SCI = SFalse + (%==) SCP SCJ = SFalse + (%==) SCP SCK = SFalse + (%==) SCP SCL = SFalse + (%==) SCP SCM = SFalse + (%==) SCP SCN = SFalse + (%==) SCP SCO = SFalse + (%==) SCP SCP = STrue + (%==) SCP SCQ = SFalse + (%==) SCP SCR = SFalse + (%==) SCP SCS = SFalse + (%==) SCP SCT = SFalse + (%==) SCP SCU = SFalse + (%==) SCP SCV = SFalse + (%==) SCP SCW = SFalse + (%==) SCP SCX = SFalse + (%==) SCP SCY = SFalse + (%==) SCP SCZ = SFalse + (%==) SCQ SCA = SFalse + (%==) SCQ SCB = SFalse + (%==) SCQ SCC = SFalse + (%==) SCQ SCD = SFalse + (%==) SCQ SCE = SFalse + (%==) SCQ SCF = SFalse + (%==) SCQ SCG = SFalse + (%==) SCQ SCH = SFalse + (%==) SCQ SCI = SFalse + (%==) SCQ SCJ = SFalse + (%==) SCQ SCK = SFalse + (%==) SCQ SCL = SFalse + (%==) SCQ SCM = SFalse + (%==) SCQ SCN = SFalse + (%==) SCQ SCO = SFalse + (%==) SCQ SCP = SFalse + (%==) SCQ SCQ = STrue + (%==) SCQ SCR = SFalse + (%==) SCQ SCS = SFalse + (%==) SCQ SCT = SFalse + (%==) SCQ SCU = SFalse + (%==) SCQ SCV = SFalse + (%==) SCQ SCW = SFalse + (%==) SCQ SCX = SFalse + (%==) SCQ SCY = SFalse + (%==) SCQ SCZ = SFalse + (%==) SCR SCA = SFalse + (%==) SCR SCB = SFalse + (%==) SCR SCC = SFalse + (%==) SCR SCD = SFalse + (%==) SCR SCE = SFalse + (%==) SCR SCF = SFalse + (%==) SCR SCG = SFalse + (%==) SCR SCH = SFalse + (%==) SCR SCI = SFalse + (%==) SCR SCJ = SFalse + (%==) SCR SCK = SFalse + (%==) SCR SCL = SFalse + (%==) SCR SCM = SFalse + (%==) SCR SCN = SFalse + (%==) SCR SCO = SFalse + (%==) SCR SCP = SFalse + (%==) SCR SCQ = SFalse + (%==) SCR SCR = STrue + (%==) SCR SCS = SFalse + (%==) SCR SCT = SFalse + (%==) SCR SCU = SFalse + (%==) SCR SCV = SFalse + (%==) SCR SCW = SFalse + (%==) SCR SCX = SFalse + (%==) SCR SCY = SFalse + (%==) SCR SCZ = SFalse + (%==) SCS SCA = SFalse + (%==) SCS SCB = SFalse + (%==) SCS SCC = SFalse + (%==) SCS SCD = SFalse + (%==) SCS SCE = SFalse + (%==) SCS SCF = SFalse + (%==) SCS SCG = SFalse + (%==) SCS SCH = SFalse + (%==) SCS SCI = SFalse + (%==) SCS SCJ = SFalse + (%==) SCS SCK = SFalse + (%==) SCS SCL = SFalse + (%==) SCS SCM = SFalse + (%==) SCS SCN = SFalse + (%==) SCS SCO = SFalse + (%==) SCS SCP = SFalse + (%==) SCS SCQ = SFalse + (%==) SCS SCR = SFalse + (%==) SCS SCS = STrue + (%==) SCS SCT = SFalse + (%==) SCS SCU = SFalse + (%==) SCS SCV = SFalse + (%==) SCS SCW = SFalse + (%==) SCS SCX = SFalse + (%==) SCS SCY = SFalse + (%==) SCS SCZ = SFalse + (%==) SCT SCA = SFalse + (%==) SCT SCB = SFalse + (%==) SCT SCC = SFalse + (%==) SCT SCD = SFalse + (%==) SCT SCE = SFalse + (%==) SCT SCF = SFalse + (%==) SCT SCG = SFalse + (%==) SCT SCH = SFalse + (%==) SCT SCI = SFalse + (%==) SCT SCJ = SFalse + (%==) SCT SCK = SFalse + (%==) SCT SCL = SFalse + (%==) SCT SCM = SFalse + (%==) SCT SCN = SFalse + (%==) SCT SCO = SFalse + (%==) SCT SCP = SFalse + (%==) SCT SCQ = SFalse + (%==) SCT SCR = SFalse + (%==) SCT SCS = SFalse + (%==) SCT SCT = STrue + (%==) SCT SCU = SFalse + (%==) SCT SCV = SFalse + (%==) SCT SCW = SFalse + (%==) SCT SCX = SFalse + (%==) SCT SCY = SFalse + (%==) SCT SCZ = SFalse + (%==) SCU SCA = SFalse + (%==) SCU SCB = SFalse + (%==) SCU SCC = SFalse + (%==) SCU SCD = SFalse + (%==) SCU SCE = SFalse + (%==) SCU SCF = SFalse + (%==) SCU SCG = SFalse + (%==) SCU SCH = SFalse + (%==) SCU SCI = SFalse + (%==) SCU SCJ = SFalse + (%==) SCU SCK = SFalse + (%==) SCU SCL = SFalse + (%==) SCU SCM = SFalse + (%==) SCU SCN = SFalse + (%==) SCU SCO = SFalse + (%==) SCU SCP = SFalse + (%==) SCU SCQ = SFalse + (%==) SCU SCR = SFalse + (%==) SCU SCS = SFalse + (%==) SCU SCT = SFalse + (%==) SCU SCU = STrue + (%==) SCU SCV = SFalse + (%==) SCU SCW = SFalse + (%==) SCU SCX = SFalse + (%==) SCU SCY = SFalse + (%==) SCU SCZ = SFalse + (%==) SCV SCA = SFalse + (%==) SCV SCB = SFalse + (%==) SCV SCC = SFalse + (%==) SCV SCD = SFalse + (%==) SCV SCE = SFalse + (%==) SCV SCF = SFalse + (%==) SCV SCG = SFalse + (%==) SCV SCH = SFalse + (%==) SCV SCI = SFalse + (%==) SCV SCJ = SFalse + (%==) SCV SCK = SFalse + (%==) SCV SCL = SFalse + (%==) SCV SCM = SFalse + (%==) SCV SCN = SFalse + (%==) SCV SCO = SFalse + (%==) SCV SCP = SFalse + (%==) SCV SCQ = SFalse + (%==) SCV SCR = SFalse + (%==) SCV SCS = SFalse + (%==) SCV SCT = SFalse + (%==) SCV SCU = SFalse + (%==) SCV SCV = STrue + (%==) SCV SCW = SFalse + (%==) SCV SCX = SFalse + (%==) SCV SCY = SFalse + (%==) SCV SCZ = SFalse + (%==) SCW SCA = SFalse + (%==) SCW SCB = SFalse + (%==) SCW SCC = SFalse + (%==) SCW SCD = SFalse + (%==) SCW SCE = SFalse + (%==) SCW SCF = SFalse + (%==) SCW SCG = SFalse + (%==) SCW SCH = SFalse + (%==) SCW SCI = SFalse + (%==) SCW SCJ = SFalse + (%==) SCW SCK = SFalse + (%==) SCW SCL = SFalse + (%==) SCW SCM = SFalse + (%==) SCW SCN = SFalse + (%==) SCW SCO = SFalse + (%==) SCW SCP = SFalse + (%==) SCW SCQ = SFalse + (%==) SCW SCR = SFalse + (%==) SCW SCS = SFalse + (%==) SCW SCT = SFalse + (%==) SCW SCU = SFalse + (%==) SCW SCV = SFalse + (%==) SCW SCW = STrue + (%==) SCW SCX = SFalse + (%==) SCW SCY = SFalse + (%==) SCW SCZ = SFalse + (%==) SCX SCA = SFalse + (%==) SCX SCB = SFalse + (%==) SCX SCC = SFalse + (%==) SCX SCD = SFalse + (%==) SCX SCE = SFalse + (%==) SCX SCF = SFalse + (%==) SCX SCG = SFalse + (%==) SCX SCH = SFalse + (%==) SCX SCI = SFalse + (%==) SCX SCJ = SFalse + (%==) SCX SCK = SFalse + (%==) SCX SCL = SFalse + (%==) SCX SCM = SFalse + (%==) SCX SCN = SFalse + (%==) SCX SCO = SFalse + (%==) SCX SCP = SFalse + (%==) SCX SCQ = SFalse + (%==) SCX SCR = SFalse + (%==) SCX SCS = SFalse + (%==) SCX SCT = SFalse + (%==) SCX SCU = SFalse + (%==) SCX SCV = SFalse + (%==) SCX SCW = SFalse + (%==) SCX SCX = STrue + (%==) SCX SCY = SFalse + (%==) SCX SCZ = SFalse + (%==) SCY SCA = SFalse + (%==) SCY SCB = SFalse + (%==) SCY SCC = SFalse + (%==) SCY SCD = SFalse + (%==) SCY SCE = SFalse + (%==) SCY SCF = SFalse + (%==) SCY SCG = SFalse + (%==) SCY SCH = SFalse + (%==) SCY SCI = SFalse + (%==) SCY SCJ = SFalse + (%==) SCY SCK = SFalse + (%==) SCY SCL = SFalse + (%==) SCY SCM = SFalse + (%==) SCY SCN = SFalse + (%==) SCY SCO = SFalse + (%==) SCY SCP = SFalse + (%==) SCY SCQ = SFalse + (%==) SCY SCR = SFalse + (%==) SCY SCS = SFalse + (%==) SCY SCT = SFalse + (%==) SCY SCU = SFalse + (%==) SCY SCV = SFalse + (%==) SCY SCW = SFalse + (%==) SCY SCX = SFalse + (%==) SCY SCY = STrue + (%==) SCY SCZ = SFalse + (%==) SCZ SCA = SFalse + (%==) SCZ SCB = SFalse + (%==) SCZ SCC = SFalse + (%==) SCZ SCD = SFalse + (%==) SCZ SCE = SFalse + (%==) SCZ SCF = SFalse + (%==) SCZ SCG = SFalse + (%==) SCZ SCH = SFalse + (%==) SCZ SCI = SFalse + (%==) SCZ SCJ = SFalse + (%==) SCZ SCK = SFalse + (%==) SCZ SCL = SFalse + (%==) SCZ SCM = SFalse + (%==) SCZ SCN = SFalse + (%==) SCZ SCO = SFalse + (%==) SCZ SCP = SFalse + (%==) SCZ SCQ = SFalse + (%==) SCZ SCR = SFalse + (%==) SCZ SCS = SFalse + (%==) SCZ SCT = SFalse + (%==) SCZ SCU = SFalse + (%==) SCZ SCV = SFalse + (%==) SCZ SCW = SFalse + (%==) SCZ SCX = SFalse + (%==) SCZ SCY = SFalse + (%==) SCZ SCZ = STrue + instance SDecide AChar where + (%~) SCA SCA = Proved Refl + (%~) SCA SCB = Disproved (\ x -> case x of) + (%~) SCA SCC = Disproved (\ x -> case x of) + (%~) SCA SCD = Disproved (\ x -> case x of) + (%~) SCA SCE = Disproved (\ x -> case x of) + (%~) SCA SCF = Disproved (\ x -> case x of) + (%~) SCA SCG = Disproved (\ x -> case x of) + (%~) SCA SCH = Disproved (\ x -> case x of) + (%~) SCA SCI = Disproved (\ x -> case x of) + (%~) SCA SCJ = Disproved (\ x -> case x of) + (%~) SCA SCK = Disproved (\ x -> case x of) + (%~) SCA SCL = Disproved (\ x -> case x of) + (%~) SCA SCM = Disproved (\ x -> case x of) + (%~) SCA SCN = Disproved (\ x -> case x of) + (%~) SCA SCO = Disproved (\ x -> case x of) + (%~) SCA SCP = Disproved (\ x -> case x of) + (%~) SCA SCQ = Disproved (\ x -> case x of) + (%~) SCA SCR = Disproved (\ x -> case x of) + (%~) SCA SCS = Disproved (\ x -> case x of) + (%~) SCA SCT = Disproved (\ x -> case x of) + (%~) SCA SCU = Disproved (\ x -> case x of) + (%~) SCA SCV = Disproved (\ x -> case x of) + (%~) SCA SCW = Disproved (\ x -> case x of) + (%~) SCA SCX = Disproved (\ x -> case x of) + (%~) SCA SCY = Disproved (\ x -> case x of) + (%~) SCA SCZ = Disproved (\ x -> case x of) + (%~) SCB SCA = Disproved (\ x -> case x of) + (%~) SCB SCB = Proved Refl + (%~) SCB SCC = Disproved (\ x -> case x of) + (%~) SCB SCD = Disproved (\ x -> case x of) + (%~) SCB SCE = Disproved (\ x -> case x of) + (%~) SCB SCF = Disproved (\ x -> case x of) + (%~) SCB SCG = Disproved (\ x -> case x of) + (%~) SCB SCH = Disproved (\ x -> case x of) + (%~) SCB SCI = Disproved (\ x -> case x of) + (%~) SCB SCJ = Disproved (\ x -> case x of) + (%~) SCB SCK = Disproved (\ x -> case x of) + (%~) SCB SCL = Disproved (\ x -> case x of) + (%~) SCB SCM = Disproved (\ x -> case x of) + (%~) SCB SCN = Disproved (\ x -> case x of) + (%~) SCB SCO = Disproved (\ x -> case x of) + (%~) SCB SCP = Disproved (\ x -> case x of) + (%~) SCB SCQ = Disproved (\ x -> case x of) + (%~) SCB SCR = Disproved (\ x -> case x of) + (%~) SCB SCS = Disproved (\ x -> case x of) + (%~) SCB SCT = Disproved (\ x -> case x of) + (%~) SCB SCU = Disproved (\ x -> case x of) + (%~) SCB SCV = Disproved (\ x -> case x of) + (%~) SCB SCW = Disproved (\ x -> case x of) + (%~) SCB SCX = Disproved (\ x -> case x of) + (%~) SCB SCY = Disproved (\ x -> case x of) + (%~) SCB SCZ = Disproved (\ x -> case x of) + (%~) SCC SCA = Disproved (\ x -> case x of) + (%~) SCC SCB = Disproved (\ x -> case x of) + (%~) SCC SCC = Proved Refl + (%~) SCC SCD = Disproved (\ x -> case x of) + (%~) SCC SCE = Disproved (\ x -> case x of) + (%~) SCC SCF = Disproved (\ x -> case x of) + (%~) SCC SCG = Disproved (\ x -> case x of) + (%~) SCC SCH = Disproved (\ x -> case x of) + (%~) SCC SCI = Disproved (\ x -> case x of) + (%~) SCC SCJ = Disproved (\ x -> case x of) + (%~) SCC SCK = Disproved (\ x -> case x of) + (%~) SCC SCL = Disproved (\ x -> case x of) + (%~) SCC SCM = Disproved (\ x -> case x of) + (%~) SCC SCN = Disproved (\ x -> case x of) + (%~) SCC SCO = Disproved (\ x -> case x of) + (%~) SCC SCP = Disproved (\ x -> case x of) + (%~) SCC SCQ = Disproved (\ x -> case x of) + (%~) SCC SCR = Disproved (\ x -> case x of) + (%~) SCC SCS = Disproved (\ x -> case x of) + (%~) SCC SCT = Disproved (\ x -> case x of) + (%~) SCC SCU = Disproved (\ x -> case x of) + (%~) SCC SCV = Disproved (\ x -> case x of) + (%~) SCC SCW = Disproved (\ x -> case x of) + (%~) SCC SCX = Disproved (\ x -> case x of) + (%~) SCC SCY = Disproved (\ x -> case x of) + (%~) SCC SCZ = Disproved (\ x -> case x of) + (%~) SCD SCA = Disproved (\ x -> case x of) + (%~) SCD SCB = Disproved (\ x -> case x of) + (%~) SCD SCC = Disproved (\ x -> case x of) + (%~) SCD SCD = Proved Refl + (%~) SCD SCE = Disproved (\ x -> case x of) + (%~) SCD SCF = Disproved (\ x -> case x of) + (%~) SCD SCG = Disproved (\ x -> case x of) + (%~) SCD SCH = Disproved (\ x -> case x of) + (%~) SCD SCI = Disproved (\ x -> case x of) + (%~) SCD SCJ = Disproved (\ x -> case x of) + (%~) SCD SCK = Disproved (\ x -> case x of) + (%~) SCD SCL = Disproved (\ x -> case x of) + (%~) SCD SCM = Disproved (\ x -> case x of) + (%~) SCD SCN = Disproved (\ x -> case x of) + (%~) SCD SCO = Disproved (\ x -> case x of) + (%~) SCD SCP = Disproved (\ x -> case x of) + (%~) SCD SCQ = Disproved (\ x -> case x of) + (%~) SCD SCR = Disproved (\ x -> case x of) + (%~) SCD SCS = Disproved (\ x -> case x of) + (%~) SCD SCT = Disproved (\ x -> case x of) + (%~) SCD SCU = Disproved (\ x -> case x of) + (%~) SCD SCV = Disproved (\ x -> case x of) + (%~) SCD SCW = Disproved (\ x -> case x of) + (%~) SCD SCX = Disproved (\ x -> case x of) + (%~) SCD SCY = Disproved (\ x -> case x of) + (%~) SCD SCZ = Disproved (\ x -> case x of) + (%~) SCE SCA = Disproved (\ x -> case x of) + (%~) SCE SCB = Disproved (\ x -> case x of) + (%~) SCE SCC = Disproved (\ x -> case x of) + (%~) SCE SCD = Disproved (\ x -> case x of) + (%~) SCE SCE = Proved Refl + (%~) SCE SCF = Disproved (\ x -> case x of) + (%~) SCE SCG = Disproved (\ x -> case x of) + (%~) SCE SCH = Disproved (\ x -> case x of) + (%~) SCE SCI = Disproved (\ x -> case x of) + (%~) SCE SCJ = Disproved (\ x -> case x of) + (%~) SCE SCK = Disproved (\ x -> case x of) + (%~) SCE SCL = Disproved (\ x -> case x of) + (%~) SCE SCM = Disproved (\ x -> case x of) + (%~) SCE SCN = Disproved (\ x -> case x of) + (%~) SCE SCO = Disproved (\ x -> case x of) + (%~) SCE SCP = Disproved (\ x -> case x of) + (%~) SCE SCQ = Disproved (\ x -> case x of) + (%~) SCE SCR = Disproved (\ x -> case x of) + (%~) SCE SCS = Disproved (\ x -> case x of) + (%~) SCE SCT = Disproved (\ x -> case x of) + (%~) SCE SCU = Disproved (\ x -> case x of) + (%~) SCE SCV = Disproved (\ x -> case x of) + (%~) SCE SCW = Disproved (\ x -> case x of) + (%~) SCE SCX = Disproved (\ x -> case x of) + (%~) SCE SCY = Disproved (\ x -> case x of) + (%~) SCE SCZ = Disproved (\ x -> case x of) + (%~) SCF SCA = Disproved (\ x -> case x of) + (%~) SCF SCB = Disproved (\ x -> case x of) + (%~) SCF SCC = Disproved (\ x -> case x of) + (%~) SCF SCD = Disproved (\ x -> case x of) + (%~) SCF SCE = Disproved (\ x -> case x of) + (%~) SCF SCF = Proved Refl + (%~) SCF SCG = Disproved (\ x -> case x of) + (%~) SCF SCH = Disproved (\ x -> case x of) + (%~) SCF SCI = Disproved (\ x -> case x of) + (%~) SCF SCJ = Disproved (\ x -> case x of) + (%~) SCF SCK = Disproved (\ x -> case x of) + (%~) SCF SCL = Disproved (\ x -> case x of) + (%~) SCF SCM = Disproved (\ x -> case x of) + (%~) SCF SCN = Disproved (\ x -> case x of) + (%~) SCF SCO = Disproved (\ x -> case x of) + (%~) SCF SCP = Disproved (\ x -> case x of) + (%~) SCF SCQ = Disproved (\ x -> case x of) + (%~) SCF SCR = Disproved (\ x -> case x of) + (%~) SCF SCS = Disproved (\ x -> case x of) + (%~) SCF SCT = Disproved (\ x -> case x of) + (%~) SCF SCU = Disproved (\ x -> case x of) + (%~) SCF SCV = Disproved (\ x -> case x of) + (%~) SCF SCW = Disproved (\ x -> case x of) + (%~) SCF SCX = Disproved (\ x -> case x of) + (%~) SCF SCY = Disproved (\ x -> case x of) + (%~) SCF SCZ = Disproved (\ x -> case x of) + (%~) SCG SCA = Disproved (\ x -> case x of) + (%~) SCG SCB = Disproved (\ x -> case x of) + (%~) SCG SCC = Disproved (\ x -> case x of) + (%~) SCG SCD = Disproved (\ x -> case x of) + (%~) SCG SCE = Disproved (\ x -> case x of) + (%~) SCG SCF = Disproved (\ x -> case x of) + (%~) SCG SCG = Proved Refl + (%~) SCG SCH = Disproved (\ x -> case x of) + (%~) SCG SCI = Disproved (\ x -> case x of) + (%~) SCG SCJ = Disproved (\ x -> case x of) + (%~) SCG SCK = Disproved (\ x -> case x of) + (%~) SCG SCL = Disproved (\ x -> case x of) + (%~) SCG SCM = Disproved (\ x -> case x of) + (%~) SCG SCN = Disproved (\ x -> case x of) + (%~) SCG SCO = Disproved (\ x -> case x of) + (%~) SCG SCP = Disproved (\ x -> case x of) + (%~) SCG SCQ = Disproved (\ x -> case x of) + (%~) SCG SCR = Disproved (\ x -> case x of) + (%~) SCG SCS = Disproved (\ x -> case x of) + (%~) SCG SCT = Disproved (\ x -> case x of) + (%~) SCG SCU = Disproved (\ x -> case x of) + (%~) SCG SCV = Disproved (\ x -> case x of) + (%~) SCG SCW = Disproved (\ x -> case x of) + (%~) SCG SCX = Disproved (\ x -> case x of) + (%~) SCG SCY = Disproved (\ x -> case x of) + (%~) SCG SCZ = Disproved (\ x -> case x of) + (%~) SCH SCA = Disproved (\ x -> case x of) + (%~) SCH SCB = Disproved (\ x -> case x of) + (%~) SCH SCC = Disproved (\ x -> case x of) + (%~) SCH SCD = Disproved (\ x -> case x of) + (%~) SCH SCE = Disproved (\ x -> case x of) + (%~) SCH SCF = Disproved (\ x -> case x of) + (%~) SCH SCG = Disproved (\ x -> case x of) + (%~) SCH SCH = Proved Refl + (%~) SCH SCI = Disproved (\ x -> case x of) + (%~) SCH SCJ = Disproved (\ x -> case x of) + (%~) SCH SCK = Disproved (\ x -> case x of) + (%~) SCH SCL = Disproved (\ x -> case x of) + (%~) SCH SCM = Disproved (\ x -> case x of) + (%~) SCH SCN = Disproved (\ x -> case x of) + (%~) SCH SCO = Disproved (\ x -> case x of) + (%~) SCH SCP = Disproved (\ x -> case x of) + (%~) SCH SCQ = Disproved (\ x -> case x of) + (%~) SCH SCR = Disproved (\ x -> case x of) + (%~) SCH SCS = Disproved (\ x -> case x of) + (%~) SCH SCT = Disproved (\ x -> case x of) + (%~) SCH SCU = Disproved (\ x -> case x of) + (%~) SCH SCV = Disproved (\ x -> case x of) + (%~) SCH SCW = Disproved (\ x -> case x of) + (%~) SCH SCX = Disproved (\ x -> case x of) + (%~) SCH SCY = Disproved (\ x -> case x of) + (%~) SCH SCZ = Disproved (\ x -> case x of) + (%~) SCI SCA = Disproved (\ x -> case x of) + (%~) SCI SCB = Disproved (\ x -> case x of) + (%~) SCI SCC = Disproved (\ x -> case x of) + (%~) SCI SCD = Disproved (\ x -> case x of) + (%~) SCI SCE = Disproved (\ x -> case x of) + (%~) SCI SCF = Disproved (\ x -> case x of) + (%~) SCI SCG = Disproved (\ x -> case x of) + (%~) SCI SCH = Disproved (\ x -> case x of) + (%~) SCI SCI = Proved Refl + (%~) SCI SCJ = Disproved (\ x -> case x of) + (%~) SCI SCK = Disproved (\ x -> case x of) + (%~) SCI SCL = Disproved (\ x -> case x of) + (%~) SCI SCM = Disproved (\ x -> case x of) + (%~) SCI SCN = Disproved (\ x -> case x of) + (%~) SCI SCO = Disproved (\ x -> case x of) + (%~) SCI SCP = Disproved (\ x -> case x of) + (%~) SCI SCQ = Disproved (\ x -> case x of) + (%~) SCI SCR = Disproved (\ x -> case x of) + (%~) SCI SCS = Disproved (\ x -> case x of) + (%~) SCI SCT = Disproved (\ x -> case x of) + (%~) SCI SCU = Disproved (\ x -> case x of) + (%~) SCI SCV = Disproved (\ x -> case x of) + (%~) SCI SCW = Disproved (\ x -> case x of) + (%~) SCI SCX = Disproved (\ x -> case x of) + (%~) SCI SCY = Disproved (\ x -> case x of) + (%~) SCI SCZ = Disproved (\ x -> case x of) + (%~) SCJ SCA = Disproved (\ x -> case x of) + (%~) SCJ SCB = Disproved (\ x -> case x of) + (%~) SCJ SCC = Disproved (\ x -> case x of) + (%~) SCJ SCD = Disproved (\ x -> case x of) + (%~) SCJ SCE = Disproved (\ x -> case x of) + (%~) SCJ SCF = Disproved (\ x -> case x of) + (%~) SCJ SCG = Disproved (\ x -> case x of) + (%~) SCJ SCH = Disproved (\ x -> case x of) + (%~) SCJ SCI = Disproved (\ x -> case x of) + (%~) SCJ SCJ = Proved Refl + (%~) SCJ SCK = Disproved (\ x -> case x of) + (%~) SCJ SCL = Disproved (\ x -> case x of) + (%~) SCJ SCM = Disproved (\ x -> case x of) + (%~) SCJ SCN = Disproved (\ x -> case x of) + (%~) SCJ SCO = Disproved (\ x -> case x of) + (%~) SCJ SCP = Disproved (\ x -> case x of) + (%~) SCJ SCQ = Disproved (\ x -> case x of) + (%~) SCJ SCR = Disproved (\ x -> case x of) + (%~) SCJ SCS = Disproved (\ x -> case x of) + (%~) SCJ SCT = Disproved (\ x -> case x of) + (%~) SCJ SCU = Disproved (\ x -> case x of) + (%~) SCJ SCV = Disproved (\ x -> case x of) + (%~) SCJ SCW = Disproved (\ x -> case x of) + (%~) SCJ SCX = Disproved (\ x -> case x of) + (%~) SCJ SCY = Disproved (\ x -> case x of) + (%~) SCJ SCZ = Disproved (\ x -> case x of) + (%~) SCK SCA = Disproved (\ x -> case x of) + (%~) SCK SCB = Disproved (\ x -> case x of) + (%~) SCK SCC = Disproved (\ x -> case x of) + (%~) SCK SCD = Disproved (\ x -> case x of) + (%~) SCK SCE = Disproved (\ x -> case x of) + (%~) SCK SCF = Disproved (\ x -> case x of) + (%~) SCK SCG = Disproved (\ x -> case x of) + (%~) SCK SCH = Disproved (\ x -> case x of) + (%~) SCK SCI = Disproved (\ x -> case x of) + (%~) SCK SCJ = Disproved (\ x -> case x of) + (%~) SCK SCK = Proved Refl + (%~) SCK SCL = Disproved (\ x -> case x of) + (%~) SCK SCM = Disproved (\ x -> case x of) + (%~) SCK SCN = Disproved (\ x -> case x of) + (%~) SCK SCO = Disproved (\ x -> case x of) + (%~) SCK SCP = Disproved (\ x -> case x of) + (%~) SCK SCQ = Disproved (\ x -> case x of) + (%~) SCK SCR = Disproved (\ x -> case x of) + (%~) SCK SCS = Disproved (\ x -> case x of) + (%~) SCK SCT = Disproved (\ x -> case x of) + (%~) SCK SCU = Disproved (\ x -> case x of) + (%~) SCK SCV = Disproved (\ x -> case x of) + (%~) SCK SCW = Disproved (\ x -> case x of) + (%~) SCK SCX = Disproved (\ x -> case x of) + (%~) SCK SCY = Disproved (\ x -> case x of) + (%~) SCK SCZ = Disproved (\ x -> case x of) + (%~) SCL SCA = Disproved (\ x -> case x of) + (%~) SCL SCB = Disproved (\ x -> case x of) + (%~) SCL SCC = Disproved (\ x -> case x of) + (%~) SCL SCD = Disproved (\ x -> case x of) + (%~) SCL SCE = Disproved (\ x -> case x of) + (%~) SCL SCF = Disproved (\ x -> case x of) + (%~) SCL SCG = Disproved (\ x -> case x of) + (%~) SCL SCH = Disproved (\ x -> case x of) + (%~) SCL SCI = Disproved (\ x -> case x of) + (%~) SCL SCJ = Disproved (\ x -> case x of) + (%~) SCL SCK = Disproved (\ x -> case x of) + (%~) SCL SCL = Proved Refl + (%~) SCL SCM = Disproved (\ x -> case x of) + (%~) SCL SCN = Disproved (\ x -> case x of) + (%~) SCL SCO = Disproved (\ x -> case x of) + (%~) SCL SCP = Disproved (\ x -> case x of) + (%~) SCL SCQ = Disproved (\ x -> case x of) + (%~) SCL SCR = Disproved (\ x -> case x of) + (%~) SCL SCS = Disproved (\ x -> case x of) + (%~) SCL SCT = Disproved (\ x -> case x of) + (%~) SCL SCU = Disproved (\ x -> case x of) + (%~) SCL SCV = Disproved (\ x -> case x of) + (%~) SCL SCW = Disproved (\ x -> case x of) + (%~) SCL SCX = Disproved (\ x -> case x of) + (%~) SCL SCY = Disproved (\ x -> case x of) + (%~) SCL SCZ = Disproved (\ x -> case x of) + (%~) SCM SCA = Disproved (\ x -> case x of) + (%~) SCM SCB = Disproved (\ x -> case x of) + (%~) SCM SCC = Disproved (\ x -> case x of) + (%~) SCM SCD = Disproved (\ x -> case x of) + (%~) SCM SCE = Disproved (\ x -> case x of) + (%~) SCM SCF = Disproved (\ x -> case x of) + (%~) SCM SCG = Disproved (\ x -> case x of) + (%~) SCM SCH = Disproved (\ x -> case x of) + (%~) SCM SCI = Disproved (\ x -> case x of) + (%~) SCM SCJ = Disproved (\ x -> case x of) + (%~) SCM SCK = Disproved (\ x -> case x of) + (%~) SCM SCL = Disproved (\ x -> case x of) + (%~) SCM SCM = Proved Refl + (%~) SCM SCN = Disproved (\ x -> case x of) + (%~) SCM SCO = Disproved (\ x -> case x of) + (%~) SCM SCP = Disproved (\ x -> case x of) + (%~) SCM SCQ = Disproved (\ x -> case x of) + (%~) SCM SCR = Disproved (\ x -> case x of) + (%~) SCM SCS = Disproved (\ x -> case x of) + (%~) SCM SCT = Disproved (\ x -> case x of) + (%~) SCM SCU = Disproved (\ x -> case x of) + (%~) SCM SCV = Disproved (\ x -> case x of) + (%~) SCM SCW = Disproved (\ x -> case x of) + (%~) SCM SCX = Disproved (\ x -> case x of) + (%~) SCM SCY = Disproved (\ x -> case x of) + (%~) SCM SCZ = Disproved (\ x -> case x of) + (%~) SCN SCA = Disproved (\ x -> case x of) + (%~) SCN SCB = Disproved (\ x -> case x of) + (%~) SCN SCC = Disproved (\ x -> case x of) + (%~) SCN SCD = Disproved (\ x -> case x of) + (%~) SCN SCE = Disproved (\ x -> case x of) + (%~) SCN SCF = Disproved (\ x -> case x of) + (%~) SCN SCG = Disproved (\ x -> case x of) + (%~) SCN SCH = Disproved (\ x -> case x of) + (%~) SCN SCI = Disproved (\ x -> case x of) + (%~) SCN SCJ = Disproved (\ x -> case x of) + (%~) SCN SCK = Disproved (\ x -> case x of) + (%~) SCN SCL = Disproved (\ x -> case x of) + (%~) SCN SCM = Disproved (\ x -> case x of) + (%~) SCN SCN = Proved Refl + (%~) SCN SCO = Disproved (\ x -> case x of) + (%~) SCN SCP = Disproved (\ x -> case x of) + (%~) SCN SCQ = Disproved (\ x -> case x of) + (%~) SCN SCR = Disproved (\ x -> case x of) + (%~) SCN SCS = Disproved (\ x -> case x of) + (%~) SCN SCT = Disproved (\ x -> case x of) + (%~) SCN SCU = Disproved (\ x -> case x of) + (%~) SCN SCV = Disproved (\ x -> case x of) + (%~) SCN SCW = Disproved (\ x -> case x of) + (%~) SCN SCX = Disproved (\ x -> case x of) + (%~) SCN SCY = Disproved (\ x -> case x of) + (%~) SCN SCZ = Disproved (\ x -> case x of) + (%~) SCO SCA = Disproved (\ x -> case x of) + (%~) SCO SCB = Disproved (\ x -> case x of) + (%~) SCO SCC = Disproved (\ x -> case x of) + (%~) SCO SCD = Disproved (\ x -> case x of) + (%~) SCO SCE = Disproved (\ x -> case x of) + (%~) SCO SCF = Disproved (\ x -> case x of) + (%~) SCO SCG = Disproved (\ x -> case x of) + (%~) SCO SCH = Disproved (\ x -> case x of) + (%~) SCO SCI = Disproved (\ x -> case x of) + (%~) SCO SCJ = Disproved (\ x -> case x of) + (%~) SCO SCK = Disproved (\ x -> case x of) + (%~) SCO SCL = Disproved (\ x -> case x of) + (%~) SCO SCM = Disproved (\ x -> case x of) + (%~) SCO SCN = Disproved (\ x -> case x of) + (%~) SCO SCO = Proved Refl + (%~) SCO SCP = Disproved (\ x -> case x of) + (%~) SCO SCQ = Disproved (\ x -> case x of) + (%~) SCO SCR = Disproved (\ x -> case x of) + (%~) SCO SCS = Disproved (\ x -> case x of) + (%~) SCO SCT = Disproved (\ x -> case x of) + (%~) SCO SCU = Disproved (\ x -> case x of) + (%~) SCO SCV = Disproved (\ x -> case x of) + (%~) SCO SCW = Disproved (\ x -> case x of) + (%~) SCO SCX = Disproved (\ x -> case x of) + (%~) SCO SCY = Disproved (\ x -> case x of) + (%~) SCO SCZ = Disproved (\ x -> case x of) + (%~) SCP SCA = Disproved (\ x -> case x of) + (%~) SCP SCB = Disproved (\ x -> case x of) + (%~) SCP SCC = Disproved (\ x -> case x of) + (%~) SCP SCD = Disproved (\ x -> case x of) + (%~) SCP SCE = Disproved (\ x -> case x of) + (%~) SCP SCF = Disproved (\ x -> case x of) + (%~) SCP SCG = Disproved (\ x -> case x of) + (%~) SCP SCH = Disproved (\ x -> case x of) + (%~) SCP SCI = Disproved (\ x -> case x of) + (%~) SCP SCJ = Disproved (\ x -> case x of) + (%~) SCP SCK = Disproved (\ x -> case x of) + (%~) SCP SCL = Disproved (\ x -> case x of) + (%~) SCP SCM = Disproved (\ x -> case x of) + (%~) SCP SCN = Disproved (\ x -> case x of) + (%~) SCP SCO = Disproved (\ x -> case x of) + (%~) SCP SCP = Proved Refl + (%~) SCP SCQ = Disproved (\ x -> case x of) + (%~) SCP SCR = Disproved (\ x -> case x of) + (%~) SCP SCS = Disproved (\ x -> case x of) + (%~) SCP SCT = Disproved (\ x -> case x of) + (%~) SCP SCU = Disproved (\ x -> case x of) + (%~) SCP SCV = Disproved (\ x -> case x of) + (%~) SCP SCW = Disproved (\ x -> case x of) + (%~) SCP SCX = Disproved (\ x -> case x of) + (%~) SCP SCY = Disproved (\ x -> case x of) + (%~) SCP SCZ = Disproved (\ x -> case x of) + (%~) SCQ SCA = Disproved (\ x -> case x of) + (%~) SCQ SCB = Disproved (\ x -> case x of) + (%~) SCQ SCC = Disproved (\ x -> case x of) + (%~) SCQ SCD = Disproved (\ x -> case x of) + (%~) SCQ SCE = Disproved (\ x -> case x of) + (%~) SCQ SCF = Disproved (\ x -> case x of) + (%~) SCQ SCG = Disproved (\ x -> case x of) + (%~) SCQ SCH = Disproved (\ x -> case x of) + (%~) SCQ SCI = Disproved (\ x -> case x of) + (%~) SCQ SCJ = Disproved (\ x -> case x of) + (%~) SCQ SCK = Disproved (\ x -> case x of) + (%~) SCQ SCL = Disproved (\ x -> case x of) + (%~) SCQ SCM = Disproved (\ x -> case x of) + (%~) SCQ SCN = Disproved (\ x -> case x of) + (%~) SCQ SCO = Disproved (\ x -> case x of) + (%~) SCQ SCP = Disproved (\ x -> case x of) + (%~) SCQ SCQ = Proved Refl + (%~) SCQ SCR = Disproved (\ x -> case x of) + (%~) SCQ SCS = Disproved (\ x -> case x of) + (%~) SCQ SCT = Disproved (\ x -> case x of) + (%~) SCQ SCU = Disproved (\ x -> case x of) + (%~) SCQ SCV = Disproved (\ x -> case x of) + (%~) SCQ SCW = Disproved (\ x -> case x of) + (%~) SCQ SCX = Disproved (\ x -> case x of) + (%~) SCQ SCY = Disproved (\ x -> case x of) + (%~) SCQ SCZ = Disproved (\ x -> case x of) + (%~) SCR SCA = Disproved (\ x -> case x of) + (%~) SCR SCB = Disproved (\ x -> case x of) + (%~) SCR SCC = Disproved (\ x -> case x of) + (%~) SCR SCD = Disproved (\ x -> case x of) + (%~) SCR SCE = Disproved (\ x -> case x of) + (%~) SCR SCF = Disproved (\ x -> case x of) + (%~) SCR SCG = Disproved (\ x -> case x of) + (%~) SCR SCH = Disproved (\ x -> case x of) + (%~) SCR SCI = Disproved (\ x -> case x of) + (%~) SCR SCJ = Disproved (\ x -> case x of) + (%~) SCR SCK = Disproved (\ x -> case x of) + (%~) SCR SCL = Disproved (\ x -> case x of) + (%~) SCR SCM = Disproved (\ x -> case x of) + (%~) SCR SCN = Disproved (\ x -> case x of) + (%~) SCR SCO = Disproved (\ x -> case x of) + (%~) SCR SCP = Disproved (\ x -> case x of) + (%~) SCR SCQ = Disproved (\ x -> case x of) + (%~) SCR SCR = Proved Refl + (%~) SCR SCS = Disproved (\ x -> case x of) + (%~) SCR SCT = Disproved (\ x -> case x of) + (%~) SCR SCU = Disproved (\ x -> case x of) + (%~) SCR SCV = Disproved (\ x -> case x of) + (%~) SCR SCW = Disproved (\ x -> case x of) + (%~) SCR SCX = Disproved (\ x -> case x of) + (%~) SCR SCY = Disproved (\ x -> case x of) + (%~) SCR SCZ = Disproved (\ x -> case x of) + (%~) SCS SCA = Disproved (\ x -> case x of) + (%~) SCS SCB = Disproved (\ x -> case x of) + (%~) SCS SCC = Disproved (\ x -> case x of) + (%~) SCS SCD = Disproved (\ x -> case x of) + (%~) SCS SCE = Disproved (\ x -> case x of) + (%~) SCS SCF = Disproved (\ x -> case x of) + (%~) SCS SCG = Disproved (\ x -> case x of) + (%~) SCS SCH = Disproved (\ x -> case x of) + (%~) SCS SCI = Disproved (\ x -> case x of) + (%~) SCS SCJ = Disproved (\ x -> case x of) + (%~) SCS SCK = Disproved (\ x -> case x of) + (%~) SCS SCL = Disproved (\ x -> case x of) + (%~) SCS SCM = Disproved (\ x -> case x of) + (%~) SCS SCN = Disproved (\ x -> case x of) + (%~) SCS SCO = Disproved (\ x -> case x of) + (%~) SCS SCP = Disproved (\ x -> case x of) + (%~) SCS SCQ = Disproved (\ x -> case x of) + (%~) SCS SCR = Disproved (\ x -> case x of) + (%~) SCS SCS = Proved Refl + (%~) SCS SCT = Disproved (\ x -> case x of) + (%~) SCS SCU = Disproved (\ x -> case x of) + (%~) SCS SCV = Disproved (\ x -> case x of) + (%~) SCS SCW = Disproved (\ x -> case x of) + (%~) SCS SCX = Disproved (\ x -> case x of) + (%~) SCS SCY = Disproved (\ x -> case x of) + (%~) SCS SCZ = Disproved (\ x -> case x of) + (%~) SCT SCA = Disproved (\ x -> case x of) + (%~) SCT SCB = Disproved (\ x -> case x of) + (%~) SCT SCC = Disproved (\ x -> case x of) + (%~) SCT SCD = Disproved (\ x -> case x of) + (%~) SCT SCE = Disproved (\ x -> case x of) + (%~) SCT SCF = Disproved (\ x -> case x of) + (%~) SCT SCG = Disproved (\ x -> case x of) + (%~) SCT SCH = Disproved (\ x -> case x of) + (%~) SCT SCI = Disproved (\ x -> case x of) + (%~) SCT SCJ = Disproved (\ x -> case x of) + (%~) SCT SCK = Disproved (\ x -> case x of) + (%~) SCT SCL = Disproved (\ x -> case x of) + (%~) SCT SCM = Disproved (\ x -> case x of) + (%~) SCT SCN = Disproved (\ x -> case x of) + (%~) SCT SCO = Disproved (\ x -> case x of) + (%~) SCT SCP = Disproved (\ x -> case x of) + (%~) SCT SCQ = Disproved (\ x -> case x of) + (%~) SCT SCR = Disproved (\ x -> case x of) + (%~) SCT SCS = Disproved (\ x -> case x of) + (%~) SCT SCT = Proved Refl + (%~) SCT SCU = Disproved (\ x -> case x of) + (%~) SCT SCV = Disproved (\ x -> case x of) + (%~) SCT SCW = Disproved (\ x -> case x of) + (%~) SCT SCX = Disproved (\ x -> case x of) + (%~) SCT SCY = Disproved (\ x -> case x of) + (%~) SCT SCZ = Disproved (\ x -> case x of) + (%~) SCU SCA = Disproved (\ x -> case x of) + (%~) SCU SCB = Disproved (\ x -> case x of) + (%~) SCU SCC = Disproved (\ x -> case x of) + (%~) SCU SCD = Disproved (\ x -> case x of) + (%~) SCU SCE = Disproved (\ x -> case x of) + (%~) SCU SCF = Disproved (\ x -> case x of) + (%~) SCU SCG = Disproved (\ x -> case x of) + (%~) SCU SCH = Disproved (\ x -> case x of) + (%~) SCU SCI = Disproved (\ x -> case x of) + (%~) SCU SCJ = Disproved (\ x -> case x of) + (%~) SCU SCK = Disproved (\ x -> case x of) + (%~) SCU SCL = Disproved (\ x -> case x of) + (%~) SCU SCM = Disproved (\ x -> case x of) + (%~) SCU SCN = Disproved (\ x -> case x of) + (%~) SCU SCO = Disproved (\ x -> case x of) + (%~) SCU SCP = Disproved (\ x -> case x of) + (%~) SCU SCQ = Disproved (\ x -> case x of) + (%~) SCU SCR = Disproved (\ x -> case x of) + (%~) SCU SCS = Disproved (\ x -> case x of) + (%~) SCU SCT = Disproved (\ x -> case x of) + (%~) SCU SCU = Proved Refl + (%~) SCU SCV = Disproved (\ x -> case x of) + (%~) SCU SCW = Disproved (\ x -> case x of) + (%~) SCU SCX = Disproved (\ x -> case x of) + (%~) SCU SCY = Disproved (\ x -> case x of) + (%~) SCU SCZ = Disproved (\ x -> case x of) + (%~) SCV SCA = Disproved (\ x -> case x of) + (%~) SCV SCB = Disproved (\ x -> case x of) + (%~) SCV SCC = Disproved (\ x -> case x of) + (%~) SCV SCD = Disproved (\ x -> case x of) + (%~) SCV SCE = Disproved (\ x -> case x of) + (%~) SCV SCF = Disproved (\ x -> case x of) + (%~) SCV SCG = Disproved (\ x -> case x of) + (%~) SCV SCH = Disproved (\ x -> case x of) + (%~) SCV SCI = Disproved (\ x -> case x of) + (%~) SCV SCJ = Disproved (\ x -> case x of) + (%~) SCV SCK = Disproved (\ x -> case x of) + (%~) SCV SCL = Disproved (\ x -> case x of) + (%~) SCV SCM = Disproved (\ x -> case x of) + (%~) SCV SCN = Disproved (\ x -> case x of) + (%~) SCV SCO = Disproved (\ x -> case x of) + (%~) SCV SCP = Disproved (\ x -> case x of) + (%~) SCV SCQ = Disproved (\ x -> case x of) + (%~) SCV SCR = Disproved (\ x -> case x of) + (%~) SCV SCS = Disproved (\ x -> case x of) + (%~) SCV SCT = Disproved (\ x -> case x of) + (%~) SCV SCU = Disproved (\ x -> case x of) + (%~) SCV SCV = Proved Refl + (%~) SCV SCW = Disproved (\ x -> case x of) + (%~) SCV SCX = Disproved (\ x -> case x of) + (%~) SCV SCY = Disproved (\ x -> case x of) + (%~) SCV SCZ = Disproved (\ x -> case x of) + (%~) SCW SCA = Disproved (\ x -> case x of) + (%~) SCW SCB = Disproved (\ x -> case x of) + (%~) SCW SCC = Disproved (\ x -> case x of) + (%~) SCW SCD = Disproved (\ x -> case x of) + (%~) SCW SCE = Disproved (\ x -> case x of) + (%~) SCW SCF = Disproved (\ x -> case x of) + (%~) SCW SCG = Disproved (\ x -> case x of) + (%~) SCW SCH = Disproved (\ x -> case x of) + (%~) SCW SCI = Disproved (\ x -> case x of) + (%~) SCW SCJ = Disproved (\ x -> case x of) + (%~) SCW SCK = Disproved (\ x -> case x of) + (%~) SCW SCL = Disproved (\ x -> case x of) + (%~) SCW SCM = Disproved (\ x -> case x of) + (%~) SCW SCN = Disproved (\ x -> case x of) + (%~) SCW SCO = Disproved (\ x -> case x of) + (%~) SCW SCP = Disproved (\ x -> case x of) + (%~) SCW SCQ = Disproved (\ x -> case x of) + (%~) SCW SCR = Disproved (\ x -> case x of) + (%~) SCW SCS = Disproved (\ x -> case x of) + (%~) SCW SCT = Disproved (\ x -> case x of) + (%~) SCW SCU = Disproved (\ x -> case x of) + (%~) SCW SCV = Disproved (\ x -> case x of) + (%~) SCW SCW = Proved Refl + (%~) SCW SCX = Disproved (\ x -> case x of) + (%~) SCW SCY = Disproved (\ x -> case x of) + (%~) SCW SCZ = Disproved (\ x -> case x of) + (%~) SCX SCA = Disproved (\ x -> case x of) + (%~) SCX SCB = Disproved (\ x -> case x of) + (%~) SCX SCC = Disproved (\ x -> case x of) + (%~) SCX SCD = Disproved (\ x -> case x of) + (%~) SCX SCE = Disproved (\ x -> case x of) + (%~) SCX SCF = Disproved (\ x -> case x of) + (%~) SCX SCG = Disproved (\ x -> case x of) + (%~) SCX SCH = Disproved (\ x -> case x of) + (%~) SCX SCI = Disproved (\ x -> case x of) + (%~) SCX SCJ = Disproved (\ x -> case x of) + (%~) SCX SCK = Disproved (\ x -> case x of) + (%~) SCX SCL = Disproved (\ x -> case x of) + (%~) SCX SCM = Disproved (\ x -> case x of) + (%~) SCX SCN = Disproved (\ x -> case x of) + (%~) SCX SCO = Disproved (\ x -> case x of) + (%~) SCX SCP = Disproved (\ x -> case x of) + (%~) SCX SCQ = Disproved (\ x -> case x of) + (%~) SCX SCR = Disproved (\ x -> case x of) + (%~) SCX SCS = Disproved (\ x -> case x of) + (%~) SCX SCT = Disproved (\ x -> case x of) + (%~) SCX SCU = Disproved (\ x -> case x of) + (%~) SCX SCV = Disproved (\ x -> case x of) + (%~) SCX SCW = Disproved (\ x -> case x of) + (%~) SCX SCX = Proved Refl + (%~) SCX SCY = Disproved (\ x -> case x of) + (%~) SCX SCZ = Disproved (\ x -> case x of) + (%~) SCY SCA = Disproved (\ x -> case x of) + (%~) SCY SCB = Disproved (\ x -> case x of) + (%~) SCY SCC = Disproved (\ x -> case x of) + (%~) SCY SCD = Disproved (\ x -> case x of) + (%~) SCY SCE = Disproved (\ x -> case x of) + (%~) SCY SCF = Disproved (\ x -> case x of) + (%~) SCY SCG = Disproved (\ x -> case x of) + (%~) SCY SCH = Disproved (\ x -> case x of) + (%~) SCY SCI = Disproved (\ x -> case x of) + (%~) SCY SCJ = Disproved (\ x -> case x of) + (%~) SCY SCK = Disproved (\ x -> case x of) + (%~) SCY SCL = Disproved (\ x -> case x of) + (%~) SCY SCM = Disproved (\ x -> case x of) + (%~) SCY SCN = Disproved (\ x -> case x of) + (%~) SCY SCO = Disproved (\ x -> case x of) + (%~) SCY SCP = Disproved (\ x -> case x of) + (%~) SCY SCQ = Disproved (\ x -> case x of) + (%~) SCY SCR = Disproved (\ x -> case x of) + (%~) SCY SCS = Disproved (\ x -> case x of) + (%~) SCY SCT = Disproved (\ x -> case x of) + (%~) SCY SCU = Disproved (\ x -> case x of) + (%~) SCY SCV = Disproved (\ x -> case x of) + (%~) SCY SCW = Disproved (\ x -> case x of) + (%~) SCY SCX = Disproved (\ x -> case x of) + (%~) SCY SCY = Proved Refl + (%~) SCY SCZ = Disproved (\ x -> case x of) + (%~) SCZ SCA = Disproved (\ x -> case x of) + (%~) SCZ SCB = Disproved (\ x -> case x of) + (%~) SCZ SCC = Disproved (\ x -> case x of) + (%~) SCZ SCD = Disproved (\ x -> case x of) + (%~) SCZ SCE = Disproved (\ x -> case x of) + (%~) SCZ SCF = Disproved (\ x -> case x of) + (%~) SCZ SCG = Disproved (\ x -> case x of) + (%~) SCZ SCH = Disproved (\ x -> case x of) + (%~) SCZ SCI = Disproved (\ x -> case x of) + (%~) SCZ SCJ = Disproved (\ x -> case x of) + (%~) SCZ SCK = Disproved (\ x -> case x of) + (%~) SCZ SCL = Disproved (\ x -> case x of) + (%~) SCZ SCM = Disproved (\ x -> case x of) + (%~) SCZ SCN = Disproved (\ x -> case x of) + (%~) SCZ SCO = Disproved (\ x -> case x of) + (%~) SCZ SCP = Disproved (\ x -> case x of) + (%~) SCZ SCQ = Disproved (\ x -> case x of) + (%~) SCZ SCR = Disproved (\ x -> case x of) + (%~) SCZ SCS = Disproved (\ x -> case x of) + (%~) SCZ SCT = Disproved (\ x -> case x of) + (%~) SCZ SCU = Disproved (\ x -> case x of) + (%~) SCZ SCV = Disproved (\ x -> case x of) + (%~) SCZ SCW = Disproved (\ x -> case x of) + (%~) SCZ SCX = Disproved (\ x -> case x of) + (%~) SCZ SCY = Disproved (\ x -> case x of) + (%~) SCZ SCZ = Proved Refl + instance (Data.Singletons.ShowSing.ShowSing U, + Data.Singletons.ShowSing.ShowSing Nat) => + Data.Singletons.ShowSing.ShowSing U where + Data.Singletons.ShowSing.showsSingPrec _ SBOOL = showString "SBOOL" + Data.Singletons.ShowSing.showsSingPrec _ SSTRING + = showString "SSTRING" + Data.Singletons.ShowSing.showsSingPrec _ SNAT = showString "SNAT" + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SVEC arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SVEC ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + (((.) GHC.Show.showSpace) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)))) + instance (Data.Singletons.ShowSing.ShowSing U, + Data.Singletons.ShowSing.ShowSing Nat) => + Show (Sing (z :: U)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance Data.Singletons.ShowSing.ShowSing AChar where + Data.Singletons.ShowSing.showsSingPrec _ SCA = showString "SCA" + Data.Singletons.ShowSing.showsSingPrec _ SCB = showString "SCB" + Data.Singletons.ShowSing.showsSingPrec _ SCC = showString "SCC" + Data.Singletons.ShowSing.showsSingPrec _ SCD = showString "SCD" + Data.Singletons.ShowSing.showsSingPrec _ SCE = showString "SCE" + Data.Singletons.ShowSing.showsSingPrec _ SCF = showString "SCF" + Data.Singletons.ShowSing.showsSingPrec _ SCG = showString "SCG" + Data.Singletons.ShowSing.showsSingPrec _ SCH = showString "SCH" + Data.Singletons.ShowSing.showsSingPrec _ SCI = showString "SCI" + Data.Singletons.ShowSing.showsSingPrec _ SCJ = showString "SCJ" + Data.Singletons.ShowSing.showsSingPrec _ SCK = showString "SCK" + Data.Singletons.ShowSing.showsSingPrec _ SCL = showString "SCL" + Data.Singletons.ShowSing.showsSingPrec _ SCM = showString "SCM" + Data.Singletons.ShowSing.showsSingPrec _ SCN = showString "SCN" + Data.Singletons.ShowSing.showsSingPrec _ SCO = showString "SCO" + Data.Singletons.ShowSing.showsSingPrec _ SCP = showString "SCP" + Data.Singletons.ShowSing.showsSingPrec _ SCQ = showString "SCQ" + Data.Singletons.ShowSing.showsSingPrec _ SCR = showString "SCR" + Data.Singletons.ShowSing.showsSingPrec _ SCS = showString "SCS" + Data.Singletons.ShowSing.showsSingPrec _ SCT = showString "SCT" + Data.Singletons.ShowSing.showsSingPrec _ SCU = showString "SCU" + Data.Singletons.ShowSing.showsSingPrec _ SCV = showString "SCV" + Data.Singletons.ShowSing.showsSingPrec _ SCW = showString "SCW" + Data.Singletons.ShowSing.showsSingPrec _ SCX = showString "SCX" + Data.Singletons.ShowSing.showsSingPrec _ SCY = showString "SCY" + Data.Singletons.ShowSing.showsSingPrec _ SCZ = showString "SCZ" + instance Show (Sing (z :: AChar)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI BOOL where + sing = SBOOL + instance SingI STRING where + sing = SSTRING + instance SingI NAT where + sing = SNAT + instance (SingI n, SingI n) => + SingI (VEC (n :: U) (n :: Nat)) where + sing = (SVEC sing) sing + instance SingI CA where + sing = SCA + instance SingI CB where + sing = SCB + instance SingI CC where + sing = SCC + instance SingI CD where + sing = SCD + instance SingI CE where + sing = SCE + instance SingI CF where + sing = SCF + instance SingI CG where + sing = SCG + instance SingI CH where + sing = SCH + instance SingI CI where + sing = SCI + instance SingI CJ where + sing = SCJ + instance SingI CK where + sing = SCK + instance SingI CL where + sing = SCL + instance SingI CM where + sing = SCM + instance SingI CN where + sing = SCN + instance SingI CO where + sing = SCO + instance SingI CP where + sing = SCP + instance SingI CQ where + sing = SCQ + instance SingI CR where + sing = SCR + instance SingI CS where + sing = SCS + instance SingI CT where + sing = SCT + instance SingI CU where + sing = SCU + instance SingI CV where + sing = SCV + instance SingI CW where + sing = SCW + instance SingI CX where + sing = SCX + instance SingI CY where + sing = SCY + instance SingI CZ where + sing = SCZ + instance (SingI n, SingI n) => + SingI (Attr (n :: [AChar]) (n :: U)) where + sing = (SAttr sing) sing + instance SingI n => SingI (Sch (n :: [Attribute])) where + sing = SSch sing +GradingClient/Database.hs:0:0:: Splicing declarations + return [] ======> +GradingClient/Database.hs:(0,0)-(0,0): Splicing expression + cases ''Row [| r |] [| changeId (n ++ (getId r)) r |] + ======> + case r of + EmptyRow _ -> (changeId (((++) n) (getId r))) r + ConsRow _ _ -> (changeId (((++) n) (getId r))) r diff --git a/tests/compile-and-dump/GradingClient/Database.hs b/tests/compile-and-dump/GradingClient/Database.hs --- a/tests/compile-and-dump/GradingClient/Database.hs +++ b/tests/compile-and-dump/GradingClient/Database.hs @@ -11,8 +11,8 @@ {-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies, GADTs, TypeOperators, RankNTypes, FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, - ConstraintKinds, CPP, InstanceSigs #-} -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} + ConstraintKinds, InstanceSigs #-} +{-# OPTIONS_GHC -Wno-warnings-deprecations #-} -- The OverlappingInstances is needed only to allow the InC and SubsetC classes. -- This is simply a convenience so that GHC can infer the necessary proofs of @@ -24,19 +24,14 @@ import Prelude hiding ( tail, id ) import Data.Singletons.Prelude hiding ( Lookup, sLookup ) +import Data.Singletons.Prelude.Show import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Control.Monad +import Control.Monad.Except ( throwError ) import Data.List hiding ( tail ) import Data.Kind -#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) @@ -108,14 +103,14 @@ -- The El type family gives us the type associated with a constructor -- of U: -type family El (u :: U) :: * +type family El (u :: U) :: Type type instance El BOOL = Bool type instance El STRING = String type instance El NAT = Nat type instance El (VEC u n) = Vec (El u) n -- Length-indexed vectors -data Vec :: * -> Nat -> * where +data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) @@ -181,7 +176,7 @@ showAttrProof (SAttr _ u) = elUShowInstance u -- A Row is one row of our database table, keyed by its schema. -data Row :: Schema -> * where +data Row :: Schema -> Type where EmptyRow :: [Int] -> Row (Sch '[]) -- the Ints are the unique id of the row ConsRow :: El u -> Row (Sch s) -> Row (Sch ((Attr name u) ': s)) @@ -198,7 +193,7 @@ -- 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 +data Handle :: Schema -> Type where Handle :: [Row s] -> Handle s -- The following functions parse our very simple flat file database format. @@ -266,11 +261,11 @@ -- 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 +data InProof :: Attribute -> Schema -> Type where InElt :: InProof attr (Sch (attr ': schTail)) InTail :: InProof attr (Sch attrs) -> InProof attr (Sch (a ': attrs)) -data SubsetProof :: Schema -> Schema -> * where +data SubsetProof :: Schema -> Schema -> Type where SubsetEmpty :: SubsetProof (Sch '[]) s' SubsetCons :: InProof attr s' -> SubsetProof (Sch attrs) s' -> SubsetProof (Sch (attr ': attrs)) s' @@ -281,7 +276,7 @@ -- make the parameters to the proof GADT constructors implicit -- i.e. in the form -- of type class constraints. -data InProof :: Attribute -> Schema -> * where +data InProof :: Attribute -> Schema -> Type where InElt :: InProof attr (Sch (attr ': schTail)) InTail :: InC name u (Sch attrs) => InProof (Attr name u) (Sch (a ': attrs)) @@ -292,7 +287,7 @@ instance InC name u (Sch attrs) => InC name u (Sch (a ': attrs)) where inProof = InTail -data SubsetProof :: Schema -> Schema -> * where +data SubsetProof :: Schema -> Schema -> Type where SubsetEmpty :: SubsetProof (Sch '[]) s' SubsetCons :: (InC name u s', SubsetC (Sch attrs) s') => SubsetProof (Sch ((Attr name u) ': attrs)) s' @@ -309,7 +304,7 @@ -- 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 +data RA :: Schema -> Type where -- The RA includes all data represented by the handle. Read :: Handle s -> RA s @@ -347,7 +342,7 @@ -- 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 +data Expr :: Schema -> U -> Type where -- Equality among two elements Equal :: Eq (El u) => Expr s u -> Expr s u -> Expr s BOOL @@ -520,7 +515,7 @@ case sing :: Sing s' of -- SSch SNil -> undefined <== IMPOSSIBLE SSch (SCons (SAttr name' _) stail) -> - case name %:== name' of + case name %== name' of STrue -> h SFalse -> withSingI stail (eval (Element (SSch stail) name) t) diff --git a/tests/compile-and-dump/GradingClient/Main.ghc82.template b/tests/compile-and-dump/GradingClient/Main.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/GradingClient/Main.ghc82.template +++ /dev/null @@ -1,123 +0,0 @@ -GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| lastName, firstName, yearName, gradeName, majorName :: [AChar] - lastName = [CL, CA, CS, CT] - firstName = [CF, CI, CR, CS, CT] - yearName = [CY, CE, CA, CR] - gradeName = [CG, CR, CA, CD, CE] - majorName = [CM, CA, CJ, CO, CR] - gradingSchema :: Schema - gradingSchema - = Sch - [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, - Attr gradeName NAT, Attr majorName BOOL] - names :: Schema - names = Sch [Attr firstName STRING, Attr lastName STRING] |] - ======> - lastName :: [AChar] - firstName :: [AChar] - yearName :: [AChar] - gradeName :: [AChar] - majorName :: [AChar] - lastName = [CL, CA, CS, CT] - firstName = [CF, CI, CR, CS, CT] - yearName = [CY, CE, CA, CR] - gradeName = [CG, CR, CA, CD, CE] - majorName = [CM, CA, CJ, CO, CR] - gradingSchema :: Schema - gradingSchema - = Sch - [(Attr lastName) STRING, (Attr firstName) STRING, - (Attr yearName) NAT, (Attr gradeName) NAT, (Attr majorName) BOOL] - names :: Schema - names = Sch [(Attr firstName) STRING, (Attr lastName) STRING] - type MajorNameSym0 = MajorName - type GradeNameSym0 = GradeName - type YearNameSym0 = YearName - type FirstNameSym0 = FirstName - type LastNameSym0 = LastName - type GradingSchemaSym0 = GradingSchema - type NamesSym0 = Names - type family MajorName :: [AChar] where - = Apply (Apply (:$) CMSym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CJSym0) (Apply (Apply (:$) COSym0) (Apply (Apply (:$) CRSym0) '[])))) - type family GradeName :: [AChar] where - = Apply (Apply (:$) CGSym0) (Apply (Apply (:$) CRSym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CDSym0) (Apply (Apply (:$) CESym0) '[])))) - type family YearName :: [AChar] where - = Apply (Apply (:$) CYSym0) (Apply (Apply (:$) CESym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CRSym0) '[]))) - type family FirstName :: [AChar] where - = Apply (Apply (:$) CFSym0) (Apply (Apply (:$) CISym0) (Apply (Apply (:$) CRSym0) (Apply (Apply (:$) CSSym0) (Apply (Apply (:$) CTSym0) '[])))) - type family LastName :: [AChar] where - = Apply (Apply (:$) CLSym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CSSym0) (Apply (Apply (:$) CTSym0) '[]))) - type family GradingSchema :: Schema where - = 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 - = Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[])) - sMajorName :: Sing (MajorNameSym0 :: [AChar]) - sGradeName :: Sing (GradeNameSym0 :: [AChar]) - sYearName :: Sing (YearNameSym0 :: [AChar]) - sFirstName :: Sing (FirstNameSym0 :: [AChar]) - sLastName :: Sing (LastNameSym0 :: [AChar]) - sGradingSchema :: Sing (GradingSchemaSym0 :: Schema) - sNames :: Sing (NamesSym0 :: Schema) - sMajorName - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SCM)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCA)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCJ)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCO)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCR)) SNil)))) - sGradeName - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SCG)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCR)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCA)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCD)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCE)) SNil)))) - sYearName - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SCY)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCE)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCA)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCR)) SNil))) - sFirstName - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SCF)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCI)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCR)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCS)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCT)) SNil)))) - sLastName - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SCL)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCA)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCS)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SCT)) SNil))) - sGradingSchema - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName)) - SNAT))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName)) - SNAT))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName)) - SBOOL))) - SNil))))) - sNames - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) - SSTRING))) - SNil)) diff --git a/tests/compile-and-dump/GradingClient/Main.ghc84.template b/tests/compile-and-dump/GradingClient/Main.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Main.ghc84.template @@ -0,0 +1,123 @@ +GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| lastName, firstName, yearName, gradeName, majorName :: [AChar] + lastName = [CL, CA, CS, CT] + firstName = [CF, CI, CR, CS, CT] + yearName = [CY, CE, CA, CR] + gradeName = [CG, CR, CA, CD, CE] + majorName = [CM, CA, CJ, CO, CR] + gradingSchema :: Schema + gradingSchema + = Sch + [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, + Attr gradeName NAT, Attr majorName BOOL] + names :: Schema + names = Sch [Attr firstName STRING, Attr lastName STRING] |] + ======> + lastName :: [AChar] + firstName :: [AChar] + yearName :: [AChar] + gradeName :: [AChar] + majorName :: [AChar] + lastName = [CL, CA, CS, CT] + firstName = [CF, CI, CR, CS, CT] + yearName = [CY, CE, CA, CR] + gradeName = [CG, CR, CA, CD, CE] + majorName = [CM, CA, CJ, CO, CR] + gradingSchema :: Schema + gradingSchema + = Sch + [(Attr lastName) STRING, (Attr firstName) STRING, + (Attr yearName) NAT, (Attr gradeName) NAT, (Attr majorName) BOOL] + names :: Schema + names = Sch [(Attr firstName) STRING, (Attr lastName) STRING] + type MajorNameSym0 = MajorName + type GradeNameSym0 = GradeName + type YearNameSym0 = YearName + type FirstNameSym0 = FirstName + type LastNameSym0 = LastName + type GradingSchemaSym0 = GradingSchema + type NamesSym0 = Names + type family MajorName :: [AChar] where + MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) '[])))) + type family GradeName :: [AChar] where + GradeName = Apply (Apply (:@#@$) CGSym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CDSym0) (Apply (Apply (:@#@$) CESym0) '[])))) + type family YearName :: [AChar] where + YearName = Apply (Apply (:@#@$) CYSym0) (Apply (Apply (:@#@$) CESym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CRSym0) '[]))) + type family FirstName :: [AChar] where + FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[])))) + type family LastName :: [AChar] where + LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[]))) + type family GradingSchema :: Schema where + GradingSchema = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 YearNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 GradeNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 MajorNameSym0) BOOLSym0)) '[]))))) + type family Names :: Schema where + Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[])) + sMajorName :: Sing (MajorNameSym0 :: [AChar]) + sGradeName :: Sing (GradeNameSym0 :: [AChar]) + sYearName :: Sing (YearNameSym0 :: [AChar]) + sFirstName :: Sing (FirstNameSym0 :: [AChar]) + sLastName :: Sing (LastNameSym0 :: [AChar]) + sGradingSchema :: Sing (GradingSchemaSym0 :: Schema) + sNames :: Sing (NamesSym0 :: Schema) + sMajorName + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCM)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCJ)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCO)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil)))) + sGradeName + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCG)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCD)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE)) SNil)))) + sYearName + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCY)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil))) + sFirstName + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCF)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCI)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil)))) + sLastName + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCL)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil))) + sGradingSchema + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName)) + SNAT))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName)) + SNAT))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName)) + SBOOL))) + SNil))))) + sNames + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) + SSTRING))) + SNil)) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc82.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc82.template +++ /dev/null @@ -1,177 +0,0 @@ -InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations - singletons [d| data Nat = Zero | Succ Nat |] - ======> - data Nat = Zero | Succ Nat - type ZeroSym0 = Zero - type SuccSym1 (t :: Nat) = Succ t - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) - data SuccSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - data instance Sing (z :: Nat) - = 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 Demote 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 Let0123456789876543210Scrutinee_0123456789876543210Sym3 t t t = - Let0123456789876543210Scrutinee_0123456789876543210 t t t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l - type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where - Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h - type family Case_0123456789876543210 n h t t where - Case_0123456789876543210 n h t True = Apply (Apply (:$) n) (Apply (Apply (:$) h) t) - Case_0123456789876543210 n h t False = Apply (Apply (:$) h) (Apply (Apply InsertSym0 n) t) - type LeqSym2 (t :: Nat) (t :: Nat) = Leq t t - instance SuppressUnusedWarnings LeqSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LeqSym1KindInference) GHC.Tuple.()) - data LeqSym1 (l :: Nat) (l :: TyFun Nat Bool) - = forall arg. SameKind (Apply (LeqSym1 l) arg) (LeqSym2 l arg) => - LeqSym1KindInference - type instance Apply (LeqSym1 l) l = Leq l l - instance SuppressUnusedWarnings LeqSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LeqSym0KindInference) GHC.Tuple.()) - data LeqSym0 (l :: TyFun Nat (TyFun Nat Bool -> GHC.Types.Type)) - = forall arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => - LeqSym0KindInference - type instance Apply LeqSym0 l = LeqSym1 l - type InsertSym2 (t :: Nat) (t :: [Nat]) = Insert t t - instance SuppressUnusedWarnings InsertSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) InsertSym1KindInference) GHC.Tuple.()) - data InsertSym1 (l :: Nat) (l :: TyFun [Nat] [Nat]) - = forall arg. SameKind (Apply (InsertSym1 l) arg) (InsertSym2 l arg) => - InsertSym1KindInference - type instance Apply (InsertSym1 l) l = Insert l l - instance SuppressUnusedWarnings InsertSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) InsertSym0KindInference) GHC.Tuple.()) - data InsertSym0 (l :: TyFun Nat (TyFun [Nat] [Nat] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => - InsertSym0KindInference - type instance Apply InsertSym0 l = InsertSym1 l - type InsertionSortSym1 (t :: [Nat]) = InsertionSort t - instance SuppressUnusedWarnings InsertionSortSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) InsertionSortSym0KindInference) GHC.Tuple.()) - data InsertionSortSym0 (l :: TyFun [Nat] [Nat]) - = forall arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => - InsertionSortSym0KindInference - type instance Apply InsertionSortSym0 l = InsertionSort l - type family Leq (a :: Nat) (a :: Nat) :: Bool where - Leq Zero _z_0123456789876543210 = TrueSym0 - Leq (Succ _z_0123456789876543210) Zero = FalseSym0 - Leq (Succ a) (Succ b) = Apply (Apply LeqSym0 a) b - type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where - Insert n '[] = Apply (Apply (:$) n) '[] - Insert n ((:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) - type family InsertionSort (a :: [Nat]) :: [Nat] where - InsertionSort '[] = '[] - InsertionSort ((:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) - sLeq :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) - sInsert :: - forall (t :: Nat) (t :: [Nat]). - Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) - sInsertionSort :: - forall (t :: [Nat]). - Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) - sLeq SZero _ = STrue - sLeq (SSucc _) SZero = SFalse - sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) - = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB - sInsert (sN :: Sing n) SNil - = (applySing ((applySing ((singFun2 @(:$)) SCons)) sN)) SNil - sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t)) - = let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) - sScrutinee_0123456789876543210 - = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sN)) sH - in case sScrutinee_0123456789876543210 of - STrue - -> (applySing ((applySing ((singFun2 @(:$)) SCons)) sN)) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) sH)) sT) - SFalse - -> (applySing ((applySing ((singFun2 @(:$)) SCons)) sH)) - ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN)) - sT) :: - Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) :: [Nat]) - sInsertionSort SNil = SNil - sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) - = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) - ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc84.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc84.template @@ -0,0 +1,177 @@ +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Nat = Zero | Succ Nat |] + ======> + data Nat = Zero | Succ Nat + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = Succ l + data instance Sing (z :: Nat) + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = leq a b + insert :: Nat -> [Nat] -> [Nat] + insert n [] = [n] + insert n (h : t) + = if leq n h then (n : h : t) else h : (insert n t) + insertionSort :: [Nat] -> [Nat] + insertionSort [] = [] + insertionSort (h : t) = insert h (insertionSort t) |] + ======> + leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = (leq a) b + insert :: Nat -> [Nat] -> [Nat] + insert n GHC.Types.[] = [n] + insert n (h GHC.Types.: t) + = if (leq n) h then + (n GHC.Types.: (h GHC.Types.: t)) + else + (h GHC.Types.: ((insert n) t)) + insertionSort :: [Nat] -> [Nat] + insertionSort GHC.Types.[] = [] + insertionSort (h GHC.Types.: t) = (insert h) (insertionSort t) + type Let0123456789876543210Scrutinee_0123456789876543210Sym3 t t t = + Let0123456789876543210Scrutinee_0123456789876543210 t t t + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l + type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where + Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h + type family Case_0123456789876543210 n h t t where + Case_0123456789876543210 n h t True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t) + Case_0123456789876543210 n h t False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t) + type LeqSym2 (t :: Nat) (t :: Nat) = Leq t t + instance SuppressUnusedWarnings LeqSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LeqSym1KindInference) GHC.Tuple.()) + data LeqSym1 (l :: Nat) (l :: TyFun Nat Bool) + = forall arg. SameKind (Apply (LeqSym1 l) arg) (LeqSym2 l arg) => + LeqSym1KindInference + type instance Apply (LeqSym1 l) l = Leq l l + instance SuppressUnusedWarnings LeqSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LeqSym0KindInference) GHC.Tuple.()) + data LeqSym0 (l :: TyFun Nat (TyFun Nat Bool -> Type)) + = forall arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => + LeqSym0KindInference + type instance Apply LeqSym0 l = LeqSym1 l + type InsertSym2 (t :: Nat) (t :: [Nat]) = Insert t t + instance SuppressUnusedWarnings InsertSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) InsertSym1KindInference) GHC.Tuple.()) + data InsertSym1 (l :: Nat) (l :: TyFun [Nat] [Nat]) + = forall arg. SameKind (Apply (InsertSym1 l) arg) (InsertSym2 l arg) => + InsertSym1KindInference + type instance Apply (InsertSym1 l) l = Insert l l + instance SuppressUnusedWarnings InsertSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) InsertSym0KindInference) GHC.Tuple.()) + data InsertSym0 (l :: TyFun Nat (TyFun [Nat] [Nat] -> Type)) + = forall arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => + InsertSym0KindInference + type instance Apply InsertSym0 l = InsertSym1 l + type InsertionSortSym1 (t :: [Nat]) = InsertionSort t + instance SuppressUnusedWarnings InsertionSortSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) InsertionSortSym0KindInference) GHC.Tuple.()) + data InsertionSortSym0 (l :: TyFun [Nat] [Nat]) + = forall arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => + InsertionSortSym0KindInference + type instance Apply InsertionSortSym0 l = InsertionSort l + type family Leq (a :: Nat) (a :: Nat) :: Bool where + Leq Zero _ = TrueSym0 + Leq (Succ _) Zero = FalseSym0 + Leq (Succ a) (Succ b) = Apply (Apply LeqSym0 a) b + type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where + Insert n '[] = Apply (Apply (:@#@$) n) '[] + Insert n ((:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) + type family InsertionSort (a :: [Nat]) :: [Nat] where + InsertionSort '[] = '[] + InsertionSort ((:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) + sLeq :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + sInsert :: + forall (t :: Nat) (t :: [Nat]). + Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) + sInsertionSort :: + forall (t :: [Nat]). + Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) + sLeq SZero _ = STrue + sLeq (SSucc _) SZero = SFalse + sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) + = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB + sInsert (sN :: Sing n) SNil + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) SNil + sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t)) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sN)) sH + in case sScrutinee_0123456789876543210 of + STrue + -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) sT) + SFalse + -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) + ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN)) + sT) :: + Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) :: [Nat]) + sInsertionSort SNil = SNil + sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) + ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs b/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs @@ -34,7 +34,7 @@ module InsertionSort.InsertionSortImp where -import Data.Kind (type (*)) +import Data.Kind (Type) import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH @@ -63,7 +63,7 @@ instance (a :<=: b) => (Succ a) :<=: (Succ b) -- A proof term asserting that a list of naturals is in ascending order -data AscendingProof :: [Nat] -> * where +data AscendingProof :: [Nat] -> Type where AscEmpty :: AscendingProof '[] AscOne :: AscendingProof '[n] AscCons :: (a :<=: b, AscendingC (b ': rest)) => AscendingProof (a ': b ': rest) diff --git a/tests/compile-and-dump/Promote/Constructors.ghc82.template b/tests/compile-and-dump/Promote/Constructors.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Constructors.ghc82.template +++ /dev/null @@ -1,69 +0,0 @@ -Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations - promote - [d| data Foo = Foo | Foo :+ Foo - data Bar = Bar Bar Bar Bar Bar Foo |] - ======> - data Foo = Foo | Foo :+ Foo - data Bar = Bar Bar Bar Bar Bar Foo - type FooSym0 = Foo - type (:+$$$) (t :: Foo) (t :: Foo) = (:+) t t - instance SuppressUnusedWarnings (:+$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$$###)) GHC.Tuple.()) - data (:+$$) (l :: Foo) (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ((:+$$) l) arg) ((:+$$$) l arg) => - (:+$$###) - type instance Apply ((:+$$) l) l = (:+) l l - instance SuppressUnusedWarnings (:+$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$###)) GHC.Tuple.()) - data (:+$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+$) arg) ((:+$$) arg) => (:+$###) - type instance Apply (:+$) l = (:+$$) l - type BarSym5 (t :: Bar) (t :: Bar) (t :: Bar) (t :: Bar) (t :: Foo) = - Bar t t t t t - instance SuppressUnusedWarnings BarSym4 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym4KindInference) GHC.Tuple.()) - data BarSym4 (l :: Bar) (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Foo Bar) - = forall arg. SameKind (Apply (BarSym4 l l l l) arg) (BarSym5 l l l l arg) => - BarSym4KindInference - type instance Apply (BarSym4 l l l l) l = Bar l l l l l - instance SuppressUnusedWarnings BarSym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym3KindInference) GHC.Tuple.()) - data BarSym3 (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym3 l l l) arg) (BarSym4 l l l arg) => - BarSym3KindInference - type instance Apply (BarSym3 l l l) l = BarSym4 l l l l - instance SuppressUnusedWarnings BarSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym2KindInference) GHC.Tuple.()) - data BarSym2 (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym2 l l) arg) (BarSym3 l l arg) => - BarSym2KindInference - type instance Apply (BarSym2 l l) l = BarSym3 l l l - instance SuppressUnusedWarnings BarSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) - data BarSym1 (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => - BarSym1KindInference - type instance Apply (BarSym1 l) l = BarSym2 l l - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = BarSym1 l diff --git a/tests/compile-and-dump/Promote/Constructors.ghc84.template b/tests/compile-and-dump/Promote/Constructors.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Constructors.ghc84.template @@ -0,0 +1,70 @@ +Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations + promote + [d| data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo |] + ======> + data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo + type FooSym0 = Foo + type (:+@#@$$$) (t :: Foo) (t :: Foo) = (:+) t t + instance SuppressUnusedWarnings (:+@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+@#@$$###)) GHC.Tuple.()) + data (:+@#@$$) (l :: Foo) (l :: TyFun Foo Foo) + = forall arg. SameKind (Apply ((:+@#@$$) l) arg) ((:+@#@$$$) l arg) => + (::+@#@$$###) + type instance Apply ((:+@#@$$) l) l = (:+) l l + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+@#@$###)) GHC.Tuple.()) + data (:+@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (::+@#@$###) + type instance Apply (:+@#@$) l = (:+@#@$$) l + type BarSym5 (t :: Bar) (t :: Bar) (t :: Bar) (t :: Bar) (t :: Foo) = + Bar t t t t t + instance SuppressUnusedWarnings BarSym4 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym4KindInference) GHC.Tuple.()) + data BarSym4 (l :: Bar) (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Foo Bar) + = forall arg. SameKind (Apply (BarSym4 l l l l) arg) (BarSym5 l l l l arg) => + BarSym4KindInference + type instance Apply (BarSym4 l l l l) l = Bar l l l l l + instance SuppressUnusedWarnings BarSym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym3KindInference) GHC.Tuple.()) + data BarSym3 (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BarSym3 l l l) arg) (BarSym4 l l l arg) => + BarSym3KindInference + type instance Apply (BarSym3 l l l) l = BarSym4 l l l l + instance SuppressUnusedWarnings BarSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym2KindInference) GHC.Tuple.()) + data BarSym2 (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BarSym2 l l) arg) (BarSym3 l l arg) => + BarSym2KindInference + type instance Apply (BarSym2 l l) l = BarSym3 l l l + instance SuppressUnusedWarnings BarSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) + data BarSym1 (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => + BarSym1KindInference + type instance Apply (BarSym1 l) l = BarSym2 l l + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l diff --git a/tests/compile-and-dump/Promote/Constructors.hs b/tests/compile-and-dump/Promote/Constructors.hs --- a/tests/compile-and-dump/Promote/Constructors.hs +++ b/tests/compile-and-dump/Promote/Constructors.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Promote.Constructors where diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc82.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc82.template +++ /dev/null @@ -1,47 +0,0 @@ -Promote/GenDefunSymbols.hs:0:0:: Splicing declarations - genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] - ======> - type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 - -> Type) (t :: Maybe a0123456789876543210) = - LiftMaybe t t - instance SuppressUnusedWarnings LiftMaybeSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.()) - data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 - -> Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)) - = forall arg. Data.Singletons.SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) => - LiftMaybeSym1KindInference - type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l - instance SuppressUnusedWarnings LiftMaybeSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.()) - data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210) - -> Type)) - = forall arg. Data.Singletons.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => - LiftMaybeSym0KindInference - type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l - type ZeroSym0 = Zero - type SuccSym1 (t :: NatT) = Succ t - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) - data SuccSym0 (l :: TyFun NatT NatT) - = forall arg. Data.Singletons.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t - instance SuppressUnusedWarnings (:+$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$$###)) GHC.Tuple.()) - data (:+$$) (l :: Nat) l - = forall arg. Data.Singletons.SameKind (Apply ((:+$$) l) arg) ((:+$$$) l arg) => - (:+$$###) - type instance Apply ((:+$$) l) l = (:+) l l - instance SuppressUnusedWarnings (:+$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$###)) GHC.Tuple.()) - data (:+$) l - = forall arg. Data.Singletons.SameKind (Apply (:+$) arg) ((:+$$) arg) => - (:+$###) - type instance Apply (:+$) l = (:+$$) l diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.template @@ -0,0 +1,47 @@ +Promote/GenDefunSymbols.hs:0:0:: Splicing declarations + genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] + ======> + type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 + -> Type) (t :: Maybe a0123456789876543210) = + LiftMaybe t t + instance SuppressUnusedWarnings LiftMaybeSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.()) + data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 + -> Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)) + = forall arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) => + LiftMaybeSym1KindInference + type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.()) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210) + -> Type)) + = forall arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => + LiftMaybeSym0KindInference + type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l + type ZeroSym0 = Zero + type SuccSym1 (t :: NatT) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) + data SuccSym0 (l :: TyFun NatT NatT) + = forall arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = Succ l + type (:+@#@$$$) (t :: Nat) (t :: Nat) = (:+) t t + instance SuppressUnusedWarnings (:+@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+@#@$$###)) GHC.Tuple.()) + data (:+@#@$$) (l :: Nat) l + = forall arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) l) arg) ((:+@#@$$$) l arg) => + (::+@#@$$###) + type instance Apply ((:+@#@$$) l) l = (:+) l l + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+@#@$###)) GHC.Tuple.()) + data (:+@#@$) l + = forall arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (::+@#@$###) + type instance Apply (:+@#@$) l = (:+@#@$$) l diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.hs b/tests/compile-and-dump/Promote/GenDefunSymbols.hs --- a/tests/compile-and-dump/Promote/GenDefunSymbols.hs +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Promote.GenDefunSymbols where diff --git a/tests/compile-and-dump/Promote/Newtypes.ghc82.template b/tests/compile-and-dump/Promote/Newtypes.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Newtypes.ghc82.template +++ /dev/null @@ -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. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => - UnBarSym0KindInference - type instance Apply UnBarSym0 l = UnBar l - type family UnBar (a :: Bar) :: Nat where - UnBar (Bar field) = field - type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where - Equals_0123456789876543210 (Foo a) (Foo b) = (:==) a b - Equals_0123456789876543210 (a :: Foo) (b :: Foo) = FalseSym0 - instance PEq Foo where - type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789876543210 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. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type BarSym1 (t :: Nat) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Nat Bar) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l diff --git a/tests/compile-and-dump/Promote/Newtypes.ghc84.template b/tests/compile-and-dump/Promote/Newtypes.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Newtypes.ghc84.template @@ -0,0 +1,42 @@ +Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| newtype Foo + = Foo Nat + deriving Eq + newtype Bar = Bar {unBar :: Nat} |] + ======> + newtype Foo + = Foo Nat + deriving Eq + newtype Bar = Bar {unBar :: Nat} + type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where + Equals_0123456789876543210 (Foo a) (Foo b) = (==) a b + Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 + instance PEq Foo where + type (==) a b = Equals_0123456789876543210 a b + type UnBarSym1 (t :: Bar) = UnBar t + instance SuppressUnusedWarnings UnBarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) UnBarSym0KindInference) GHC.Tuple.()) + data UnBarSym0 (l :: TyFun Bar Nat) + = forall arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => + UnBarSym0KindInference + type instance Apply UnBarSym0 l = UnBar l + type family UnBar (a :: Bar) :: Nat where + UnBar (Bar field) = field + type FooSym1 (t :: Nat) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun Nat Foo) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type BarSym1 (t :: Nat) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun Nat Bar) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = Bar l diff --git a/tests/compile-and-dump/Promote/Newtypes.hs b/tests/compile-and-dump/Promote/Newtypes.hs --- a/tests/compile-and-dump/Promote/Newtypes.hs +++ b/tests/compile-and-dump/Promote/Newtypes.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Promote.Newtypes where diff --git a/tests/compile-and-dump/Promote/Pragmas.ghc82.template b/tests/compile-and-dump/Promote/Pragmas.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Pragmas.ghc82.template +++ /dev/null @@ -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 - = TrueSym0 diff --git a/tests/compile-and-dump/Promote/Pragmas.ghc84.template b/tests/compile-and-dump/Promote/Pragmas.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Pragmas.ghc84.template @@ -0,0 +1,12 @@ +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 diff --git a/tests/compile-and-dump/Promote/Prelude.ghc82.template b/tests/compile-and-dump/Promote/Prelude.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Prelude.ghc82.template +++ /dev/null @@ -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.SameKind (Apply OddSym0 arg) (OddSym1 arg) => - OddSym0KindInference - type instance Apply OddSym0 l = Odd l - type family Odd (a :: Nat) :: Bool where - Odd 0 = FalseSym0 - Odd n = Apply (Apply ($$) (Apply (Apply (:.$) NotSym0) OddSym0)) (Apply (Apply (:-$) n) (FromInteger 1)) diff --git a/tests/compile-and-dump/Promote/Prelude.ghc84.template b/tests/compile-and-dump/Promote/Prelude.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Prelude.ghc84.template @@ -0,0 +1,17 @@ +Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations + promoteOnly + [d| odd :: Nat -> Bool + odd 0 = False + odd n = not . odd $ n - 1 |] + ======> + type OddSym1 (t :: Nat) = Odd t + instance SuppressUnusedWarnings OddSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) OddSym0KindInference) GHC.Tuple.()) + data OddSym0 (l :: TyFun Nat Bool) + = forall arg. Data.Singletons.Internal.SameKind (Apply OddSym0 arg) (OddSym1 arg) => + OddSym0KindInference + type instance Apply OddSym0 l = Odd l + type family Odd (a :: Nat) :: Bool where + Odd 0 = FalseSym0 + Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1)) diff --git a/tests/compile-and-dump/Promote/Prelude.hs b/tests/compile-and-dump/Promote/Prelude.hs --- a/tests/compile-and-dump/Promote/Prelude.hs +++ b/tests/compile-and-dump/Promote/Prelude.hs @@ -3,7 +3,6 @@ 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]) @@ -78,13 +77,13 @@ splitAtTest2b :: Proxy ( '( '[], '[] ) ) splitAtTest2b = Proxy -indexingTest1a :: Proxy ('[4, 3, 2, 1] :!! 1) +indexingTest1a :: Proxy ('[4, 3, 2, 1] !! 1) indexingTest1a = Proxy indexingTest1b :: Proxy 3 indexingTest1b = indexingTest1a -indexingTest2a :: Proxy ('[] :!! 0) +indexingTest2a :: Proxy ('[] !! 0) indexingTest2a = Proxy indexingTest2b :: Proxy (Error "Data.Singletons.List.!!: index too large") diff --git a/tests/compile-and-dump/Promote/T180.ghc82.template b/tests/compile-and-dump/Promote/T180.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/T180.ghc82.template +++ /dev/null @@ -1,48 +0,0 @@ -Promote/T180.hs:(0,0)-(0,0): Splicing declarations - promote - [d| z (X1 x) = x - z (X2 x) = x - - data X = X1 {y :: Symbol} | X2 {y :: Symbol} |] - ======> - data X = X1 {y :: Symbol} | X2 {y :: Symbol} - z (X1 x) = x - z (X2 x) = x - type ZSym1 t = Z t - instance SuppressUnusedWarnings ZSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ZSym0KindInference) GHC.Tuple.()) - data ZSym0 l - = forall arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) => - ZSym0KindInference - type instance Apply ZSym0 l = Z l - type family Z a where - Z (X1 x) = x - Z (X2 x) = x - type YSym1 (t :: X) = Y t - instance SuppressUnusedWarnings YSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) YSym0KindInference) GHC.Tuple.()) - data YSym0 (l :: TyFun X Symbol) - = forall arg. SameKind (Apply YSym0 arg) (YSym1 arg) => - YSym0KindInference - type instance Apply YSym0 l = Y l - type family Y (a :: X) :: Symbol where - Y (X1 field) = field - Y (X2 field) = field - type X1Sym1 (t :: Symbol) = X1 t - instance SuppressUnusedWarnings X1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) X1Sym0KindInference) GHC.Tuple.()) - data X1Sym0 (l :: TyFun Symbol X) - = forall arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => - X1Sym0KindInference - type instance Apply X1Sym0 l = X1 l - type X2Sym1 (t :: Symbol) = X2 t - instance SuppressUnusedWarnings X2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) X2Sym0KindInference) GHC.Tuple.()) - data X2Sym0 (l :: TyFun Symbol X) - = forall arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => - X2Sym0KindInference - type instance Apply X2Sym0 l = X2 l diff --git a/tests/compile-and-dump/Promote/T180.ghc84.template b/tests/compile-and-dump/Promote/T180.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/T180.ghc84.template @@ -0,0 +1,48 @@ +Promote/T180.hs:(0,0)-(0,0): Splicing declarations + promote + [d| z (X1 x) = x + z (X2 x) = x + + data X = X1 {y :: Symbol} | X2 {y :: Symbol} |] + ======> + data X = X1 {y :: Symbol} | X2 {y :: Symbol} + z (X1 x) = x + z (X2 x) = x + type ZSym1 t = Z t + instance SuppressUnusedWarnings ZSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ZSym0KindInference) GHC.Tuple.()) + data ZSym0 l + = forall arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) => + ZSym0KindInference + type instance Apply ZSym0 l = Z l + type family Z a where + Z (X1 x) = x + Z (X2 x) = x + type YSym1 (t :: X) = Y t + instance SuppressUnusedWarnings YSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) YSym0KindInference) GHC.Tuple.()) + data YSym0 (l :: TyFun X Symbol) + = forall arg. SameKind (Apply YSym0 arg) (YSym1 arg) => + YSym0KindInference + type instance Apply YSym0 l = Y l + type family Y (a :: X) :: Symbol where + Y (X1 field) = field + Y (X2 field) = field + type X1Sym1 (t :: Symbol) = X1 t + instance SuppressUnusedWarnings X1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) X1Sym0KindInference) GHC.Tuple.()) + data X1Sym0 (l :: TyFun Symbol X) + = forall arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => + X1Sym0KindInference + type instance Apply X1Sym0 l = X1 l + type X2Sym1 (t :: Symbol) = X2 t + instance SuppressUnusedWarnings X2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) X2Sym0KindInference) GHC.Tuple.()) + data X2Sym0 (l :: TyFun Symbol X) + = forall arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => + X2Sym0KindInference + type instance Apply X2Sym0 l = X2 l diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc82.template b/tests/compile-and-dump/Singletons/AsPattern.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/AsPattern.ghc82.template +++ /dev/null @@ -1,347 +0,0 @@ -Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| maybePlus :: Maybe Nat -> Maybe Nat - maybePlus (Just n) = Just (plus (Succ Zero) n) - maybePlus p@Nothing = p - bar :: Maybe Nat -> Maybe Nat - bar x@(Just _) = x - bar Nothing = Nothing - baz_ :: Maybe Baz -> Maybe Baz - baz_ p@Nothing = p - baz_ p@(Just (Baz _ _ _)) = p - tup :: (Nat, Nat) -> (Nat, Nat) - tup p@(_, _) = p - foo :: [Nat] -> [Nat] - foo p@[] = p - foo p@[_] = p - foo p@(_ : _ : _) = p - - data Baz = Baz Nat Nat Nat |] - ======> - maybePlus :: Maybe Nat -> Maybe Nat - maybePlus (Just n) = Just ((plus (Succ Zero)) n) - maybePlus p@Nothing = p - bar :: Maybe Nat -> Maybe Nat - bar x@Just _ = x - bar Nothing = Nothing - data Baz = Baz Nat Nat Nat - baz_ :: Maybe Baz -> Maybe Baz - baz_ p@Nothing = p - baz_ p@Just (Baz _ _ _) = p - tup :: (Nat, Nat) -> (Nat, Nat) - tup p@(_, _) = p - foo :: [Nat] -> [Nat] - foo p@GHC.Types.[] = p - foo p@[_] = p - foo p@(_ GHC.Types.: (_ GHC.Types.: _)) = p - type BazSym3 (t :: Nat) (t :: Nat) (t :: Nat) = Baz t t t - instance SuppressUnusedWarnings BazSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BazSym2KindInference) GHC.Tuple.()) - data BazSym2 (l :: Nat) (l :: Nat) (l :: TyFun Nat Baz) - = forall arg. SameKind (Apply (BazSym2 l l) arg) (BazSym3 l l arg) => - BazSym2KindInference - type instance Apply (BazSym2 l l) l = Baz l l l - instance SuppressUnusedWarnings BazSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BazSym1KindInference) GHC.Tuple.()) - data BazSym1 (l :: Nat) (l :: TyFun Nat (TyFun Nat Baz - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BazSym1 l) arg) (BazSym2 l arg) => - BazSym1KindInference - type instance Apply (BazSym1 l) l = BazSym2 l l - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) - data BazSym0 (l :: TyFun Nat (TyFun Nat (TyFun Nat Baz - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0KindInference - type instance Apply BazSym0 l = BazSym1 l - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - = '[] - type Let0123456789876543210PSym1 t = Let0123456789876543210P t - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210P l - type family Let0123456789876543210P wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:$) wild_0123456789876543210) '[] - type Let0123456789876543210PSym3 t t t = - Let0123456789876543210P t t t - instance SuppressUnusedWarnings Let0123456789876543210PSym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => - Let0123456789876543210PSym2KindInference - type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:$) wild_0123456789876543210) (Apply (Apply (:$) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210PSym2 t t = Let0123456789876543210P t t - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210P l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - = NothingSym0 - type Let0123456789876543210PSym3 t t t = - Let0123456789876543210P t t t - instance SuppressUnusedWarnings Let0123456789876543210PSym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => - Let0123456789876543210PSym2KindInference - type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210XSym1 t = Let0123456789876543210X t - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210XSym0 l - = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0KindInference - type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l - type family Let0123456789876543210X wild_0123456789876543210 where - Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - = NothingSym0 - type FooSym1 (t :: [Nat]) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun [Nat] [Nat]) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type TupSym1 (t :: (Nat, Nat)) = Tup t - instance SuppressUnusedWarnings TupSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) TupSym0KindInference) GHC.Tuple.()) - data TupSym0 (l :: TyFun (Nat, Nat) (Nat, Nat)) - = forall arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => - TupSym0KindInference - type instance Apply TupSym0 l = Tup l - type Baz_Sym1 (t :: Maybe Baz) = Baz_ t - instance SuppressUnusedWarnings Baz_Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Baz_Sym0KindInference) GHC.Tuple.()) - data Baz_Sym0 (l :: TyFun (Maybe Baz) (Maybe Baz)) - = forall arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => - Baz_Sym0KindInference - type instance Apply Baz_Sym0 l = Baz_ l - type BarSym1 (t :: Maybe Nat) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l - type MaybePlusSym1 (t :: Maybe Nat) = MaybePlus t - instance SuppressUnusedWarnings MaybePlusSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MaybePlusSym0KindInference) GHC.Tuple.()) - data MaybePlusSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) - = forall arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => - MaybePlusSym0KindInference - type instance Apply MaybePlusSym0 l = MaybePlus l - type family Foo (a :: [Nat]) :: [Nat] where - Foo '[] = Let0123456789876543210PSym0 - Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 - Foo ((:) wild_0123456789876543210 ((:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 - type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where - Tup '(wild_0123456789876543210, - wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 - type family Baz_ (a :: Maybe Baz) :: Maybe Baz where - Baz_ Nothing = Let0123456789876543210PSym0 - Baz_ (Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 - type family Bar (a :: Maybe Nat) :: Maybe Nat where - Bar (Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 - Bar Nothing = NothingSym0 - type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where - MaybePlus (Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) - MaybePlus Nothing = Let0123456789876543210PSym0 - sFoo :: - forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) - sTup :: - forall (t :: (Nat, Nat)). - Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) - sBaz_ :: - forall (t :: Maybe Baz). - Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) - sBar :: - forall (t :: Maybe Nat). - Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) - sMaybePlus :: - forall (t :: Maybe Nat). - Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) - sFoo SNil - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNil - in sP - sFoo - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - SNil) - = let - sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) sWild_0123456789876543210)) - SNil - in sP - sFoo - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) - = let - sP :: - Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) sWild_0123456789876543210)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) sWild_0123456789876543210)) - sWild_0123456789876543210) - in sP - sTup - (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) - = let - sP :: - Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - sWild_0123456789876543210)) - sWild_0123456789876543210 - in sP - sBaz_ SNothing - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNothing - in sP - sBaz_ - (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) - = let - sP :: - Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing ((singFun1 @JustSym0) SJust)) - ((applySing - ((applySing - ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210)) - sWild_0123456789876543210)) - sWild_0123456789876543210) - in sP - sBar - (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) - = let - sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) - sX - = (applySing ((singFun1 @JustSym0) SJust)) - sWild_0123456789876543210 - in sX - sBar SNothing = SNothing - sMaybePlus (SJust (sN :: Sing n)) - = (applySing ((singFun1 @JustSym0) SJust)) - ((applySing - ((applySing ((singFun2 @PlusSym0) sPlus)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - sN) - sMaybePlus SNothing - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNothing - in sP - data instance Sing (z :: Baz) - = 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 Demote 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 diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc84.template b/tests/compile-and-dump/Singletons/AsPattern.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/AsPattern.ghc84.template @@ -0,0 +1,352 @@ +Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just (plus (Succ Zero) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@(Just _) = x + bar Nothing = Nothing + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@(Just (Baz _ _ _)) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@[] = p + foo p@[_] = p + foo p@(_ : _ : _) = p + + data Baz = Baz Nat Nat Nat |] + ======> + maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just ((plus (Succ Zero)) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@Just _ = x + bar Nothing = Nothing + data Baz = Baz Nat Nat Nat + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@Just (Baz _ _ _) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@GHC.Types.[] = p + foo p@[_] = p + foo p@(_ GHC.Types.: (_ GHC.Types.: _)) = p + type BazSym3 (t :: Nat) (t :: Nat) (t :: Nat) = Baz t t t + instance SuppressUnusedWarnings BazSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BazSym2KindInference) GHC.Tuple.()) + data BazSym2 (l :: Nat) (l :: Nat) (l :: TyFun Nat Baz) + = forall arg. SameKind (Apply (BazSym2 l l) arg) (BazSym3 l l arg) => + BazSym2KindInference + type instance Apply (BazSym2 l l) l = Baz l l l + instance SuppressUnusedWarnings BazSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BazSym1KindInference) GHC.Tuple.()) + data BazSym1 (l :: Nat) (l :: TyFun Nat (TyFun Nat Baz + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BazSym1 l) arg) (BazSym2 l arg) => + BazSym1KindInference + type instance Apply (BazSym1 l) l = BazSym2 l l + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) + data BazSym0 (l :: TyFun Nat (TyFun Nat (TyFun Nat Baz + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0KindInference + type instance Apply BazSym0 l = BazSym1 l + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = '[] + type Let0123456789876543210PSym1 t = Let0123456789876543210P t + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym0 l + = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0KindInference + type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210P l + type family Let0123456789876543210P wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[] + type Let0123456789876543210PSym3 t t t = + Let0123456789876543210P t t t + instance SuppressUnusedWarnings Let0123456789876543210PSym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym2 l l l + = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => + Let0123456789876543210PSym2KindInference + type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l + instance SuppressUnusedWarnings Let0123456789876543210PSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => + Let0123456789876543210PSym1KindInference + type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym0 l + = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0KindInference + type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) + type Let0123456789876543210PSym2 t t = Let0123456789876543210P t t + instance SuppressUnusedWarnings Let0123456789876543210PSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => + Let0123456789876543210PSym1KindInference + type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210P l l + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym0 l + = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0KindInference + type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = NothingSym0 + type Let0123456789876543210PSym3 t t t = + Let0123456789876543210P t t t + instance SuppressUnusedWarnings Let0123456789876543210PSym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym2 l l l + = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => + Let0123456789876543210PSym2KindInference + type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l + instance SuppressUnusedWarnings Let0123456789876543210PSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => + Let0123456789876543210PSym1KindInference + type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210PSym0 l + = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0KindInference + type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) + type Let0123456789876543210XSym1 t = Let0123456789876543210X t + instance SuppressUnusedWarnings Let0123456789876543210XSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210XSym0 l + = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => + Let0123456789876543210XSym0KindInference + type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l + type family Let0123456789876543210X wild_0123456789876543210 where + Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = NothingSym0 + type FooSym1 (t :: [Nat]) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun [Nat] [Nat]) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type TupSym1 (t :: (Nat, Nat)) = Tup t + instance SuppressUnusedWarnings TupSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) TupSym0KindInference) GHC.Tuple.()) + data TupSym0 (l :: TyFun (Nat, Nat) (Nat, Nat)) + = forall arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => + TupSym0KindInference + type instance Apply TupSym0 l = Tup l + type Baz_Sym1 (t :: Maybe Baz) = Baz_ t + instance SuppressUnusedWarnings Baz_Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Baz_Sym0KindInference) GHC.Tuple.()) + data Baz_Sym0 (l :: TyFun (Maybe Baz) (Maybe Baz)) + = forall arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => + Baz_Sym0KindInference + type instance Apply Baz_Sym0 l = Baz_ l + type BarSym1 (t :: Maybe Nat) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = Bar l + type MaybePlusSym1 (t :: Maybe Nat) = MaybePlus t + instance SuppressUnusedWarnings MaybePlusSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MaybePlusSym0KindInference) GHC.Tuple.()) + data MaybePlusSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) + = forall arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => + MaybePlusSym0KindInference + type instance Apply MaybePlusSym0 l = MaybePlus l + type family Foo (a :: [Nat]) :: [Nat] where + Foo '[] = Let0123456789876543210PSym0 + Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 + Foo ((:) wild_0123456789876543210 ((:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 + type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where + Tup '(wild_0123456789876543210, + wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 + type family Baz_ (a :: Maybe Baz) :: Maybe Baz where + Baz_ Nothing = Let0123456789876543210PSym0 + Baz_ (Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 + type family Bar (a :: Maybe Nat) :: Maybe Nat where + Bar (Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 + Bar Nothing = NothingSym0 + type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where + MaybePlus (Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) + MaybePlus Nothing = Let0123456789876543210PSym0 + sFoo :: + forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) + sTup :: + forall (t :: (Nat, Nat)). + Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) + sBaz_ :: + forall (t :: Maybe Baz). + Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) + sBar :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) + sMaybePlus :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) + sFoo SNil + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNil + in sP + sFoo + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + SNil) + = let + sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + SNil + in sP + sFoo + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) + = let + sP :: + Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + sWild_0123456789876543210) + in sP + sTup + (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + = let + sP :: + Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + sWild_0123456789876543210)) + sWild_0123456789876543210 + in sP + sBaz_ SNothing + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNothing + in sP + sBaz_ + (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) + = let + sP :: + Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing ((singFun1 @JustSym0) SJust)) + ((applySing + ((applySing + ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210)) + sWild_0123456789876543210)) + sWild_0123456789876543210) + in sP + sBar + (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + = let + sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) + sX + = (applySing ((singFun1 @JustSym0) SJust)) + sWild_0123456789876543210 + in sX + sBar SNothing = SNothing + sMaybePlus (SJust (sN :: Sing n)) + = (applySing ((singFun1 @JustSym0) SJust)) + ((applySing + ((applySing ((singFun2 @PlusSym0) sPlus)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sN) + sMaybePlus SNothing + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNothing + in sP + data instance Sing (z :: Baz) + where + SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat). + (Sing (n :: Nat)) + -> (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> Sing (Baz n n n) + type SBaz = (Sing :: Baz -> GHC.Types.Type) + instance SingKind Baz where + type Demote Baz = Baz + fromSing (SBaz b b b) + = ((Baz (fromSing b)) (fromSing b)) (fromSing b) + toSing (Baz (b :: Demote Nat) (b :: Demote Nat) (b :: Demote Nat)) + = case + ((GHC.Tuple.(,,) (toSing b :: SomeSing Nat)) + (toSing b :: SomeSing Nat)) + (toSing b :: SomeSing Nat) + of { + GHC.Tuple.(,,) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (((SBaz c) c) c) } + instance (SingI n, SingI n, SingI n) => + SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where + sing = ((SBaz sing) sing) sing diff --git a/tests/compile-and-dump/Singletons/AsPattern.hs b/tests/compile-and-dump/Singletons/AsPattern.hs --- a/tests/compile-and-dump/Singletons/AsPattern.hs +++ b/tests/compile-and-dump/Singletons/AsPattern.hs @@ -1,6 +1,5 @@ module Singletons.AsPattern where -import Data.Proxy import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.Maybe diff --git a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc82.template b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc82.template +++ /dev/null @@ -1,6 +0,0 @@ - -Singletons/BadBoundedDeriving.hs:0:0: error: - Can't derive Bounded instance for Foo_0 a_1. - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template @@ -0,0 +1,6 @@ + +Singletons/BadBoundedDeriving.hs:0:0: error: + Can't derive Bounded instance for Foo_0 a_1. + | +5 | $(singletons [d| + | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/BadBoundedDeriving.hs b/tests/compile-and-dump/Singletons/BadBoundedDeriving.hs --- a/tests/compile-and-dump/Singletons/BadBoundedDeriving.hs +++ b/tests/compile-and-dump/Singletons/BadBoundedDeriving.hs @@ -1,6 +1,5 @@ module Singletons.BadBoundedDeriving where -import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| diff --git a/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc82.template b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc82.template +++ /dev/null @@ -1,6 +0,0 @@ - -Singletons/BadEnumDeriving.hs:0:0: error: - Can't derive Enum instance for Foo_0 a_1. - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc84.template b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc84.template @@ -0,0 +1,6 @@ + +Singletons/BadEnumDeriving.hs:0:0: error: + Can't derive Enum instance for Foo_0 a_1. + | +5 | $(singletons [d| + | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc82.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc82.template +++ /dev/null @@ -1,225 +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 :: a0123456789876543210) = Foo3 t - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 (Foo3 a0123456789876543210)) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3 l - type Foo41Sym0 = Foo41 - type Foo42Sym0 = Foo42 - type PairSym2 (t :: Bool) (t :: Bool) = Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: Bool) (l :: TyFun Bool Pair) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type family MinBound_0123456789876543210 :: Foo1 where - = Foo1Sym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo1 where - = Foo1Sym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Foo1 where - type = MinBound_0123456789876543210Sym0 - type = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo2 where - = ASym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo2 where - = ESym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Foo2 where - type = MinBound_0123456789876543210Sym0 - type = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo3 a where - = Apply Foo3Sym0 MinBoundSym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo3 a where - = Apply Foo3Sym0 MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded (Foo3 a) where - type = MinBound_0123456789876543210Sym0 - type = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo4 a b where - = Foo41Sym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo4 a b where - = Foo42Sym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded (Foo4 a b) where - type = MinBound_0123456789876543210Sym0 - type = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Pair where - = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Pair where - = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Pair where - type = MinBound_0123456789876543210Sym0 - type = MaxBound_0123456789876543210Sym0 - data instance Sing (z :: Foo1) = z ~ Foo1 => SFoo1 - type SFoo1 = (Sing :: Foo1 -> Type) - instance SingKind Foo1 where - type Demote Foo1 = Foo1 - fromSing SFoo1 = Foo1 - toSing Foo1 = SomeSing SFoo1 - data instance Sing (z :: Foo2) - = 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 Demote Foo2 = Foo2 - fromSing SA = A - fromSing SB = B - fromSing SC = C - fromSing SD = D - fromSing SE = E - toSing A = SomeSing SA - toSing B = SomeSing SB - toSing C = SomeSing SC - toSing D = SomeSing SD - toSing E = SomeSing SE - data instance Sing (z :: Foo3 a) - = forall (n :: a). z ~ Foo3 n => SFoo3 (Sing (n :: a)) - type SFoo3 = (Sing :: Foo3 a -> Type) - instance SingKind a => SingKind (Foo3 a) where - type Demote (Foo3 a) = Foo3 (Demote a) - fromSing (SFoo3 b) = Foo3 (fromSing b) - toSing (Foo3 b) - = 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 Demote (Foo4 a b) = Foo4 (Demote a) (Demote b) - fromSing SFoo41 = Foo41 - fromSing SFoo42 = Foo42 - toSing Foo41 = SomeSing SFoo41 - toSing Foo42 = SomeSing SFoo42 - data instance Sing (z :: Pair) - = 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 Demote 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 = SFoo1 - sMaxBound = SFoo1 - instance SBounded Foo2 where - sMinBound :: Sing (MinBoundSym0 :: Foo2) - sMaxBound :: Sing (MaxBoundSym0 :: Foo2) - sMinBound = SA - sMaxBound = SE - instance SBounded a => SBounded (Foo3 a) where - sMinBound :: Sing (MinBoundSym0 :: Foo3 a) - sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) - sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound - sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound - instance SBounded (Foo4 a b) where - sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) - sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) - sMinBound = SFoo41 - sMaxBound = SFoo42 - instance SBounded Bool => SBounded Pair where - sMinBound :: Sing (MinBoundSym0 :: Pair) - sMaxBound :: Sing (MaxBoundSym0 :: Pair) - sMinBound - = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound)) - sMinBound - sMaxBound - = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound)) - sMaxBound - instance SingI Foo1 where - sing = SFoo1 - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI C where - sing = SC - instance SingI D where - sing = SD - instance SingI E where - sing = SE - instance SingI n => SingI (Foo3 (n :: a)) where - sing = SFoo3 sing - instance SingI Foo41 where - sing = SFoo41 - instance SingI Foo42 where - sing = SFoo42 - instance (SingI n, SingI n) => - SingI (Pair (n :: Bool) (n :: Bool)) where - sing = (SPair sing) sing diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc84.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc84.template @@ -0,0 +1,229 @@ +Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo1 + = Foo1 + deriving Bounded + data Foo2 + = A | B | C | D | E + deriving Bounded + data Foo3 a + = Foo3 a + deriving Bounded + data Foo4 (a :: Type) (b :: Type) + = Foo41 | Foo42 + deriving Bounded + data Pair + = Pair Bool Bool + deriving Bounded |] + ======> + data Foo1 + = Foo1 + deriving Bounded + data Foo2 + = A | B | C | D | E + deriving Bounded + data Foo3 a + = Foo3 a + deriving Bounded + data Foo4 (a :: Type) (b :: Type) + = Foo41 | Foo42 + deriving Bounded + data Pair + = Pair Bool Bool + deriving Bounded + type Foo1Sym0 = Foo1 + type ASym0 = A + type BSym0 = B + type CSym0 = C + type DSym0 = D + type ESym0 = E + type Foo3Sym1 (t :: a0123456789876543210) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789876543210 (Foo3 a0123456789876543210)) + = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3 l + type Foo41Sym0 = Foo41 + type Foo42Sym0 = Foo42 + type PairSym2 (t :: Bool) (t :: Bool) = Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) + data PairSym1 (l :: Bool) (l :: TyFun Bool Pair) + = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = Pair l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) + data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type)) + = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type family MinBound_0123456789876543210 :: Foo1 where + MinBound_0123456789876543210 = Foo1Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo1 where + MaxBound_0123456789876543210 = Foo1Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Foo1 where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo2 where + MinBound_0123456789876543210 = ASym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo2 where + MaxBound_0123456789876543210 = ESym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Foo2 where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo3 a where + MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo3 a where + MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded (Foo3 a) where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo4 a b where + MinBound_0123456789876543210 = Foo41Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo4 a b where + MaxBound_0123456789876543210 = Foo42Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded (Foo4 a b) where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Pair where + MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Pair where + MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Pair where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + data instance Sing (z :: Foo1) where SFoo1 :: Sing Foo1 + type SFoo1 = (Sing :: Foo1 -> Type) + instance SingKind Foo1 where + type Demote Foo1 = Foo1 + fromSing SFoo1 = Foo1 + toSing Foo1 = SomeSing SFoo1 + data instance Sing (z :: Foo2) + where + SA :: Sing A + SB :: Sing B + SC :: Sing C + SD :: Sing D + SE :: Sing E + type SFoo2 = (Sing :: Foo2 -> Type) + instance SingKind Foo2 where + type Demote Foo2 = Foo2 + fromSing SA = A + fromSing SB = B + fromSing SC = C + fromSing SD = D + fromSing SE = E + toSing A = SomeSing SA + toSing B = SomeSing SB + toSing C = SomeSing SC + toSing D = SomeSing SD + toSing E = SomeSing SE + data instance Sing (z :: Foo3 a) + where SFoo3 :: forall (n :: a). (Sing (n :: a)) -> Sing (Foo3 n) + type SFoo3 = (Sing :: Foo3 a -> Type) + instance SingKind a => SingKind (Foo3 a) where + type Demote (Foo3 a) = Foo3 (Demote a) + fromSing (SFoo3 b) = Foo3 (fromSing b) + toSing (Foo3 (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SFoo3 c) } + data instance Sing (z :: Foo4 a b) + where + SFoo41 :: Sing Foo41 + SFoo42 :: Sing Foo42 + type SFoo4 = (Sing :: Foo4 a b -> Type) + instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where + type Demote (Foo4 a b) = Foo4 (Demote a) (Demote b) + fromSing SFoo41 = Foo41 + fromSing SFoo42 = Foo42 + toSing Foo41 = SomeSing SFoo41 + toSing Foo42 = SomeSing SFoo42 + data instance Sing (z :: Pair) + where + SPair :: forall (n :: Bool) (n :: Bool). + (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Pair n n) + type SPair = (Sing :: Pair -> Type) + instance SingKind Pair where + type Demote Pair = Pair + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote Bool) (b :: Demote Bool)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) + (toSing b :: SomeSing Bool) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance SBounded Foo1 where + sMinBound :: Sing (MinBoundSym0 :: Foo1) + sMaxBound :: Sing (MaxBoundSym0 :: Foo1) + sMinBound = SFoo1 + sMaxBound = SFoo1 + instance SBounded Foo2 where + sMinBound :: Sing (MinBoundSym0 :: Foo2) + sMaxBound :: Sing (MaxBoundSym0 :: Foo2) + sMinBound = SA + sMaxBound = SE + instance SBounded a => SBounded (Foo3 a) where + sMinBound :: Sing (MinBoundSym0 :: Foo3 a) + sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) + sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound + sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound + instance SBounded (Foo4 a b) where + sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) + sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) + sMinBound = SFoo41 + sMaxBound = SFoo42 + instance SBounded Bool => SBounded Pair where + sMinBound :: Sing (MinBoundSym0 :: Pair) + sMaxBound :: Sing (MaxBoundSym0 :: Pair) + sMinBound + = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound)) + sMinBound + sMaxBound + = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound)) + sMaxBound + instance SingI Foo1 where + sing = SFoo1 + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI C where + sing = SC + instance SingI D where + sing = SD + instance SingI E where + sing = SE + instance SingI n => SingI (Foo3 (n :: a)) where + sing = SFoo3 sing + instance SingI Foo41 where + sing = SFoo41 + instance SingI Foo42 where + sing = SFoo42 + instance (SingI n, SingI n) => + SingI (Pair (n :: Bool) (n :: Bool)) where + sing = (SPair sing) sing diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.hs b/tests/compile-and-dump/Singletons/BoundedDeriving.hs --- a/tests/compile-and-dump/Singletons/BoundedDeriving.hs +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.hs @@ -8,7 +8,7 @@ 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 Foo4 (a :: Type) (b :: Type) = Foo41 | Foo42 deriving Bounded data Pair = Pair Bool Bool deriving Bounded diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.ghc82.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BoxUnBox.ghc82.template +++ /dev/null @@ -1,42 +0,0 @@ -Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| unBox :: Box a -> a - unBox (FBox a) = a - - data Box a = FBox a |] - ======> - data Box a = FBox a - unBox :: Box a -> a - unBox (FBox a) = a - type FBoxSym1 (t :: a0123456789876543210) = FBox t - instance SuppressUnusedWarnings FBoxSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FBoxSym0KindInference) GHC.Tuple.()) - data FBoxSym0 (l :: TyFun a0123456789876543210 (Box a0123456789876543210)) - = forall arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => - FBoxSym0KindInference - type instance Apply FBoxSym0 l = FBox l - type UnBoxSym1 (t :: Box a0123456789876543210) = UnBox t - instance SuppressUnusedWarnings UnBoxSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) UnBoxSym0KindInference) GHC.Tuple.()) - data UnBoxSym0 (l :: TyFun (Box a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => - UnBoxSym0KindInference - type instance Apply UnBoxSym0 l = UnBox l - type family UnBox (a :: Box a) :: a where - UnBox (FBox a) = a - sUnBox :: - forall (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a) - sUnBox (SFBox (sA :: Sing a)) = sA - data instance Sing (z :: Box a) - = 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 Demote (Box a) = Box (Demote 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 diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.template @@ -0,0 +1,42 @@ +Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| unBox :: Box a -> a + unBox (FBox a) = a + + data Box a = FBox a |] + ======> + data Box a = FBox a + unBox :: Box a -> a + unBox (FBox a) = a + type FBoxSym1 (t :: a0123456789876543210) = FBox t + instance SuppressUnusedWarnings FBoxSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FBoxSym0KindInference) GHC.Tuple.()) + data FBoxSym0 (l :: TyFun a0123456789876543210 (Box a0123456789876543210)) + = forall arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => + FBoxSym0KindInference + type instance Apply FBoxSym0 l = FBox l + type UnBoxSym1 (t :: Box a0123456789876543210) = UnBox t + instance SuppressUnusedWarnings UnBoxSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) UnBoxSym0KindInference) GHC.Tuple.()) + data UnBoxSym0 (l :: TyFun (Box a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => + UnBoxSym0KindInference + type instance Apply UnBoxSym0 l = UnBox l + type family UnBox (a :: Box a) :: a where + UnBox (FBox a) = a + sUnBox :: + forall (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a) + sUnBox (SFBox (sA :: Sing a)) = sA + data instance Sing (z :: Box a) + where SFBox :: forall (n :: a). (Sing (n :: a)) -> Sing (FBox n) + type SBox = (Sing :: Box a -> GHC.Types.Type) + instance SingKind a => SingKind (Box a) where + type Demote (Box a) = Box (Demote a) + fromSing (SFBox b) = FBox (fromSing b) + toSing (FBox (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SFBox c) } + instance SingI n => SingI (FBox (n :: a)) where + sing = SFBox sing diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.hs b/tests/compile-and-dump/Singletons/BoxUnBox.hs --- a/tests/compile-and-dump/Singletons/BoxUnBox.hs +++ b/tests/compile-and-dump/Singletons/BoxUnBox.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.BoxUnBox where diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc82.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/CaseExpressions.ghc82.template +++ /dev/null @@ -1,273 +0,0 @@ -Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo1 :: a -> Maybe a -> a - foo1 d x - = case x of - Just y -> y - Nothing -> d - foo2 :: a -> Maybe a -> a - foo2 d _ = case (Just d) of { Just y -> y } - foo3 :: a -> b -> a - foo3 a b = case (a, b) of { (p, _) -> p } - foo4 :: forall a. a -> a - foo4 x - = case x of { - y -> let - z :: a - z = y - in z } - foo5 :: a -> a - foo5 x = case x of { y -> (\ _ -> x) y } |] - ======> - foo1 :: a -> Maybe a -> a - foo1 d x - = case x of - Just y -> y - Nothing -> d - foo2 :: a -> Maybe a -> a - foo2 d _ = case Just d of { Just y -> y } - foo3 :: a -> b -> a - foo3 a b = case (a, b) of { (p, _) -> p } - foo4 :: forall a. a -> a - foo4 x - = case x of { - y -> let - z :: a - z = y - in z } - foo5 :: a -> a - foo5 x = case x of { y -> (\ _ -> x) y } - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _z_0123456789876543210 = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t - instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => - Let0123456789876543210ZSym1KindInference - type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l - type family Let0123456789876543210Z x y :: a where - Let0123456789876543210Z x y = y - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y - type Let0123456789876543210Scrutinee_0123456789876543210Sym2 t t = - Let0123456789876543210Scrutinee_0123456789876543210 t t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l - type family Let0123456789876543210Scrutinee_0123456789876543210 a b where - Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b - type family Case_0123456789876543210 a b t where - Case_0123456789876543210 a b '(p, _z_0123456789876543210) = p - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 t = - Let0123456789876543210Scrutinee_0123456789876543210 t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l - type family Let0123456789876543210Scrutinee_0123456789876543210 d where - Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d - type family Case_0123456789876543210 d t where - Case_0123456789876543210 d (Just y) = y - type family Case_0123456789876543210 d x t where - Case_0123456789876543210 d x (Just y) = y - Case_0123456789876543210 d x Nothing = d - type Foo5Sym1 (t :: a0123456789876543210) = Foo5 t - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) - data Foo5Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0KindInference - type instance Apply Foo5Sym0 l = Foo5 l - type Foo4Sym1 (t :: a0123456789876543210) = Foo4 t - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) - data Foo4Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0KindInference - type instance Apply Foo4Sym0 l = Foo4 l - type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo3 t t - instance SuppressUnusedWarnings Foo3Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.()) - data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) => - Foo3Sym1KindInference - type instance Apply (Foo3Sym1 l) l = Foo3 l l - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo2 t t - instance SuppressUnusedWarnings Foo2Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) - data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => - Foo2Sym1KindInference - type instance Apply (Foo2Sym1 l) l = Foo2 l l - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo1 t t - instance SuppressUnusedWarnings Foo1Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) - data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => - Foo1Sym1KindInference - type instance Apply (Foo1Sym1 l) l = Foo1 l l - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1Sym1 l - type family Foo5 (a :: a) :: a where - Foo5 x = Case_0123456789876543210 x x - type family Foo4 (a :: a) :: a where - Foo4 x = Case_0123456789876543210 x x - type family Foo3 (a :: a) (a :: b) :: a where - Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) - type family Foo2 (a :: a) (a :: Maybe a) :: a where - Foo2 d _z_0123456789876543210 = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) - type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Case_0123456789876543210 d x x - sFoo5 :: forall (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) - sFoo4 :: forall (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) - sFoo3 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) - sFoo2 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) - sFoo1 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) - sFoo5 (sX :: Sing x) - = case sX of { - sY :: Sing y - -> (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) - sY } :: - Sing (Case_0123456789876543210 x x :: a) - sFoo4 (sX :: Sing x) - = case sX of { - sY :: Sing y - -> let - sZ :: Sing (Let0123456789876543210ZSym2 x y :: a) - sZ = sY - in sZ } :: - Sing (Case_0123456789876543210 x x :: a) - sFoo3 (sA :: Sing a) (sB :: Sing b) - = let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) - sScrutinee_0123456789876543210 - = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB - in case sScrutinee_0123456789876543210 of { - STuple2 (sP :: Sing p) _ -> sP } :: - Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) :: a) - sFoo2 (sD :: Sing d) _ - = let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) - sScrutinee_0123456789876543210 - = (applySing ((singFun1 @JustSym0) SJust)) sD - in case sScrutinee_0123456789876543210 of { - SJust (sY :: Sing y) -> sY } :: - Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) :: a) - sFoo1 (sD :: Sing d) (sX :: Sing x) - = case sX of - SJust (sY :: Sing y) -> sY - SNothing -> sD :: - Sing (Case_0123456789876543210 d x x :: a) diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.template @@ -0,0 +1,273 @@ +Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = case x of + Just y -> y + Nothing -> d + foo2 :: a -> Maybe a -> a + foo2 d _ = case (Just d) of { Just y -> y } + foo3 :: a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: a -> a + foo5 x = case x of { y -> (\ _ -> x) y } |] + ======> + foo1 :: a -> Maybe a -> a + foo1 d x + = case x of + Just y -> y + Nothing -> d + foo2 :: a -> Maybe a -> a + foo2 d _ = case Just d of { Just y -> y } + foo3 :: a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: a -> a + foo5 x = case x of { y -> (\ _ -> x) y } + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t + instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => + Let0123456789876543210ZSym1KindInference + type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l + type family Let0123456789876543210Z x y :: a where + Let0123456789876543210Z x y = y + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y + type Let0123456789876543210Scrutinee_0123456789876543210Sym2 t t = + Let0123456789876543210Scrutinee_0123456789876543210 t t + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l + type family Let0123456789876543210Scrutinee_0123456789876543210 a b where + Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b + type family Case_0123456789876543210 a b t where + Case_0123456789876543210 a b '(p, _) = p + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 t = + Let0123456789876543210Scrutinee_0123456789876543210 t + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l + type family Let0123456789876543210Scrutinee_0123456789876543210 d where + Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d + type family Case_0123456789876543210 d t where + Case_0123456789876543210 d (Just y) = y + type family Case_0123456789876543210 d x t where + Case_0123456789876543210 d x (Just y) = y + Case_0123456789876543210 d x Nothing = d + type Foo5Sym1 (t :: a0123456789876543210) = Foo5 t + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5 l + type Foo4Sym1 (t :: a0123456789876543210) = Foo4 t + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4 l + type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo3 t t + instance SuppressUnusedWarnings Foo3Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.()) + data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) => + Foo3Sym1KindInference + type instance Apply (Foo3Sym1 l) l = Foo3 l l + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = + Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = + Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type family Foo5 (a :: a) :: a where + Foo5 x = Case_0123456789876543210 x x + type family Foo4 (a :: a) :: a where + Foo4 x = Case_0123456789876543210 x x + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _ = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Case_0123456789876543210 d x x + sFoo5 :: forall (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) + sFoo4 :: forall (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) + sFoo3 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo5 (sX :: Sing x) + = case sX of { + sY :: Sing y + -> (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sX } :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY } :: + Sing (Case_0123456789876543210 x x :: a) + sFoo4 (sX :: Sing x) + = case sX of { + sY :: Sing y + -> let + sZ :: Sing (Let0123456789876543210ZSym2 x y :: a) + sZ = sY + in sZ } :: + Sing (Case_0123456789876543210 x x :: a) + sFoo3 (sA :: Sing a) (sB :: Sing b) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB + in case sScrutinee_0123456789876543210 of { + STuple2 (sP :: Sing p) _ -> sP } :: + Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) :: a) + sFoo2 (sD :: Sing d) _ + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) + sScrutinee_0123456789876543210 + = (applySing ((singFun1 @JustSym0) SJust)) sD + in case sScrutinee_0123456789876543210 of { + SJust (sY :: Sing y) -> sY } :: + Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) :: a) + sFoo1 (sD :: Sing d) (sX :: Sing x) + = case sX of + SJust (sY :: Sing y) -> sY + SNothing -> sD :: + Sing (Case_0123456789876543210 d x x :: a) diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.hs b/tests/compile-and-dump/Singletons/CaseExpressions.hs --- a/tests/compile-and-dump/Singletons/CaseExpressions.hs +++ b/tests/compile-and-dump/Singletons/CaseExpressions.hs @@ -1,5 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.CaseExpressions where diff --git a/tests/compile-and-dump/Singletons/Classes.ghc82.template b/tests/compile-and-dump/Singletons/Classes.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Classes.ghc82.template +++ /dev/null @@ -1,529 +0,0 @@ -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infix 4 <=> - - const :: a -> b -> a - const x _ = x - fooCompare :: Foo -> Foo -> Ordering - fooCompare A A = EQ - fooCompare A B = LT - fooCompare B B = GT - fooCompare B A = EQ - - class MyOrd a where - mycompare :: a -> a -> Ordering - (<=>) :: a -> a -> Ordering - (<=>) = mycompare - infix 4 <=> - data Foo = A | B - data Foo2 = F | G - - instance MyOrd () where - mycompare _ = const EQ - instance MyOrd Nat where - Zero `mycompare` Zero = EQ - Zero `mycompare` (Succ _) = LT - (Succ _) `mycompare` Zero = GT - (Succ n) `mycompare` (Succ m) = m `mycompare` n - instance MyOrd Foo where - mycompare = fooCompare - instance Eq Foo2 where - F == F = True - G == G = True - F == G = False - G == F = False |] - ======> - const :: a -> b -> a - const x _ = x - class MyOrd a where - mycompare :: a -> a -> Ordering - (<=>) :: a -> a -> Ordering - (<=>) = mycompare - infix 4 <=> - instance MyOrd Nat where - mycompare Zero Zero = EQ - mycompare Zero (Succ _) = LT - mycompare (Succ _) Zero = GT - mycompare (Succ n) (Succ m) = (m `mycompare` n) - instance MyOrd () where - mycompare _ = const EQ - data Foo = A | B - fooCompare :: Foo -> Foo -> Ordering - fooCompare A A = EQ - fooCompare A B = LT - fooCompare B B = GT - fooCompare B A = EQ - instance MyOrd Foo where - mycompare = fooCompare - data Foo2 = F | G - instance Eq Foo2 where - (==) F F = True - (==) G G = True - (==) F G = False - (==) G F = False - type ASym0 = A - type BSym0 = B - type FSym0 = F - type GSym0 = G - type FooCompareSym2 (t :: Foo) (t :: Foo) = FooCompare t t - instance SuppressUnusedWarnings FooCompareSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooCompareSym1KindInference) GHC.Tuple.()) - data FooCompareSym1 (l :: Foo) (l :: TyFun Foo Ordering) - = forall arg. SameKind (Apply (FooCompareSym1 l) arg) (FooCompareSym2 l arg) => - FooCompareSym1KindInference - type instance Apply (FooCompareSym1 l) l = FooCompare l l - instance SuppressUnusedWarnings FooCompareSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooCompareSym0KindInference) GHC.Tuple.()) - data FooCompareSym0 (l :: TyFun Foo (TyFun Foo Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => - FooCompareSym0KindInference - type instance Apply FooCompareSym0 l = FooCompareSym1 l - type ConstSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Const t t - instance SuppressUnusedWarnings ConstSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ConstSym1KindInference) GHC.Tuple.()) - data ConstSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (ConstSym1 l) arg) (ConstSym2 l arg) => - ConstSym1KindInference - type instance Apply (ConstSym1 l) l = Const l l - instance SuppressUnusedWarnings ConstSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ConstSym0KindInference) GHC.Tuple.()) - data ConstSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => - ConstSym0KindInference - type instance Apply ConstSym0 l = ConstSym1 l - type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where - FooCompare A A = EQSym0 - FooCompare A B = LTSym0 - FooCompare B B = GTSym0 - FooCompare B A = EQSym0 - type family Const (a :: a) (a :: b) :: a where - Const x _z_0123456789876543210 = x - infix 4 :<=> - type MycompareSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - Mycompare t t - instance SuppressUnusedWarnings MycompareSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MycompareSym1KindInference) GHC.Tuple.()) - data MycompareSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply (MycompareSym1 l) arg) (MycompareSym2 l arg) => - MycompareSym1KindInference - type instance Apply (MycompareSym1 l) l = Mycompare l l - instance SuppressUnusedWarnings MycompareSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MycompareSym0KindInference) GHC.Tuple.()) - data MycompareSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => - MycompareSym0KindInference - type instance Apply MycompareSym0 l = MycompareSym1 l - type (:<=>$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (:<=>) t t - instance SuppressUnusedWarnings (:<=>$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:<=>$$###)) GHC.Tuple.()) - data (:<=>$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply ((:<=>$$) l) arg) ((:<=>$$$) l arg) => - (:<=>$$###) - type instance Apply ((:<=>$$) l) l = (:<=>) l l - instance SuppressUnusedWarnings (:<=>$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:<=>$###)) GHC.Tuple.()) - data (:<=>$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:<=>$) arg) ((:<=>$$) arg) => - (:<=>$###) - type instance Apply (:<=>$) l = (:<=>$$) l - type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where - TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 - type TFHelper_0123456789876543210Sym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - TFHelper_0123456789876543210 t t - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => - TFHelper_0123456789876543210Sym1KindInference - type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0KindInference - type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l - class PMyOrd (a :: GHC.Types.Type) where - type Mycompare (arg :: a) (arg :: a) :: Ordering - type (:<=>) (arg :: a) (arg :: a) :: Ordering - type (:<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Mycompare_0123456789876543210 Zero Zero = EQSym0 - Mycompare_0123456789876543210 Zero (Succ _z_0123456789876543210) = LTSym0 - Mycompare_0123456789876543210 (Succ _z_0123456789876543210) Zero = GTSym0 - Mycompare_0123456789876543210 (Succ n) (Succ m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Nat where - type Mycompare (a :: Nat) (a :: Nat) = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where - Mycompare_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (t :: ()) (t :: ()) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: ()) (l :: TyFun () Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun () (TyFun () Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd () where - type Mycompare (a :: ()) (a :: ()) = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where - Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (t :: Foo) (t :: Foo) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Foo) (l :: TyFun Foo Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo (TyFun Foo Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Foo where - type Mycompare (a :: Foo) (a :: Foo) = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where - TFHelper_0123456789876543210 F F = TrueSym0 - TFHelper_0123456789876543210 G G = TrueSym0 - TFHelper_0123456789876543210 F G = FalseSym0 - TFHelper_0123456789876543210 G F = FalseSym0 - type TFHelper_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - TFHelper_0123456789876543210 t t - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool) - = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => - TFHelper_0123456789876543210Sym1KindInference - type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool - -> GHC.Types.Type)) - = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0KindInference - type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l - instance PEq Foo2 where - type (:==) (a :: Foo2) (a :: Foo2) = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - infix 4 %:<=> - sFooCompare :: - forall (t :: Foo) (t :: Foo). - Sing t - -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) - sConst :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) - sFooCompare SA SA = SEQ - sFooCompare SA SB = SLT - sFooCompare SB SB = SGT - sFooCompare SB SA = SEQ - sConst (sX :: Sing x) _ = sX - data instance Sing (z :: Foo) = z ~ A => SA | z ~ B => SB - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing SA = A - fromSing SB = B - toSing A = SomeSing SA - toSing B = SomeSing SB - data instance Sing (z :: Foo2) = z ~ F => SF | z ~ G => SG - type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) - instance SingKind Foo2 where - type Demote Foo2 = Foo2 - fromSing SF = F - fromSing SG = G - toSing F = SomeSing SF - toSing G = SomeSing SG - class SMyOrd a where - sMycompare :: - forall (t :: a) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - (%:<=>) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) - default (%:<=>) :: - forall (t :: a) (t :: a). - (Apply (Apply (:<=>$) t) t :: Ordering) ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t => - Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) - (%:<=>) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) - sA_0123456789876543210)) - sA_0123456789876543210 - instance SMyOrd Nat where - sMycompare :: - forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare SZero SZero = SEQ - sMycompare SZero (SSucc _) = SLT - sMycompare (SSucc _) SZero = SGT - sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m)) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) - sN - instance SMyOrd () where - sMycompare :: - forall (t :: ()) (t :: ()). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ)) - sA_0123456789876543210 - instance SMyOrd Foo where - sMycompare :: - forall (t :: Foo) (t :: Foo). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @FooCompareSym0) sFooCompare)) - sA_0123456789876543210)) - sA_0123456789876543210 - instance SEq Foo2 where - (%:==) :: - forall (a :: Foo2) (b :: Foo2). - Sing a -> Sing b -> Sing ((:==) a b) - (%:==) SF SF = STrue - (%:==) SG SG = STrue - (%:==) SF SG = SFalse - (%:==) SG SF = SFalse - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI F where - sing = SF - instance SingI G where - sing = SG -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - promote - [d| instance Ord Foo2 where - F `compare` F = EQ - F `compare` _ = LT - _ `compare` _ = GT - instance MyOrd Foo2 where - F `mycompare` F = EQ - F `mycompare` _ = LT - _ `mycompare` _ = GT |] - ======> - instance MyOrd Foo2 where - mycompare F F = EQ - mycompare F _ = LT - mycompare _ _ = GT - instance Ord Foo2 where - compare F F = EQ - compare F _ = LT - compare _ _ = GT - type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Mycompare_0123456789876543210 F F = EQSym0 - Mycompare_0123456789876543210 F _z_0123456789876543210 = LTSym0 - Mycompare_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 = GTSym0 - type Mycompare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Foo2 where - type Mycompare (a :: Foo2) (a :: Foo2) = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Compare_0123456789876543210 F F = EQSym0 - Compare_0123456789876543210 F _z_0123456789876543210 = LTSym0 - Compare_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Foo2 where - type Compare (a :: Foo2) (a :: Foo2) = Apply (Apply Compare_0123456789876543210Sym0 a) a -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Nat' = Zero' | Succ' Nat' - - instance MyOrd Nat' where - Zero' `mycompare` Zero' = EQ - Zero' `mycompare` (Succ' _) = LT - (Succ' _) `mycompare` Zero' = GT - (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] - ======> - data Nat' = Zero' | Succ' Nat' - instance MyOrd Nat' where - mycompare Zero' Zero' = EQ - mycompare Zero' (Succ' _) = LT - mycompare (Succ' _) Zero' = GT - mycompare (Succ' n) (Succ' m) = (m `mycompare` n) - type Zero'Sym0 = Zero' - type Succ'Sym1 (t :: Nat') = Succ' t - instance SuppressUnusedWarnings Succ'Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Succ'Sym0KindInference) GHC.Tuple.()) - data Succ'Sym0 (l :: TyFun Nat' Nat') - = forall arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => - Succ'Sym0KindInference - type instance Apply Succ'Sym0 l = Succ' l - type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where - Mycompare_0123456789876543210 Zero' Zero' = EQSym0 - Mycompare_0123456789876543210 Zero' (Succ' _z_0123456789876543210) = LTSym0 - Mycompare_0123456789876543210 (Succ' _z_0123456789876543210) Zero' = GTSym0 - Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (t :: Nat') (t :: Nat') = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Nat') (l :: TyFun Nat' Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Nat' where - type Mycompare (a :: Nat') (a :: Nat') = Apply (Apply Mycompare_0123456789876543210Sym0 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 Demote 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' = SEQ - sMycompare SZero' (SSucc' _) = SLT - sMycompare (SSucc' _) SZero' = SGT - sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m)) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) - sN - instance SingI Zero' where - sing = SZero' - instance SingI n => SingI (Succ' (n :: Nat')) where - sing = SSucc' sing diff --git a/tests/compile-and-dump/Singletons/Classes.ghc84.template b/tests/compile-and-dump/Singletons/Classes.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes.ghc84.template @@ -0,0 +1,533 @@ +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 <=> + + const :: a -> b -> a + const x _ = x + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + data Foo = A | B + data Foo2 = F | G + + instance MyOrd () where + mycompare _ = const EQ + instance MyOrd Nat where + Zero `mycompare` Zero = EQ + Zero `mycompare` (Succ _) = LT + (Succ _) `mycompare` Zero = GT + (Succ n) `mycompare` (Succ m) = m `mycompare` n + instance MyOrd Foo where + mycompare = fooCompare + instance Eq Foo2 where + F == F = True + G == G = True + F == G = False + G == F = False |] + ======> + const :: a -> b -> a + const x _ = x + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + instance MyOrd Nat where + mycompare Zero Zero = EQ + mycompare Zero (Succ _) = LT + mycompare (Succ _) Zero = GT + mycompare (Succ n) (Succ m) = (m `mycompare` n) + instance MyOrd () where + mycompare _ = const EQ + data Foo = A | B + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + instance MyOrd Foo where + mycompare = fooCompare + data Foo2 = F | G + instance Eq Foo2 where + (==) F F = True + (==) G G = True + (==) F G = False + (==) G F = False + type ASym0 = A + type BSym0 = B + type FSym0 = F + type GSym0 = G + type FooCompareSym2 (t :: Foo) (t :: Foo) = FooCompare t t + instance SuppressUnusedWarnings FooCompareSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooCompareSym1KindInference) GHC.Tuple.()) + data FooCompareSym1 (l :: Foo) (l :: TyFun Foo Ordering) + = forall arg. SameKind (Apply (FooCompareSym1 l) arg) (FooCompareSym2 l arg) => + FooCompareSym1KindInference + type instance Apply (FooCompareSym1 l) l = FooCompare l l + instance SuppressUnusedWarnings FooCompareSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooCompareSym0KindInference) GHC.Tuple.()) + data FooCompareSym0 (l :: TyFun Foo (TyFun Foo Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => + FooCompareSym0KindInference + type instance Apply FooCompareSym0 l = FooCompareSym1 l + type ConstSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Const t t + instance SuppressUnusedWarnings ConstSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ConstSym1KindInference) GHC.Tuple.()) + data ConstSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (ConstSym1 l) arg) (ConstSym2 l arg) => + ConstSym1KindInference + type instance Apply (ConstSym1 l) l = Const l l + instance SuppressUnusedWarnings ConstSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ConstSym0KindInference) GHC.Tuple.()) + data ConstSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => + ConstSym0KindInference + type instance Apply ConstSym0 l = ConstSym1 l + type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where + FooCompare A A = EQSym0 + FooCompare A B = LTSym0 + FooCompare B B = GTSym0 + FooCompare B A = EQSym0 + type family Const (a :: a) (a :: b) :: a where + Const x _ = x + type MycompareSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = + Mycompare t t + instance SuppressUnusedWarnings MycompareSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MycompareSym1KindInference) GHC.Tuple.()) + data MycompareSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) + = forall arg. SameKind (Apply (MycompareSym1 l) arg) (MycompareSym2 l arg) => + MycompareSym1KindInference + type instance Apply (MycompareSym1 l) l = Mycompare l l + instance SuppressUnusedWarnings MycompareSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MycompareSym0KindInference) GHC.Tuple.()) + data MycompareSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => + MycompareSym0KindInference + type instance Apply MycompareSym0 l = MycompareSym1 l + type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = + (<=>) t t + instance SuppressUnusedWarnings (<=>@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.()) + data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) + = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) => + (:<=>@#@$$###) + type instance Apply ((<=>@#@$$) l) l = (<=>) l l + instance SuppressUnusedWarnings (<=>@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.()) + data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => + (:<=>@#@$###) + type instance Apply (<=>@#@$) l = (<=>@#@$$) l + type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where + TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 + type TFHelper_0123456789876543210Sym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = + TFHelper_0123456789876543210 t t + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data TFHelper_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) + = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => + TFHelper_0123456789876543210Sym1KindInference + type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data TFHelper_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0KindInference + type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l + class PMyOrd (a :: GHC.Types.Type) where + type Mycompare (arg :: a) (arg :: a) :: Ordering + type (<=>) (arg :: a) (arg :: a) :: Ordering + type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Mycompare_0123456789876543210 Zero Zero = EQSym0 + Mycompare_0123456789876543210 Zero (Succ _) = LTSym0 + Mycompare_0123456789876543210 (Succ _) Zero = GTSym0 + Mycompare_0123456789876543210 (Succ n) (Succ m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd Nat where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where + Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 + type Mycompare_0123456789876543210Sym2 (t :: ()) (t :: ()) = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: ()) (l :: TyFun () Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun () (TyFun () Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd () where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where + Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 + type Mycompare_0123456789876543210Sym2 (t :: Foo) (t :: Foo) = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: Foo) (l :: TyFun Foo Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo (TyFun Foo Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd Foo where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where + TFHelper_0123456789876543210 F F = TrueSym0 + TFHelper_0123456789876543210 G G = TrueSym0 + TFHelper_0123456789876543210 F G = FalseSym0 + TFHelper_0123456789876543210 G F = FalseSym0 + type TFHelper_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = + TFHelper_0123456789876543210 t t + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data TFHelper_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool) + = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => + TFHelper_0123456789876543210Sym1KindInference + type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data TFHelper_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool + -> GHC.Types.Type)) + = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0KindInference + type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l + instance PEq Foo2 where + type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + infix 4 %<=> + sFooCompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + sConst :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) + sFooCompare SA SA = SEQ + sFooCompare SA SB = SLT + sFooCompare SB SB = SGT + sFooCompare SB SA = SEQ + sConst (sX :: Sing x) _ = sX + data instance Sing (z :: Foo) + where + SA :: Sing A + SB :: Sing B + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SA = A + fromSing SB = B + toSing A = SomeSing SA + toSing B = SomeSing SB + data instance Sing (z :: Foo2) + where + SF :: Sing F + SG :: Sing G + type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) + instance SingKind Foo2 where + type Demote Foo2 = Foo2 + fromSing SF = F + fromSing SG = G + toSing F = SomeSing SF + toSing G = SomeSing SG + class SMyOrd a where + sMycompare :: + forall (t :: a) (t :: a). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + (%<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) + default (%<=>) :: + forall (t :: a) (t :: a). + (Apply (Apply (<=>@#@$) t) t :: Ordering) ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) + (%<=>) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SMyOrd Nat where + sMycompare :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare SZero SZero = SEQ + sMycompare SZero (SSucc _) = SLT + sMycompare (SSucc _) SZero = SGT + sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SMyOrd () where + sMycompare :: + forall (t :: ()) (t :: ()). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ)) + sA_0123456789876543210 + instance SMyOrd Foo where + sMycompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @FooCompareSym0) sFooCompare)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SEq Foo2 where + (%==) :: + forall (a :: Foo2) (b :: Foo2). Sing a -> Sing b -> Sing ((==) a b) + (%==) SF SF = STrue + (%==) SG SG = STrue + (%==) SF SG = SFalse + (%==) SG SF = SFalse + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI F where + sing = SF + instance SingI G where + sing = SG +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| instance Ord Foo2 where + F `compare` F = EQ + F `compare` _ = LT + _ `compare` _ = GT + instance MyOrd Foo2 where + F `mycompare` F = EQ + F `mycompare` _ = LT + _ `mycompare` _ = GT |] + ======> + instance MyOrd Foo2 where + mycompare F F = EQ + mycompare F _ = LT + mycompare _ _ = GT + instance Ord Foo2 where + compare F F = EQ + compare F _ = LT + compare _ _ = GT + type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where + Mycompare_0123456789876543210 F F = EQSym0 + Mycompare_0123456789876543210 F _ = LTSym0 + Mycompare_0123456789876543210 _ _ = GTSym0 + type Mycompare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd Foo2 where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where + Compare_0123456789876543210 F F = EQSym0 + Compare_0123456789876543210 F _ = LTSym0 + Compare_0123456789876543210 _ _ = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Foo2 where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat' = Zero' | Succ' Nat' + + instance MyOrd Nat' where + Zero' `mycompare` Zero' = EQ + Zero' `mycompare` (Succ' _) = LT + (Succ' _) `mycompare` Zero' = GT + (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] + ======> + data Nat' = Zero' | Succ' Nat' + instance MyOrd Nat' where + mycompare Zero' Zero' = EQ + mycompare Zero' (Succ' _) = LT + mycompare (Succ' _) Zero' = GT + mycompare (Succ' n) (Succ' m) = (m `mycompare` n) + type Zero'Sym0 = Zero' + type Succ'Sym1 (t :: Nat') = Succ' t + instance SuppressUnusedWarnings Succ'Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Succ'Sym0KindInference) GHC.Tuple.()) + data Succ'Sym0 (l :: TyFun Nat' Nat') + = forall arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => + Succ'Sym0KindInference + type instance Apply Succ'Sym0 l = Succ' l + type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where + Mycompare_0123456789876543210 Zero' Zero' = EQSym0 + Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0 + Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0 + Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (t :: Nat') (t :: Nat') = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: Nat') (l :: TyFun Nat' Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd Nat' where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + data instance Sing (z :: Nat') + where + SZero' :: Sing Zero' + SSucc' :: forall (n :: Nat'). (Sing (n :: Nat')) -> Sing (Succ' n) + type SNat' = (Sing :: Nat' -> GHC.Types.Type) + instance SingKind Nat' where + type Demote Nat' = Nat' + fromSing SZero' = Zero' + fromSing (SSucc' b) = Succ' (fromSing b) + toSing Zero' = SomeSing SZero' + toSing (Succ' (b :: Demote Nat')) + = case toSing b :: SomeSing Nat' of { + SomeSing c -> SomeSing (SSucc' c) } + instance SMyOrd Nat' where + sMycompare :: + forall (t :: Nat') (t :: Nat'). + Sing t + -> Sing t + -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' (TyFun Nat' Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t) t) + sMycompare SZero' SZero' = SEQ + sMycompare SZero' (SSucc' _) = SLT + sMycompare (SSucc' _) SZero' = SGT + sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SingI Zero' where + sing = SZero' + instance SingI n => SingI (Succ' (n :: Nat')) where + sing = SSucc' sing diff --git a/tests/compile-and-dump/Singletons/Classes.hs b/tests/compile-and-dump/Singletons/Classes.hs --- a/tests/compile-and-dump/Singletons/Classes.hs +++ b/tests/compile-and-dump/Singletons/Classes.hs @@ -91,7 +91,7 @@ foo3b :: Proxy EQ foo3b = foo3a -foo4a :: Proxy (Succ' Zero' :<=> Zero') +foo4a :: Proxy (Succ' Zero' <=> Zero') foo4a = Proxy foo4b :: Proxy GT diff --git a/tests/compile-and-dump/Singletons/Classes2.ghc82.template b/tests/compile-and-dump/Singletons/Classes2.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Classes2.ghc82.template +++ /dev/null @@ -1,86 +0,0 @@ -Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data NatFoo = ZeroFoo | SuccFoo NatFoo - - instance MyOrd NatFoo where - ZeroFoo `mycompare` ZeroFoo = EQ - ZeroFoo `mycompare` (SuccFoo _) = LT - (SuccFoo _) `mycompare` ZeroFoo = GT - (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |] - ======> - data NatFoo = ZeroFoo | SuccFoo NatFoo - instance MyOrd NatFoo where - mycompare ZeroFoo ZeroFoo = EQ - mycompare ZeroFoo (SuccFoo _) = LT - mycompare (SuccFoo _) ZeroFoo = GT - mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) - type ZeroFooSym0 = ZeroFoo - type SuccFooSym1 (t :: NatFoo) = SuccFoo t - instance SuppressUnusedWarnings SuccFooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SuccFooSym0KindInference) GHC.Tuple.()) - data SuccFooSym0 (l :: TyFun NatFoo NatFoo) - = forall arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => - SuccFooSym0KindInference - type instance Apply SuccFooSym0 l = SuccFoo l - type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where - Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0 - Mycompare_0123456789876543210 ZeroFoo (SuccFoo _z_0123456789876543210) = LTSym0 - Mycompare_0123456789876543210 (SuccFoo _z_0123456789876543210) ZeroFoo = GTSym0 - Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (t :: NatFoo) (t :: NatFoo) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: NatFoo) (l :: TyFun NatFoo Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun NatFoo (TyFun NatFoo Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd NatFoo where - type Mycompare (a :: NatFoo) (a :: NatFoo) = Apply (Apply Mycompare_0123456789876543210Sym0 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 Demote 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 (t1 :: NatFoo) (t2 :: NatFoo). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo (TyFun NatFoo Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1 :: TyFun NatFoo Ordering - -> GHC.Types.Type) t2 :: Ordering) - sMycompare SZeroFoo SZeroFoo = SEQ - sMycompare SZeroFoo (SSuccFoo _) = SLT - sMycompare (SSuccFoo _) SZeroFoo = SGT - sMycompare (SSuccFoo (sN :: Sing n)) (SSuccFoo (sM :: Sing m)) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) - sN - instance SingI ZeroFoo where - sing = SZeroFoo - instance SingI n => SingI (SuccFoo (n :: NatFoo)) where - sing = SSuccFoo sing diff --git a/tests/compile-and-dump/Singletons/Classes2.ghc84.template b/tests/compile-and-dump/Singletons/Classes2.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes2.ghc84.template @@ -0,0 +1,86 @@ +Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data NatFoo = ZeroFoo | SuccFoo NatFoo + + instance MyOrd NatFoo where + ZeroFoo `mycompare` ZeroFoo = EQ + ZeroFoo `mycompare` (SuccFoo _) = LT + (SuccFoo _) `mycompare` ZeroFoo = GT + (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |] + ======> + data NatFoo = ZeroFoo | SuccFoo NatFoo + instance MyOrd NatFoo where + mycompare ZeroFoo ZeroFoo = EQ + mycompare ZeroFoo (SuccFoo _) = LT + mycompare (SuccFoo _) ZeroFoo = GT + mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) + type ZeroFooSym0 = ZeroFoo + type SuccFooSym1 (t :: NatFoo) = SuccFoo t + instance SuppressUnusedWarnings SuccFooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccFooSym0KindInference) GHC.Tuple.()) + data SuccFooSym0 (l :: TyFun NatFoo NatFoo) + = forall arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => + SuccFooSym0KindInference + type instance Apply SuccFooSym0 l = SuccFoo l + type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where + Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0 + Mycompare_0123456789876543210 ZeroFoo (SuccFoo _) = LTSym0 + Mycompare_0123456789876543210 (SuccFoo _) ZeroFoo = GTSym0 + Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (t :: NatFoo) (t :: NatFoo) = + Mycompare_0123456789876543210 t t + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym1 (l :: NatFoo) (l :: TyFun NatFoo Ordering) + = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => + Mycompare_0123456789876543210Sym1KindInference + type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Mycompare_0123456789876543210Sym0 (l :: TyFun NatFoo (TyFun NatFoo Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0KindInference + type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l + instance PMyOrd NatFoo where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + data instance Sing (z :: NatFoo) + where + SZeroFoo :: Sing ZeroFoo + SSuccFoo :: forall (n :: NatFoo). + (Sing (n :: NatFoo)) -> Sing (SuccFoo n) + type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type) + instance SingKind NatFoo where + type Demote NatFoo = NatFoo + fromSing SZeroFoo = ZeroFoo + fromSing (SSuccFoo b) = SuccFoo (fromSing b) + toSing ZeroFoo = SomeSing SZeroFoo + toSing (SuccFoo (b :: Demote NatFoo)) + = case toSing b :: SomeSing NatFoo of { + SomeSing c -> SomeSing (SSuccFoo c) } + instance SMyOrd NatFoo where + sMycompare :: + forall (t1 :: NatFoo) (t2 :: NatFoo). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo (TyFun NatFoo Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sMycompare SZeroFoo SZeroFoo = SEQ + sMycompare SZeroFoo (SSuccFoo _) = SLT + sMycompare (SSuccFoo _) SZeroFoo = SGT + sMycompare (SSuccFoo (sN :: Sing n)) (SSuccFoo (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SingI ZeroFoo where + sing = SZeroFoo + instance SingI n => SingI (SuccFoo (n :: NatFoo)) where + sing = SSuccFoo sing diff --git a/tests/compile-and-dump/Singletons/Contains.ghc82.template b/tests/compile-and-dump/Singletons/Contains.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Contains.ghc82.template +++ /dev/null @@ -1,41 +0,0 @@ -Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| contains :: Eq a => a -> [a] -> Bool - contains _ [] = False - contains elt (h : t) = (elt == h) || (contains elt t) |] - ======> - contains :: Eq a => a -> [a] -> Bool - contains _ GHC.Types.[] = False - contains elt (h GHC.Types.: t) = ((elt == h) || ((contains elt) t)) - type ContainsSym2 (t :: a0123456789876543210) (t :: [a0123456789876543210]) = - Contains t t - instance SuppressUnusedWarnings ContainsSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ContainsSym1KindInference) GHC.Tuple.()) - data ContainsSym1 (l :: a0123456789876543210) (l :: TyFun [a0123456789876543210] Bool) - = forall arg. SameKind (Apply (ContainsSym1 l) arg) (ContainsSym2 l arg) => - ContainsSym1KindInference - type instance Apply (ContainsSym1 l) l = Contains l l - instance SuppressUnusedWarnings ContainsSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ContainsSym0KindInference) GHC.Tuple.()) - data ContainsSym0 (l :: TyFun a0123456789876543210 (TyFun [a0123456789876543210] Bool - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => - ContainsSym0KindInference - type instance Apply ContainsSym0 l = ContainsSym1 l - type family Contains (a :: a) (a :: [a]) :: Bool where - Contains _z_0123456789876543210 '[] = FalseSym0 - Contains elt ((:) h t) = Apply (Apply (:||$) (Apply (Apply (:==$) elt) h)) (Apply (Apply ContainsSym0 elt) t) - sContains :: - forall (t :: a) (t :: [a]). - SEq a => - Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) - sContains _ SNil = SFalse - sContains (sElt :: Sing elt) (SCons (sH :: Sing h) (sT :: Sing t)) - = (applySing - ((applySing ((singFun2 @(:||$)) (%:||))) - ((applySing ((applySing ((singFun2 @(:==$)) (%:==))) sElt)) sH))) - ((applySing - ((applySing ((singFun2 @ContainsSym0) sContains)) sElt)) - sT) diff --git a/tests/compile-and-dump/Singletons/Contains.ghc84.template b/tests/compile-and-dump/Singletons/Contains.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Contains.ghc84.template @@ -0,0 +1,41 @@ +Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| contains :: Eq a => a -> [a] -> Bool + contains _ [] = False + contains elt (h : t) = (elt == h) || (contains elt t) |] + ======> + contains :: Eq a => a -> [a] -> Bool + contains _ GHC.Types.[] = False + contains elt (h GHC.Types.: t) = ((elt == h) || ((contains elt) t)) + type ContainsSym2 (t :: a0123456789876543210) (t :: [a0123456789876543210]) = + Contains t t + instance SuppressUnusedWarnings ContainsSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ContainsSym1KindInference) GHC.Tuple.()) + data ContainsSym1 (l :: a0123456789876543210) (l :: TyFun [a0123456789876543210] Bool) + = forall arg. SameKind (Apply (ContainsSym1 l) arg) (ContainsSym2 l arg) => + ContainsSym1KindInference + type instance Apply (ContainsSym1 l) l = Contains l l + instance SuppressUnusedWarnings ContainsSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ContainsSym0KindInference) GHC.Tuple.()) + data ContainsSym0 (l :: TyFun a0123456789876543210 (TyFun [a0123456789876543210] Bool + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => + ContainsSym0KindInference + type instance Apply ContainsSym0 l = ContainsSym1 l + type family Contains (a :: a) (a :: [a]) :: Bool where + Contains _ '[] = FalseSym0 + Contains elt ((:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t) + sContains :: + forall (t :: a) (t :: [a]). + SEq a => + Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) + sContains _ SNil = SFalse + sContains (sElt :: Sing elt) (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing + ((applySing ((singFun2 @(||@#@$)) (%||))) + ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sElt)) sH))) + ((applySing + ((applySing ((singFun2 @ContainsSym0) sContains)) sElt)) + sT) diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc82.template b/tests/compile-and-dump/Singletons/DataValues.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/DataValues.ghc82.template +++ /dev/null @@ -1,93 +0,0 @@ -Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| pr = Pair (Succ Zero) ([Zero]) - complex = Pair (Pair (Just Zero) Zero) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - - data Pair a b - = Pair a b - deriving Show |] - ======> - data Pair a b - = Pair a b - deriving Show - pr = (Pair (Succ Zero)) [Zero] - complex = (Pair ((Pair (Just Zero)) Zero)) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type AListSym0 = AList - type TupleSym0 = Tuple - type ComplexSym0 = Complex - type PrSym0 = Pr - type family AList where - = Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) - type family Tuple where - = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 - type family Complex where - = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 - type family Pr where - = 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 @(:$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) - sTuple - = (applySing - ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - STrue - sComplex - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - SZero))) - SFalse - sPr - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SZero)) SNil) - data instance Sing (z :: Pair a b) - = 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 Demote (Pair a b) = Pair (Demote a) (Demote 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 diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc84.template b/tests/compile-and-dump/Singletons/DataValues.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/DataValues.ghc84.template @@ -0,0 +1,187 @@ +Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving Show |] + ======> + data Pair a b + = Pair a b + deriving Show + pr = (Pair (Succ Zero)) [Zero] + complex = (Pair ((Pair (Just Zero)) Zero)) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) + data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = Pair l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) + data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow (Pair a b) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sTuple + = (applySing + ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + STrue + sComplex + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + SZero))) + SFalse + sPr + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) + data instance Sing (z :: Pair a b) + where + SPair :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance (SShow a, SShow b) => SShow (Pair a b) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Pair a b) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Pair ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Data.Singletons.ShowSing.ShowSing (Pair a b) where + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SPair arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SPair ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + (((.) GHC.Show.showSpace) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)))) + instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Show (Sing (z :: Pair a b)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = (SPair sing) sing diff --git a/tests/compile-and-dump/Singletons/DataValues.hs b/tests/compile-and-dump/Singletons/DataValues.hs --- a/tests/compile-and-dump/Singletons/DataValues.hs +++ b/tests/compile-and-dump/Singletons/DataValues.hs @@ -2,6 +2,7 @@ import Data.Singletons.TH import Data.Singletons.Prelude +import Data.Singletons.Prelude.Show import Singletons.Nat import Data.Singletons.SuppressUnusedWarnings diff --git a/tests/compile-and-dump/Singletons/Empty.ghc82.template b/tests/compile-and-dump/Singletons/Empty.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Empty.ghc82.template +++ /dev/null @@ -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 Demote 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" } diff --git a/tests/compile-and-dump/Singletons/Empty.ghc84.template b/tests/compile-and-dump/Singletons/Empty.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Empty.ghc84.template @@ -0,0 +1,10 @@ +Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Empty |] + ======> + data Empty + data instance Sing (z :: Empty) + type SEmpty = (Sing :: Empty -> GHC.Types.Type) + instance SingKind Empty where + type Demote Empty = Empty + fromSing x = case x of + toSing x = SomeSing (case x of) diff --git a/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template b/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template @@ -0,0 +1,74 @@ +Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo + + deriving instance Show Foo |] + ======> + data Foo + deriving instance Show Foo + type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo) (t :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Foo where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + data instance Sing (z :: Foo) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing x = case x of + toSing x = SomeSing (case x of) + instance SShow Foo where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + (sV_0123456789876543210 :: Sing v_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + (case sV_0123456789876543210 of :: + Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210))) + sA_0123456789876543210 + instance Data.Singletons.ShowSing.ShowSing Foo where + Data.Singletons.ShowSing.showsSingPrec _ v_0123456789876543210 + = case v_0123456789876543210 of + instance Show (Sing (z :: Foo)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec diff --git a/tests/compile-and-dump/Singletons/EmptyShowDeriving.hs b/tests/compile-and-dump/Singletons/EmptyShowDeriving.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EmptyShowDeriving.hs @@ -0,0 +1,7 @@ +module Singletons.EmptyShowDeriving where + +import Data.Singletons.TH + +$(singletons [d| data Foo + deriving instance Show Foo + |]) diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc82.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/EnumDeriving.ghc82.template +++ /dev/null @@ -1,188 +0,0 @@ -Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Foo - = Bar | Baz | Bum - deriving Enum - data Quux = Q1 | Q2 |] - ======> - data Foo - = Bar | Baz | Bum - deriving Enum - data Quux = Q1 | Q2 - type BarSym0 = Bar - type BazSym0 = Baz - type BumSym0 = Bum - type Q1Sym0 = Q1 - type Q2Sym0 = Q2 - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BumSym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BazSym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 2)) - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BarSym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 1)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Foo) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where - FromEnum_0123456789876543210 Bar = FromInteger 0 - FromEnum_0123456789876543210 Baz = FromInteger 1 - FromEnum_0123456789876543210 Bum = FromInteger 2 - type FromEnum_0123456789876543210Sym1 (t :: Foo) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun Foo GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum Foo where - type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum (a :: Foo) = Apply FromEnum_0123456789876543210Sym0 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 Demote Foo = Foo - fromSing SBar = Bar - fromSing SBaz = Baz - fromSing SBum = Bum - toSing Bar = SomeSing SBar - toSing Baz = SomeSing SBaz - toSing Bum = SomeSing SBum - data instance Sing (z :: Quux) = z ~ Q1 => SQ1 | z ~ Q2 => SQ2 - type SQuux = (Sing :: Quux -> GHC.Types.Type) - instance SingKind Quux where - type Demote Quux = Quux - fromSing SQ1 = Q1 - fromSing SQ2 = Q2 - toSing Q1 = SomeSing SQ1 - toSing Q2 = SomeSing SQ2 - instance SEnum Foo where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Foo - -> GHC.Types.Type) t :: Foo) - sFromEnum :: - forall (t :: Foo). - Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun Foo GHC.Types.Nat - -> GHC.Types.Type) t :: GHC.Types.Nat) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sN)) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SBar - SFalse - -> case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sN)) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SBaz - SFalse - -> case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sN)) - (sFromInteger (sing :: Sing 2)) - of - STrue -> SBum - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 2)) :: Foo) :: - Sing (Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Foo) :: - Sing (Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Foo) - sFromEnum SBar = sFromInteger (sing :: Sing 0) - sFromEnum SBaz = sFromInteger (sing :: Sing 1) - sFromEnum SBum = sFromInteger (sing :: Sing 2) - instance SingI Bar where - sing = SBar - instance SingI Baz where - sing = SBaz - instance SingI Bum where - sing = SBum - instance SingI Q1 where - sing = SQ1 - instance SingI Q2 where - sing = SQ2 -Singletons/EnumDeriving.hs:0:0:: Splicing declarations - singEnumInstance ''Quux - ======> - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = Q2Sym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = Q1Sym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 1)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Quux) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where - FromEnum_0123456789876543210 Q1 = FromInteger 0 - FromEnum_0123456789876543210 Q2 = FromInteger 1 - type FromEnum_0123456789876543210Sym1 (t :: Quux) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun Quux GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum Quux where - type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum (a :: Quux) = Apply FromEnum_0123456789876543210Sym0 a - instance SEnum Quux where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Quux - -> GHC.Types.Type) t :: Quux) - sFromEnum :: - forall (t :: Quux). - Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun Quux GHC.Types.Nat - -> GHC.Types.Type) t :: GHC.Types.Nat) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sN)) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SQ1 - SFalse - -> case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sN)) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SQ2 - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Quux) :: - Sing (Case_0123456789876543210 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Quux) - sFromEnum SQ1 = sFromInteger (sing :: Sing 0) - sFromEnum SQ2 = sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template @@ -0,0 +1,199 @@ +Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo + = Bar | Baz | Bum + deriving Enum + data Quux = Q1 | Q2 |] + ======> + data Foo + = Bar | Baz | Bum + deriving Enum + data Quux = Q1 | Q2 + type BarSym0 = Bar + type BazSym0 = Baz + type BumSym0 = Bum + type Q1Sym0 = Q1 + type Q2Sym0 = Q2 + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = BumSym0 + Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = BazSym0 + Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)) + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = BarSym0 + Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789876543210 t + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Foo) + = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0KindInference + type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l + type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where + FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0 + FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1 + FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2 + type FromEnum_0123456789876543210Sym1 (t :: Foo) = + FromEnum_0123456789876543210 t + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FromEnum_0123456789876543210Sym0 (l :: TyFun Foo GHC.Types.Nat) + = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0KindInference + type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l + instance PEnum Foo where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + data instance Sing (z :: Foo) + where + SBar :: Sing Bar + SBaz :: Sing Baz + SBum :: Sing Bum + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SBar = Bar + fromSing SBaz = Baz + fromSing SBum = Bum + toSing Bar = SomeSing SBar + toSing Baz = SomeSing SBaz + toSing Bum = SomeSing SBum + data instance Sing (z :: Quux) + where + SQ1 :: Sing Q1 + SQ2 :: Sing Q2 + type SQuux = (Sing :: Quux -> GHC.Types.Type) + instance SingKind Quux where + type Demote Quux = Quux + fromSing SQ1 = Q1 + fromSing SQ2 = Q2 + toSing Q1 = SomeSing SQ1 + toSing Q2 = SomeSing SQ2 + instance SEnum Foo where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Foo + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: Foo). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Foo GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> SBar + SFalse + -> case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) + of + STrue -> SBaz + SFalse + -> case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2)) + of + STrue -> SBum + SFalse -> sError (sing :: Sing "toEnum: bad argument") :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum SBar + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + sFromEnum SBaz + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) + sFromEnum SBum + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2) + instance SingI Bar where + sing = SBar + instance SingI Baz where + sing = SBaz + instance SingI Bum where + sing = SBum + instance SingI Q1 where + sing = SQ1 + instance SingI Q2 where + sing = SQ2 +Singletons/EnumDeriving.hs:0:0:: Splicing declarations + singEnumInstance ''Quux + ======> + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = Q2Sym0 + Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = Q1Sym0 + Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789876543210 t + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Quux) + = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0KindInference + type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l + type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where + FromEnum_0123456789876543210 Q1 = Data.Singletons.Prelude.Num.FromInteger 0 + FromEnum_0123456789876543210 Q2 = Data.Singletons.Prelude.Num.FromInteger 1 + type FromEnum_0123456789876543210Sym1 (t :: Quux) = + FromEnum_0123456789876543210 t + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FromEnum_0123456789876543210Sym0 (l :: TyFun Quux GHC.Types.Nat) + = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0KindInference + type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l + instance PEnum Quux where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + instance SEnum Quux where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Quux + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: Quux). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Quux GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> SQ1 + SFalse + -> case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) + of + STrue -> SQ2 + SFalse -> sError (sing :: Sing "toEnum: bad argument") :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum SQ1 + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + sFromEnum SQ2 + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.hs b/tests/compile-and-dump/Singletons/EnumDeriving.hs --- a/tests/compile-and-dump/Singletons/EnumDeriving.hs +++ b/tests/compile-and-dump/Singletons/EnumDeriving.hs @@ -1,6 +1,5 @@ module Singletons.EnumDeriving where -import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| diff --git a/tests/compile-and-dump/Singletons/EqInstances.ghc82.template b/tests/compile-and-dump/Singletons/EqInstances.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/EqInstances.ghc82.template +++ /dev/null @@ -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_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where - Equals_0123456789876543210 FLeaf FLeaf = TrueSym0 - Equals_0123456789876543210 ((:+:) a a) ((:+:) b b) = (:&&) ((:==) a b) ((:==) a b) - Equals_0123456789876543210 (a :: Foo) (b :: Foo) = FalseSym0 - instance PEq Foo where - type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789876543210 a b - instance SEq Empty where - (%:==) a _ - = case a of { - _ -> error "Empty case reached -- this should be impossible" } - type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where - Equals_0123456789876543210 (a :: Empty) (b :: Empty) = FalseSym0 - instance PEq Empty where - type (:==) (a :: Empty) (b :: Empty) = Equals_0123456789876543210 a b diff --git a/tests/compile-and-dump/Singletons/EqInstances.ghc84.template b/tests/compile-and-dump/Singletons/EqInstances.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EqInstances.ghc84.template @@ -0,0 +1,21 @@ +Singletons/EqInstances.hs:0:0:: Splicing declarations + singEqInstances [''Foo, ''Empty] + ======> + instance SEq Foo => SEq Foo where + (%==) SFLeaf SFLeaf = STrue + (%==) SFLeaf ((:%+:) _ _) = SFalse + (%==) ((:%+:) _ _) SFLeaf = SFalse + (%==) ((:%+:) a a) ((:%+:) b b) + = ((%&&) (((%==) a) b)) (((%==) a) b) + type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where + Equals_0123456789876543210 FLeaf FLeaf = TrueSym0 + Equals_0123456789876543210 ((:+:) a a) ((:+:) b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 + instance PEq Foo where + type (==) a b = Equals_0123456789876543210 a b + instance SEq Empty where + (%==) _ _ = STrue + type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where + Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 + instance PEq Empty where + type (==) a b = Equals_0123456789876543210 a b diff --git a/tests/compile-and-dump/Singletons/Error.ghc82.template b/tests/compile-and-dump/Singletons/Error.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Error.ghc82.template +++ /dev/null @@ -1,24 +0,0 @@ -Singletons/Error.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| head :: [a] -> a - head (a : _) = a - head [] = error "Data.Singletons.List.head: empty list" |] - ======> - head :: [a] -> a - head (a GHC.Types.: _) = a - head GHC.Types.[] = error "Data.Singletons.List.head: empty list" - type HeadSym1 (t :: [a0123456789876543210]) = Head t - instance SuppressUnusedWarnings HeadSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) HeadSym0KindInference) GHC.Tuple.()) - data HeadSym0 (l :: TyFun [a0123456789876543210] a0123456789876543210) - = forall arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => - HeadSym0KindInference - type instance Apply HeadSym0 l = Head l - type family Head (a :: [a]) :: a where - Head ((:) a _z_0123456789876543210) = a - Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" - sHead :: forall (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) - sHead (SCons (sA :: Sing a) _) = sA - sHead SNil - = sError (sing :: Sing "Data.Singletons.List.head: empty list") diff --git a/tests/compile-and-dump/Singletons/Error.ghc84.template b/tests/compile-and-dump/Singletons/Error.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Error.ghc84.template @@ -0,0 +1,24 @@ +Singletons/Error.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| head :: [a] -> a + head (a : _) = a + head [] = error "Data.Singletons.List.head: empty list" |] + ======> + head :: [a] -> a + head (a GHC.Types.: _) = a + head GHC.Types.[] = error "Data.Singletons.List.head: empty list" + type HeadSym1 (t :: [a0123456789876543210]) = Head t + instance SuppressUnusedWarnings HeadSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) HeadSym0KindInference) GHC.Tuple.()) + data HeadSym0 (l :: TyFun [a0123456789876543210] a0123456789876543210) + = forall arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => + HeadSym0KindInference + type instance Apply HeadSym0 l = Head l + type family Head (a :: [a]) :: a where + Head ((:) a _) = a + Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" + sHead :: forall (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) + sHead (SCons (sA :: Sing a) _) = sA + sHead SNil + = sError (sing :: Sing "Data.Singletons.List.head: empty list") diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc82.template b/tests/compile-and-dump/Singletons/Fixity.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Fixity.ghc82.template +++ /dev/null @@ -1,68 +0,0 @@ -Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infix 4 ==== - infix 4 <=> - - (====) :: a -> a -> a - a ==== _ = a - - class MyOrd a where - (<=>) :: a -> a -> Ordering - infix 4 <=> |] - ======> - class MyOrd a where - (<=>) :: a -> a -> Ordering - infix 4 <=> - (====) :: a -> a -> a - (====) a _ = a - infix 4 ==== - type (:====$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (:====) t t - instance SuppressUnusedWarnings (:====$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:====$$###)) GHC.Tuple.()) - data (:====$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply ((:====$$) l) arg) ((:====$$$) l arg) => - (:====$$###) - type instance Apply ((:====$$) l) l = (:====) l l - instance SuppressUnusedWarnings (:====$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:====$###)) GHC.Tuple.()) - data (:====$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:====$) arg) ((:====$$) arg) => - (:====$###) - type instance Apply (:====$) l = (:====$$) l - type family (:====) (a :: a) (a :: a) :: a where - (:====) a _z_0123456789876543210 = a - infix 4 :==== - infix 4 :<=> - type (:<=>$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (:<=>) t t - instance SuppressUnusedWarnings (:<=>$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:<=>$$###)) GHC.Tuple.()) - data (:<=>$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply ((:<=>$$) l) arg) ((:<=>$$$) l arg) => - (:<=>$$###) - type instance Apply ((:<=>$$) l) l = (:<=>) l l - instance SuppressUnusedWarnings (:<=>$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:<=>$###)) GHC.Tuple.()) - data (:<=>$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:<=>$) arg) ((:<=>$$) arg) => - (:<=>$###) - type instance Apply (:<=>$) l = (:<=>$$) l - class PMyOrd (a :: GHC.Types.Type) where - type (:<=>) (arg :: a) (arg :: a) :: Ordering - infix 4 %:==== - infix 4 %:<=> - (%:====) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (:====$) t) t :: a) - (%:====) (sA :: Sing a) _ = sA - class SMyOrd a where - (%:<=>) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc84.template b/tests/compile-and-dump/Singletons/Fixity.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Fixity.ghc84.template @@ -0,0 +1,66 @@ +Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 ==== + infix 4 <=> + + (====) :: a -> a -> a + a ==== _ = a + + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> |] + ======> + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> + (====) :: a -> a -> a + (====) a _ = a + infix 4 ==== + type (====@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = + (====) t t + instance SuppressUnusedWarnings (====@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:====@#@$$###)) GHC.Tuple.()) + data (====@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply ((====@#@$$) l) arg) ((====@#@$$$) l arg) => + (:====@#@$$###) + type instance Apply ((====@#@$$) l) l = (====) l l + instance SuppressUnusedWarnings (====@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:====@#@$###)) GHC.Tuple.()) + data (====@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) => + (:====@#@$###) + type instance Apply (====@#@$) l = (====@#@$$) l + type family (====) (a :: a) (a :: a) :: a where + (====) a _ = a + type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = + (<=>) t t + instance SuppressUnusedWarnings (<=>@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.()) + data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) + = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) => + (:<=>@#@$$###) + type instance Apply ((<=>@#@$$) l) l = (<=>) l l + instance SuppressUnusedWarnings (<=>@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.()) + data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => + (:<=>@#@$###) + type instance Apply (<=>@#@$) l = (<=>@#@$$) l + class PMyOrd (a :: GHC.Types.Type) where + type (<=>) (arg :: a) (arg :: a) :: Ordering + infix 4 %==== + infix 4 %<=> + (%====) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a) + (%====) (sA :: Sing a) _ = sA + class SMyOrd a where + (%<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) diff --git a/tests/compile-and-dump/Singletons/FunDeps.ghc82.template b/tests/compile-and-dump/Singletons/FunDeps.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/FunDeps.ghc82.template +++ /dev/null @@ -1,86 +0,0 @@ -Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| t1 = meth True - - class FD a b | a -> b where - meth :: a -> a - l2r :: a -> b - - instance FD Bool Nat where - meth = not - l2r False = 0 - l2r True = 1 |] - ======> - class FD a b | a -> b where - meth :: a -> a - l2r :: a -> b - instance FD Bool Nat where - meth = not - l2r False = 0 - l2r True = 1 - t1 = meth True - type T1Sym0 = T1 - type family T1 where - = Apply MethSym0 TrueSym0 - type MethSym1 (t :: a0123456789876543210) = Meth t - instance SuppressUnusedWarnings MethSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.()) - data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => - MethSym0KindInference - type instance Apply MethSym0 l = Meth l - type L2rSym1 (t :: a0123456789876543210) = L2r t - instance SuppressUnusedWarnings L2rSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) L2rSym0KindInference) GHC.Tuple.()) - data L2rSym0 (l :: TyFun a0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => - L2rSym0KindInference - type instance Apply L2rSym0 l = L2r l - class PFD (a :: GHC.Types.Type) (b :: GHC.Types.Type) | a -> b where - type Meth (arg :: a) :: a - type L2r (arg :: a) :: b - type family Meth_0123456789876543210 (a :: Bool) :: Bool where - Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym1 (t :: Bool) = - Meth_0123456789876543210 t - instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => - Meth_0123456789876543210Sym0KindInference - type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l - type family L2r_0123456789876543210 (a :: Bool) :: Nat where - L2r_0123456789876543210 False = FromInteger 0 - L2r_0123456789876543210 True = FromInteger 1 - type L2r_0123456789876543210Sym1 (t :: Bool) = - L2r_0123456789876543210 t - instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) L2r_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data L2r_0123456789876543210Sym0 (l :: TyFun Bool Nat) - = forall arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => - L2r_0123456789876543210Sym0KindInference - type instance Apply L2r_0123456789876543210Sym0 l = L2r_0123456789876543210 l - instance PFD Bool Nat where - type Meth (a :: Bool) = Apply Meth_0123456789876543210Sym0 a - type L2r (a :: Bool) = Apply L2r_0123456789876543210Sym0 a - sT1 :: Sing T1Sym0 - sT1 = (applySing ((singFun1 @MethSym0) sMeth)) STrue - class SFD a b | a -> b where - sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) - sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) - instance SFD Bool Nat where - sMeth :: - forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool) - sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat) - sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 - sL2r SFalse = sFromInteger (sing :: Sing 0) - sL2r STrue = sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/FunDeps.ghc84.template b/tests/compile-and-dump/Singletons/FunDeps.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/FunDeps.ghc84.template @@ -0,0 +1,86 @@ +Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| t1 = meth True + + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 |] + ======> + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 + t1 = meth True + type T1Sym0 = T1 + type family T1 where + T1 = Apply MethSym0 TrueSym0 + type MethSym1 (t :: a0123456789876543210) = Meth t + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.()) + data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => + MethSym0KindInference + type instance Apply MethSym0 l = Meth l + type L2rSym1 (t :: a0123456789876543210) = L2r t + instance SuppressUnusedWarnings L2rSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) L2rSym0KindInference) GHC.Tuple.()) + data L2rSym0 (l :: TyFun a0123456789876543210 b0123456789876543210) + = forall arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => + L2rSym0KindInference + type instance Apply L2rSym0 l = L2r l + class PFD (a :: GHC.Types.Type) (b :: GHC.Types.Type) | a -> b where + type Meth (arg :: a) :: a + type L2r (arg :: a) :: b + type family Meth_0123456789876543210 (a :: Bool) :: Bool where + Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 + type Meth_0123456789876543210Sym1 (t :: Bool) = + Meth_0123456789876543210 t + instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => + Meth_0123456789876543210Sym0KindInference + type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l + type family L2r_0123456789876543210 (a :: Bool) :: Nat where + L2r_0123456789876543210 False = FromInteger 0 + L2r_0123456789876543210 True = FromInteger 1 + type L2r_0123456789876543210Sym1 (t :: Bool) = + L2r_0123456789876543210 t + instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) L2r_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data L2r_0123456789876543210Sym0 (l :: TyFun Bool Nat) + = forall arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => + L2r_0123456789876543210Sym0KindInference + type instance Apply L2r_0123456789876543210Sym0 l = L2r_0123456789876543210 l + instance PFD Bool Nat where + type Meth a = Apply Meth_0123456789876543210Sym0 a + type L2r a = Apply L2r_0123456789876543210Sym0 a + sT1 :: Sing T1Sym0 + sT1 = (applySing ((singFun1 @MethSym0) sMeth)) STrue + class SFD a b | a -> b where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) + sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) + instance SFD Bool Nat where + sMeth :: + forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool) + sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat) + sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 + sL2r SFalse = sFromInteger (sing :: Sing 0) + sL2r STrue = sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc82.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/HigherOrder.ghc82.template +++ /dev/null @@ -1,423 +0,0 @@ -Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| map :: (a -> b) -> [a] -> [b] - map _ [] = [] - map f (h : t) = (f h) : (map f t) - liftMaybe :: (a -> b) -> Maybe a -> Maybe b - liftMaybe f (Just x) = Just (f x) - liftMaybe _ Nothing = Nothing - zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys - zipWith _ [] [] = [] - zipWith _ (_ : _) [] = [] - zipWith _ [] (_ : _) = [] - foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b - foo f g a = f g a - splunge :: [Nat] -> [Bool] -> [Nat] - splunge ns bs - = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs - etad :: [Nat] -> [Bool] -> [Nat] - etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - - data Either a b = Left a | Right b |] - ======> - data Either a b = Left a | Right b - map :: (a -> b) -> [a] -> [b] - map _ GHC.Types.[] = [] - map f (h GHC.Types.: t) = ((f h) GHC.Types.: ((map f) t)) - liftMaybe :: (a -> b) -> Maybe a -> Maybe b - liftMaybe f (Just x) = Just (f x) - liftMaybe _ Nothing = Nothing - zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - zipWith f (x GHC.Types.: xs) (y GHC.Types.: ys) - = (((f x) y) GHC.Types.: (((zipWith f) xs) ys)) - zipWith _ GHC.Types.[] GHC.Types.[] = [] - zipWith _ (_ GHC.Types.: _) GHC.Types.[] = [] - zipWith _ GHC.Types.[] (_ GHC.Types.: _) = [] - foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b - foo f g a = (f g) a - splunge :: [Nat] -> [Bool] -> [Nat] - splunge ns bs - = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs - etad :: [Nat] -> [Bool] -> [Nat] - etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - type LeftSym1 (t :: a0123456789876543210) = Left t - instance SuppressUnusedWarnings LeftSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LeftSym0KindInference) GHC.Tuple.()) - data LeftSym0 (l :: TyFun a0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => - LeftSym0KindInference - type instance Apply LeftSym0 l = Left l - type RightSym1 (t :: b0123456789876543210) = Right t - instance SuppressUnusedWarnings RightSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) RightSym0KindInference) GHC.Tuple.()) - data RightSym0 (l :: TyFun b0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => - RightSym0KindInference - type instance Apply RightSym0 l = Right l - type family Case_0123456789876543210 ns bs n b t where - Case_0123456789876543210 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 ns bs n b False = n - type family Lambda_0123456789876543210 ns bs t t where - Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 False = n - type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type FooSym3 (t :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: a0123456789876543210) = - Foo t t t - instance SuppressUnusedWarnings FooSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym2KindInference) GHC.Tuple.()) - data FooSym2 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply (FooSym2 l l) arg) (FooSym3 l l arg) => - FooSym2KindInference - type instance Apply (FooSym2 l l) l = Foo l l l - instance SuppressUnusedWarnings FooSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.()) - data FooSym1 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) => - FooSym1KindInference - type instance Apply (FooSym1 l) l = FooSym2 l l - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = FooSym1 l - type ZipWithSym3 (t :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (t :: [a0123456789876543210]) (t :: [b0123456789876543210]) = - ZipWith t t t - instance SuppressUnusedWarnings ZipWithSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ZipWithSym2KindInference) GHC.Tuple.()) - data ZipWithSym2 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: [a0123456789876543210]) (l :: TyFun [b0123456789876543210] [c0123456789876543210]) - = forall arg. SameKind (Apply (ZipWithSym2 l l) arg) (ZipWithSym3 l l arg) => - ZipWithSym2KindInference - type instance Apply (ZipWithSym2 l l) l = ZipWith l l l - instance SuppressUnusedWarnings ZipWithSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ZipWithSym1KindInference) GHC.Tuple.()) - data ZipWithSym1 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ZipWithSym1 l) arg) (ZipWithSym2 l arg) => - ZipWithSym1KindInference - type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l - instance SuppressUnusedWarnings ZipWithSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ZipWithSym0KindInference) GHC.Tuple.()) - data ZipWithSym0 (l :: TyFun (TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => - ZipWithSym0KindInference - type instance Apply ZipWithSym0 l = ZipWithSym1 l - type SplungeSym2 (t :: [Nat]) (t :: [Bool]) = Splunge t t - instance SuppressUnusedWarnings SplungeSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SplungeSym1KindInference) GHC.Tuple.()) - data SplungeSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) - = forall arg. SameKind (Apply (SplungeSym1 l) arg) (SplungeSym2 l arg) => - SplungeSym1KindInference - type instance Apply (SplungeSym1 l) l = Splunge l l - instance SuppressUnusedWarnings SplungeSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SplungeSym0KindInference) GHC.Tuple.()) - data SplungeSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => - SplungeSym0KindInference - type instance Apply SplungeSym0 l = SplungeSym1 l - type EtadSym2 (t :: [Nat]) (t :: [Bool]) = Etad t t - instance SuppressUnusedWarnings EtadSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) EtadSym1KindInference) GHC.Tuple.()) - data EtadSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) - = forall arg. SameKind (Apply (EtadSym1 l) arg) (EtadSym2 l arg) => - EtadSym1KindInference - type instance Apply (EtadSym1 l) l = Etad l l - instance SuppressUnusedWarnings EtadSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) EtadSym0KindInference) GHC.Tuple.()) - data EtadSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => - EtadSym0KindInference - type instance Apply EtadSym0 l = EtadSym1 l - type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: Maybe a0123456789876543210) = - LiftMaybe t t - instance SuppressUnusedWarnings LiftMaybeSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.()) - data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)) - = forall arg. SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) => - LiftMaybeSym1KindInference - type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l - instance SuppressUnusedWarnings LiftMaybeSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.()) - data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => - LiftMaybeSym0KindInference - type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l - type MapSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: [a0123456789876543210]) = - Map t t - instance SuppressUnusedWarnings MapSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MapSym1KindInference) GHC.Tuple.()) - data MapSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] [b0123456789876543210]) - = forall arg. SameKind (Apply (MapSym1 l) arg) (MapSym2 l arg) => - MapSym1KindInference - type instance Apply (MapSym1 l) l = Map l l - instance SuppressUnusedWarnings MapSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MapSym0KindInference) GHC.Tuple.()) - data MapSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun [a0123456789876543210] [b0123456789876543210] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => - MapSym0KindInference - type instance Apply MapSym0 l = MapSym1 l - type family Foo (a :: TyFun (TyFun a b - -> GHC.Types.Type) (TyFun a b -> GHC.Types.Type) - -> GHC.Types.Type) (a :: TyFun a b - -> GHC.Types.Type) (a :: a) :: b where - Foo f g a = Apply (Apply f g) a - type family ZipWith (a :: TyFun a (TyFun b c -> GHC.Types.Type) - -> GHC.Types.Type) (a :: [a]) (a :: [b]) :: [c] where - ZipWith f ((:) x xs) ((:) y ys) = Apply (Apply (:$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) - ZipWith _z_0123456789876543210 '[] '[] = '[] - ZipWith _z_0123456789876543210 ((:) _z_0123456789876543210 _z_0123456789876543210) '[] = '[] - ZipWith _z_0123456789876543210 '[] ((:) _z_0123456789876543210 _z_0123456789876543210) = '[] - type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where - Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs - type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where - Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 - type family LiftMaybe (a :: TyFun a b - -> GHC.Types.Type) (a :: Maybe a) :: Maybe b where - LiftMaybe f (Just x) = Apply JustSym0 (Apply f x) - LiftMaybe _z_0123456789876543210 Nothing = NothingSym0 - type family Map (a :: TyFun a b - -> GHC.Types.Type) (a :: [a]) :: [b] where - Map _z_0123456789876543210 '[] = '[] - Map f ((:) h t) = Apply (Apply (:$) (Apply f h)) (Apply (Apply MapSym0 f) t) - sFoo :: - forall (t :: TyFun (TyFun a b -> GHC.Types.Type) (TyFun a b - -> GHC.Types.Type) - -> GHC.Types.Type) - (t :: TyFun a b -> GHC.Types.Type) - (t :: a). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) - sZipWith :: - forall (t :: TyFun a (TyFun b c -> GHC.Types.Type) - -> GHC.Types.Type) - (t :: [a]) - (t :: [b]). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) - sSplunge :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) - sEtad :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) - sLiftMaybe :: - forall (t :: TyFun a b -> GHC.Types.Type) (t :: Maybe a). - Sing t - -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) - sMap :: - forall (t :: TyFun a b -> GHC.Types.Type) (t :: [a]). - Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) - sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) - = (applySing ((applySing sF) sG)) sA - sZipWith - (sF :: Sing f) - (SCons (sX :: Sing x) (sXs :: Sing xs)) - (SCons (sY :: Sing y) (sYs :: Sing ys)) - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((applySing sF) sX)) sY))) - ((applySing - ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) - sXs)) - sYs) - sZipWith _ SNil SNil = SNil - sZipWith _ (SCons _ _) SNil = SNil - sZipWith _ SNil (SCons _ _) = SNil - sSplunge (sNs :: Sing ns) (sBs :: Sing bs) - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) - (\ sN sB - -> case (GHC.Tuple.(,) sN) sB of { - GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) - -> case sB of - STrue - -> (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) sN) - SFalse -> sN :: - Sing (Case_0123456789876543210 ns bs n b b) })))) - sNs)) - sBs - sEtad - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 - @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) - (\ sN sB - -> case (GHC.Tuple.(,) sN) sB of { - GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) - -> case sB of - STrue - -> (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) sN) - SFalse -> sN :: - Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) })))) - sA_0123456789876543210)) - sA_0123456789876543210 - sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) - = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) - sLiftMaybe _ SNothing = SNothing - sMap _ SNil = SNil - sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t)) - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) ((applySing sF) sH))) - ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) - data instance Sing (z :: Either a b) - = 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 Demote (Either a b) = Either (Demote a) (Demote 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 diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template @@ -0,0 +1,424 @@ +Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| map :: (a -> b) -> [a] -> [b] + map _ [] = [] + map f (h : t) = (f h) : (map f t) + liftMaybe :: (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys + zipWith _ [] [] = [] + zipWith _ (_ : _) [] = [] + zipWith _ [] (_ : _) = [] + foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = f g a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + + data Either a b = Left a | Right b |] + ======> + data Either a b = Left a | Right b + map :: (a -> b) -> [a] -> [b] + map _ GHC.Types.[] = [] + map f (h GHC.Types.: t) = ((f h) GHC.Types.: ((map f) t)) + liftMaybe :: (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x GHC.Types.: xs) (y GHC.Types.: ys) + = (((f x) y) GHC.Types.: (((zipWith f) xs) ys)) + zipWith _ GHC.Types.[] GHC.Types.[] = [] + zipWith _ (_ GHC.Types.: _) GHC.Types.[] = [] + zipWith _ GHC.Types.[] (_ GHC.Types.: _) = [] + foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = (f g) a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + type LeftSym1 (t :: a0123456789876543210) = Left t + instance SuppressUnusedWarnings LeftSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LeftSym0KindInference) GHC.Tuple.()) + data LeftSym0 (l :: TyFun a0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => + LeftSym0KindInference + type instance Apply LeftSym0 l = Left l + type RightSym1 (t :: b0123456789876543210) = Right t + instance SuppressUnusedWarnings RightSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) RightSym0KindInference) GHC.Tuple.()) + data RightSym0 (l :: TyFun b0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => + RightSym0KindInference + type instance Apply RightSym0 l = Right l + type family Case_0123456789876543210 ns bs n b t where + Case_0123456789876543210 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789876543210 ns bs n b False = n + type family Lambda_0123456789876543210 ns bs t t where + Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b + type Lambda_0123456789876543210Sym4 t t t t = + Lambda_0123456789876543210 t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 False = n + type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b + type Lambda_0123456789876543210Sym4 t t t t = + Lambda_0123456789876543210 t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type FooSym3 (t :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (t :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (t :: a0123456789876543210) = + Foo t t t + instance SuppressUnusedWarnings FooSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym2KindInference) GHC.Tuple.()) + data FooSym2 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210) + = forall arg. SameKind (Apply (FooSym2 l l) arg) (FooSym3 l l arg) => + FooSym2KindInference + type instance Apply (FooSym2 l l) l = Foo l l l + instance SuppressUnusedWarnings FooSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.()) + data FooSym1 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) => + FooSym1KindInference + type instance Apply (FooSym1 l) l = FooSym2 l l + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type ZipWithSym3 (t :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (t :: [a0123456789876543210]) (t :: [b0123456789876543210]) = + ZipWith t t t + instance SuppressUnusedWarnings ZipWithSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ZipWithSym2KindInference) GHC.Tuple.()) + data ZipWithSym2 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (l :: [a0123456789876543210]) (l :: TyFun [b0123456789876543210] [c0123456789876543210]) + = forall arg. SameKind (Apply (ZipWithSym2 l l) arg) (ZipWithSym3 l l arg) => + ZipWithSym2KindInference + type instance Apply (ZipWithSym2 l l) l = ZipWith l l l + instance SuppressUnusedWarnings ZipWithSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ZipWithSym1KindInference) GHC.Tuple.()) + data ZipWithSym1 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ZipWithSym1 l) arg) (ZipWithSym2 l arg) => + ZipWithSym1KindInference + type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l + instance SuppressUnusedWarnings ZipWithSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ZipWithSym0KindInference) GHC.Tuple.()) + data ZipWithSym0 (l :: TyFun (TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type) (TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => + ZipWithSym0KindInference + type instance Apply ZipWithSym0 l = ZipWithSym1 l + type SplungeSym2 (t :: [Nat]) (t :: [Bool]) = Splunge t t + instance SuppressUnusedWarnings SplungeSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SplungeSym1KindInference) GHC.Tuple.()) + data SplungeSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) + = forall arg. SameKind (Apply (SplungeSym1 l) arg) (SplungeSym2 l arg) => + SplungeSym1KindInference + type instance Apply (SplungeSym1 l) l = Splunge l l + instance SuppressUnusedWarnings SplungeSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SplungeSym0KindInference) GHC.Tuple.()) + data SplungeSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => + SplungeSym0KindInference + type instance Apply SplungeSym0 l = SplungeSym1 l + type EtadSym2 (t :: [Nat]) (t :: [Bool]) = Etad t t + instance SuppressUnusedWarnings EtadSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) EtadSym1KindInference) GHC.Tuple.()) + data EtadSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) + = forall arg. SameKind (Apply (EtadSym1 l) arg) (EtadSym2 l arg) => + EtadSym1KindInference + type instance Apply (EtadSym1 l) l = Etad l l + instance SuppressUnusedWarnings EtadSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) EtadSym0KindInference) GHC.Tuple.()) + data EtadSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => + EtadSym0KindInference + type instance Apply EtadSym0 l = EtadSym1 l + type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (t :: Maybe a0123456789876543210) = + LiftMaybe t t + instance SuppressUnusedWarnings LiftMaybeSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.()) + data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)) + = forall arg. SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) => + LiftMaybeSym1KindInference + type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.()) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => + LiftMaybeSym0KindInference + type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l + type MapSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (t :: [a0123456789876543210]) = + Map t t + instance SuppressUnusedWarnings MapSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MapSym1KindInference) GHC.Tuple.()) + data MapSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] [b0123456789876543210]) + = forall arg. SameKind (Apply (MapSym1 l) arg) (MapSym2 l arg) => + MapSym1KindInference + type instance Apply (MapSym1 l) l = Map l l + instance SuppressUnusedWarnings MapSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MapSym0KindInference) GHC.Tuple.()) + data MapSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> GHC.Types.Type) (TyFun [a0123456789876543210] [b0123456789876543210] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => + MapSym0KindInference + type instance Apply MapSym0 l = MapSym1 l + type family Foo (a :: TyFun (TyFun a b + -> GHC.Types.Type) (TyFun a b -> GHC.Types.Type) + -> GHC.Types.Type) (a :: TyFun a b + -> GHC.Types.Type) (a :: a) :: b where + Foo f g a = Apply (Apply f g) a + type family ZipWith (a :: TyFun a (TyFun b c -> GHC.Types.Type) + -> GHC.Types.Type) (a :: [a]) (a :: [b]) :: [c] where + ZipWith f ((:) x xs) ((:) y ys) = Apply (Apply (:@#@$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) + ZipWith _ '[] '[] = '[] + ZipWith _ ((:) _ _) '[] = '[] + ZipWith _ '[] ((:) _ _) = '[] + type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs + type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 + type family LiftMaybe (a :: TyFun a b + -> GHC.Types.Type) (a :: Maybe a) :: Maybe b where + LiftMaybe f (Just x) = Apply JustSym0 (Apply f x) + LiftMaybe _ Nothing = NothingSym0 + type family Map (a :: TyFun a b + -> GHC.Types.Type) (a :: [a]) :: [b] where + Map _ '[] = '[] + Map f ((:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) + sFoo :: + forall (t :: TyFun (TyFun a b -> GHC.Types.Type) (TyFun a b + -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: TyFun a b -> GHC.Types.Type) + (t :: a). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) + sZipWith :: + forall (t :: TyFun a (TyFun b c -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: [a]) + (t :: [b]). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + sSplunge :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) + sEtad :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) + sLiftMaybe :: + forall (t :: TyFun a b -> GHC.Types.Type) (t :: Maybe a). + Sing t + -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) + sMap :: + forall (t :: TyFun a b -> GHC.Types.Type) (t :: [a]). + Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) + sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) + = (applySing ((applySing sF) sG)) sA + sZipWith + (sF :: Sing f) + (SCons (sX :: Sing x) (sXs :: Sing xs)) + (SCons (sY :: Sing y) (sYs :: Sing ys)) + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing sF) sX)) sY))) + ((applySing + ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) + sXs)) + sYs) + sZipWith _ SNil SNil = SNil + sZipWith _ (SCons _ _) SNil = SNil + sZipWith _ SNil (SCons _ _) = SNil + sSplunge (sNs :: Sing ns) (sBs :: Sing bs) + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) + (\ sN sB + -> case (GHC.Tuple.(,) sN) sB of { + GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) + -> case sB of + STrue + -> (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sN) + SFalse -> sN :: + Sing (Case_0123456789876543210 ns bs n b b) })))) + sNs)) + sBs + sEtad + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) + (\ sN sB + -> case (GHC.Tuple.(,) sN) sB of { + GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) + -> case sB of + STrue + -> (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sN) + SFalse -> sN :: + Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) })))) + sA_0123456789876543210)) + sA_0123456789876543210 + sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) + = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) + sLiftMaybe _ SNothing = SNothing + sMap _ SNil = SNil + sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH))) + ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) + data instance Sing (z :: Either a b) + where + SLeft :: forall (n :: a). (Sing (n :: a)) -> Sing (Left n) + SRight :: forall (n :: b). (Sing (n :: b)) -> Sing (Right n) + type SEither = (Sing :: Either a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Either a b) where + type Demote (Either a b) = Either (Demote a) (Demote b) + fromSing (SLeft b) = Left (fromSing b) + fromSing (SRight b) = Right (fromSing b) + toSing (Left (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SLeft c) } + toSing (Right (b :: Demote b)) + = case toSing b :: SomeSing b of { + SomeSing c -> SomeSing (SRight c) } + instance SingI n => SingI (Left (n :: a)) where + sing = SLeft sing + instance SingI n => SingI (Right (n :: b)) where + sing = SRight sing diff --git a/tests/compile-and-dump/Singletons/HigherOrder.hs b/tests/compile-and-dump/Singletons/HigherOrder.hs --- a/tests/compile-and-dump/Singletons/HigherOrder.hs +++ b/tests/compile-and-dump/Singletons/HigherOrder.hs @@ -38,13 +38,13 @@ |]) -foo1a :: Proxy (ZipWith (TyCon2 Either) '[Int, Bool] '[Char, Double]) +foo1a :: Proxy (ZipWith (TyCon 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 (Map (TyCon (Either Int)) '[Bool, Double]) foo2a = Proxy foo2b :: Proxy ('[Either Int Bool, Either Int Double]) diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc82.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LambdaCase.ghc82.template +++ /dev/null @@ -1,222 +0,0 @@ -Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo1 :: a -> Maybe a -> a - foo1 d x - = (\case - Just y -> y - Nothing -> d) - x - foo2 :: a -> Maybe a -> a - foo2 d _ - = (\case - Just y -> y - Nothing -> d) - (Just d) - foo3 :: a -> b -> a - foo3 a b = (\case (p, _) -> p) (a, b) |] - ======> - foo1 :: a -> Maybe a -> a - foo1 d x - = (\case - \ (Just y) -> y - \ Nothing -> d) - x - foo2 :: a -> Maybe a -> a - foo2 d _ - = (\case - \ (Just y) -> y - \ Nothing -> d) - (Just d) - foo3 :: a -> b -> a - foo3 a b = (\case \ (p, _) -> p) (a, b) - type family Case_0123456789876543210 a b x_0123456789876543210 t where - Case_0123456789876543210 a b x_0123456789876543210 '(p, - _z_0123456789876543210) = p - type family Lambda_0123456789876543210 a b t where - Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 d x_0123456789876543210 t where - Case_0123456789876543210 d x_0123456789876543210 (Just y) = y - Case_0123456789876543210 d x_0123456789876543210 Nothing = d - type family Lambda_0123456789876543210 d t where - Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 d x x_0123456789876543210 t where - Case_0123456789876543210 d x x_0123456789876543210 (Just y) = y - Case_0123456789876543210 d x x_0123456789876543210 Nothing = d - type family Lambda_0123456789876543210 d x t where - Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo3 t t - instance SuppressUnusedWarnings Foo3Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.()) - data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) => - Foo3Sym1KindInference - type instance Apply (Foo3Sym1 l) l = Foo3 l l - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo2 t t - instance SuppressUnusedWarnings Foo2Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) - data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => - Foo2Sym1KindInference - type instance Apply (Foo2Sym1 l) l = Foo2 l l - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo1 t t - instance SuppressUnusedWarnings Foo1Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) - data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => - Foo1Sym1KindInference - type instance Apply (Foo1Sym1 l) l = Foo1 l l - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1Sym1 l - type family Foo3 (a :: a) (a :: b) :: a where - Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) - type family Foo2 (a :: a) (a :: Maybe a) :: a where - Foo2 d _z_0123456789876543210 = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) - type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x - sFoo3 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) - sFoo2 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) - sFoo1 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) - sFoo3 (sA :: Sing a) (sB :: Sing b) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of { - STuple2 (sP :: Sing p) _ -> sP } :: - Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) }))) - ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) - sFoo2 (sD :: Sing d) _ - = (applySing - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD :: - Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) }))) - ((applySing ((singFun1 @JustSym0) SJust)) sD) - sFoo1 (sD :: Sing d) (sX :: Sing x) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD :: - Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) }))) - sX diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template @@ -0,0 +1,221 @@ +Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = (\case + Just y -> y + Nothing -> d) + x + foo2 :: a -> Maybe a -> a + foo2 d _ + = (\case + Just y -> y + Nothing -> d) + (Just d) + foo3 :: a -> b -> a + foo3 a b = (\case (p, _) -> p) (a, b) |] + ======> + foo1 :: a -> Maybe a -> a + foo1 d x + = (\case + \ (Just y) -> y + \ Nothing -> d) + x + foo2 :: a -> Maybe a -> a + foo2 d _ + = (\case + \ (Just y) -> y + \ Nothing -> d) + (Just d) + foo3 :: a -> b -> a + foo3 a b = (\case \ (p, _) -> p) (a, b) + type family Case_0123456789876543210 a b x_0123456789876543210 t where + Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p + type family Lambda_0123456789876543210 a b t where + Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 d x_0123456789876543210 t where + Case_0123456789876543210 d x_0123456789876543210 (Just y) = y + Case_0123456789876543210 d x_0123456789876543210 Nothing = d + type family Lambda_0123456789876543210 d t where + Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym2 t t = + Lambda_0123456789876543210 t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 d x x_0123456789876543210 t where + Case_0123456789876543210 d x x_0123456789876543210 (Just y) = y + Case_0123456789876543210 d x x_0123456789876543210 Nothing = d + type family Lambda_0123456789876543210 d x t where + Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo3 t t + instance SuppressUnusedWarnings Foo3Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.()) + data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) => + Foo3Sym1KindInference + type instance Apply (Foo3Sym1 l) l = Foo3 l l + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = + Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = + Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x + sFoo3 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo3 (sA :: Sing a) (sB :: Sing b) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + _ :: Sing x_0123456789876543210 + -> case sX_0123456789876543210 of { + STuple2 (sP :: Sing p) _ -> sP } :: + Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) }))) + ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) + sFoo2 (sD :: Sing d) _ + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + _ :: Sing x_0123456789876543210 + -> case sX_0123456789876543210 of + SJust (sY :: Sing y) -> sY + SNothing -> sD :: + Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) }))) + ((applySing ((singFun1 @JustSym0) SJust)) sD) + sFoo1 (sD :: Sing d) (sX :: Sing x) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + _ :: Sing x_0123456789876543210 + -> case sX_0123456789876543210 of + SJust (sY :: Sing y) -> sY + SNothing -> sD :: + Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) }))) + sX diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc82.template b/tests/compile-and-dump/Singletons/Lambdas.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Lambdas.ghc82.template +++ /dev/null @@ -1,704 +0,0 @@ -Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo0 :: a -> b -> a - foo0 = (\ x y -> x) - foo1 :: a -> b -> a - foo1 x = (\ _ -> x) - foo2 :: a -> b -> a - foo2 x y = (\ _ -> x) y - foo3 :: a -> a - foo3 x = (\ y -> y) x - foo4 :: a -> b -> c -> a - foo4 x y z = (\ _ _ -> x) y z - foo5 :: a -> b -> b - foo5 x y = (\ x -> x) y - foo6 :: a -> b -> a - foo6 a b = (\ x -> \ _ -> x) a b - foo7 :: a -> b -> b - foo7 x y = (\ (_, b) -> b) (x, y) - foo8 :: Foo a b -> a - foo8 x = (\ (Foo a _) -> a) x - - data Foo a b = Foo a b |] - ======> - foo0 :: a -> b -> a - foo0 = \ x y -> x - foo1 :: a -> b -> a - foo1 x = \ _ -> x - foo2 :: a -> b -> a - foo2 x y = (\ _ -> x) y - foo3 :: a -> a - foo3 x = (\ y -> y) x - foo4 :: a -> b -> c -> a - foo4 x y z = ((\ _ _ -> x) y) z - foo5 :: a -> b -> b - foo5 x y = (\ x -> x) y - foo6 :: a -> b -> a - foo6 a b = ((\ x -> \ _ -> x) a) b - foo7 :: a -> b -> b - foo7 x y = (\ (_, b) -> b) (x, y) - data Foo a b = Foo a b - foo8 :: Foo a b -> a - foo8 x = (\ Foo a _ -> a) x - type FooSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo t t - instance SuppressUnusedWarnings FooSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.()) - data FooSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) => - FooSym1KindInference - type instance Apply (FooSym1 l) l = Foo l l - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = FooSym1 l - type family Case_0123456789876543210 x arg_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 (Foo a _z_0123456789876543210) = a - type family Lambda_0123456789876543210 x t where - Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 '(_z_0123456789876543210, - b) = b - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 a b x arg_0123456789876543210 t where - Case_0123456789876543210 a b x arg_0123456789876543210 _z_0123456789876543210 = x - type family Lambda_0123456789876543210 a b x t where - Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Lambda_0123456789876543210 a b t where - Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y x = x - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where - Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_z_0123456789876543210, - _z_0123456789876543210) = x - type family Lambda_0123456789876543210 x y z t t where - Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) - type Lambda_0123456789876543210Sym5 t t t t t = - Lambda_0123456789876543210 t t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym4 l l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) => - Lambda_0123456789876543210Sym4KindInference - type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Lambda_0123456789876543210 x t where - Lambda_0123456789876543210 x y = y - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _z_0123456789876543210 = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _z_0123456789876543210 = x - type family Lambda_0123456789876543210 x a_0123456789876543210 t where - Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Foo8Sym1 (t :: Foo a0123456789876543210 b0123456789876543210) = - Foo8 t - instance SuppressUnusedWarnings Foo8Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.()) - data Foo8Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => - Foo8Sym0KindInference - type instance Apply Foo8Sym0 l = Foo8 l - type Foo7Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo7 t t - instance SuppressUnusedWarnings Foo7Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo7Sym1KindInference) GHC.Tuple.()) - data Foo7Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply (Foo7Sym1 l) arg) (Foo7Sym2 l arg) => - Foo7Sym1KindInference - type instance Apply (Foo7Sym1 l) l = Foo7 l l - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.()) - data Foo7Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0KindInference - type instance Apply Foo7Sym0 l = Foo7Sym1 l - type Foo6Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo6 t t - instance SuppressUnusedWarnings Foo6Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo6Sym1KindInference) GHC.Tuple.()) - data Foo6Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo6Sym1 l) arg) (Foo6Sym2 l arg) => - Foo6Sym1KindInference - type instance Apply (Foo6Sym1 l) l = Foo6 l l - instance SuppressUnusedWarnings Foo6Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.()) - data Foo6Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => - Foo6Sym0KindInference - type instance Apply Foo6Sym0 l = Foo6Sym1 l - type Foo5Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo5 t t - instance SuppressUnusedWarnings Foo5Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo5Sym1KindInference) GHC.Tuple.()) - data Foo5Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply (Foo5Sym1 l) arg) (Foo5Sym2 l arg) => - Foo5Sym1KindInference - type instance Apply (Foo5Sym1 l) l = Foo5 l l - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) - data Foo5Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0KindInference - type instance Apply Foo5Sym0 l = Foo5Sym1 l - type Foo4Sym3 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) = - Foo4 t t t - instance SuppressUnusedWarnings Foo4Sym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo4Sym2KindInference) GHC.Tuple.()) - data Foo4Sym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo4Sym2 l l) arg) (Foo4Sym3 l l arg) => - Foo4Sym2KindInference - type instance Apply (Foo4Sym2 l l) l = Foo4 l l l - instance SuppressUnusedWarnings Foo4Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo4Sym1KindInference) GHC.Tuple.()) - data Foo4Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (Foo4Sym1 l) arg) (Foo4Sym2 l arg) => - Foo4Sym1KindInference - type instance Apply (Foo4Sym1 l) l = Foo4Sym2 l l - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) - data Foo4Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0KindInference - type instance Apply Foo4Sym0 l = Foo4Sym1 l - type Foo3Sym1 (t :: a0123456789876543210) = Foo3 t - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3 l - type Foo2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo2 t t - instance SuppressUnusedWarnings Foo2Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) - data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => - Foo2Sym1KindInference - type instance Apply (Foo2Sym1 l) l = Foo2 l l - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo1 t t - instance SuppressUnusedWarnings Foo1Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) - data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => - Foo1Sym1KindInference - type instance Apply (Foo1Sym1 l) l = Foo1 l l - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1Sym1 l - type Foo0Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo0 t t - instance SuppressUnusedWarnings Foo0Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo0Sym1KindInference) GHC.Tuple.()) - data Foo0Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo0Sym1 l) arg) (Foo0Sym2 l arg) => - Foo0Sym1KindInference - type instance Apply (Foo0Sym1 l) l = Foo0 l l - instance SuppressUnusedWarnings Foo0Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo0Sym0KindInference) GHC.Tuple.()) - data Foo0Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => - Foo0Sym0KindInference - type instance Apply Foo0Sym0 l = Foo0Sym1 l - type family Foo8 (a :: Foo a b) :: a where - Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x - type family Foo7 (a :: a) (a :: b) :: b where - Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) - type family Foo6 (a :: a) (a :: b) :: a where - Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b - type family Foo5 (a :: a) (a :: b) :: b where - Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Foo4 (a :: a) (a :: b) (a :: c) :: a where - Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z - type family Foo3 (a :: a) :: a where - Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x - type family Foo2 (a :: a) (a :: b) :: a where - Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Foo1 (a :: a) (a :: b) :: a where - Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 - type family Foo0 (a :: a) (a :: b) :: a where - Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 - sFoo8 :: - forall (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) - sFoo7 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) - sFoo6 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) - sFoo5 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) - sFoo4 :: - forall (t :: a) (t :: b) (t :: c). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) - sFoo3 :: forall (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) - sFoo2 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) - sFoo1 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) - sFoo0 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) - sFoo8 (sX :: Sing x) - = (applySing - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { - SFoo (sA :: Sing a) _ -> sA } :: - Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))) - sX - sFoo7 (sX :: Sing x) (sY :: Sing y) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { - STuple2 _ (sB :: Sing b) -> sB } :: - Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) - ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) - sFoo6 (sA :: Sing a) (sB :: Sing b) - = (applySing - ((applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) - (\ sX - -> case sX of { - _ :: Sing x - -> (singFun1 - @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) }))) - sA)) - sB - sFoo5 (sX :: Sing x) (sY :: Sing y) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sX -> case sX of { _ :: Sing x -> sX }))) - sY - sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z) - = (applySing - ((applySing - ((singFun2 - @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z)) - (\ sArg_0123456789876543210 sArg_0123456789876543210 - -> case - (GHC.Tuple.(,) sArg_0123456789876543210) sArg_0123456789876543210 - of { - GHC.Tuple.(,) (_ :: Sing arg_0123456789876543210) - (_ :: Sing arg_0123456789876543210) - -> case - (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - sArg_0123456789876543210)) - sArg_0123456789876543210 - of { - STuple2 _ _ -> sX } :: - Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) }))) - sY)) - sZ - sFoo3 (sX :: Sing x) - = (applySing - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) - (\ sY -> case sY of { _ :: Sing y -> sY }))) - sX - sFoo2 (sX :: Sing x) (sY :: Sing y) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) - sY - sFoo1 - (sX :: Sing x) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) - sA_0123456789876543210 - sFoo0 - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((singFun2 - @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) - (\ sX sY - -> case (GHC.Tuple.(,) sX) sY of { - GHC.Tuple.(,) (_ :: Sing x) (_ :: Sing y) -> sX }))) - sA_0123456789876543210)) - sA_0123456789876543210 - data instance Sing (z :: Foo a b) - = 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 Demote (Foo a b) = Foo (Demote a) (Demote 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 diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc84.template b/tests/compile-and-dump/Singletons/Lambdas.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Lambdas.ghc84.template @@ -0,0 +1,704 @@ +Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo0 :: a -> b -> a + foo0 = (\ x y -> x) + foo1 :: a -> b -> a + foo1 x = (\ _ -> x) + foo2 :: a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: a -> a + foo3 x = (\ y -> y) x + foo4 :: a -> b -> c -> a + foo4 x y z = (\ _ _ -> x) y z + foo5 :: a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: a -> b -> a + foo6 a b = (\ x -> \ _ -> x) a b + foo7 :: a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + foo8 :: Foo a b -> a + foo8 x = (\ (Foo a _) -> a) x + + data Foo a b = Foo a b |] + ======> + foo0 :: a -> b -> a + foo0 = \ x y -> x + foo1 :: a -> b -> a + foo1 x = \ _ -> x + foo2 :: a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: a -> a + foo3 x = (\ y -> y) x + foo4 :: a -> b -> c -> a + foo4 x y z = ((\ _ _ -> x) y) z + foo5 :: a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: a -> b -> a + foo6 a b = ((\ x -> \ _ -> x) a) b + foo7 :: a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + data Foo a b = Foo a b + foo8 :: Foo a b -> a + foo8 x = (\ Foo a _ -> a) x + type FooSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo t t + instance SuppressUnusedWarnings FooSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.()) + data FooSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) => + FooSym1KindInference + type instance Apply (FooSym1 l) l = Foo l l + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Case_0123456789876543210 x arg_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym2 t t = + Lambda_0123456789876543210 t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 a b x arg_0123456789876543210 t where + Case_0123456789876543210 a b x arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 a b x t where + Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym4 t t t t = + Lambda_0123456789876543210 t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Lambda_0123456789876543210 a b t where + Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y x = x + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where + Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_, + _) = x + type family Lambda_0123456789876543210 x y z t t where + Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) + type Lambda_0123456789876543210Sym5 t t t t t = + Lambda_0123456789876543210 t t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym4 l l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) => + Lambda_0123456789876543210Sym4KindInference + type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x y = y + type Lambda_0123456789876543210Sym2 t t = + Lambda_0123456789876543210 t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x a_0123456789876543210 t where + Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x + type Lambda_0123456789876543210Sym4 t t t t = + Lambda_0123456789876543210 t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type Foo8Sym1 (t :: Foo a0123456789876543210 b0123456789876543210) = + Foo8 t + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.()) + data Foo8Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => + Foo8Sym0KindInference + type instance Apply Foo8Sym0 l = Foo8 l + type Foo7Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo7 t t + instance SuppressUnusedWarnings Foo7Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo7Sym1KindInference) GHC.Tuple.()) + data Foo7Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) + = forall arg. SameKind (Apply (Foo7Sym1 l) arg) (Foo7Sym2 l arg) => + Foo7Sym1KindInference + type instance Apply (Foo7Sym1 l) l = Foo7 l l + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.()) + data Foo7Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0KindInference + type instance Apply Foo7Sym0 l = Foo7Sym1 l + type Foo6Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo6 t t + instance SuppressUnusedWarnings Foo6Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo6Sym1KindInference) GHC.Tuple.()) + data Foo6Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo6Sym1 l) arg) (Foo6Sym2 l arg) => + Foo6Sym1KindInference + type instance Apply (Foo6Sym1 l) l = Foo6 l l + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.()) + data Foo6Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => + Foo6Sym0KindInference + type instance Apply Foo6Sym0 l = Foo6Sym1 l + type Foo5Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo5 t t + instance SuppressUnusedWarnings Foo5Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo5Sym1KindInference) GHC.Tuple.()) + data Foo5Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) + = forall arg. SameKind (Apply (Foo5Sym1 l) arg) (Foo5Sym2 l arg) => + Foo5Sym1KindInference + type instance Apply (Foo5Sym1 l) l = Foo5 l l + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5Sym1 l + type Foo4Sym3 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) = + Foo4 t t t + instance SuppressUnusedWarnings Foo4Sym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo4Sym2KindInference) GHC.Tuple.()) + data Foo4Sym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo4Sym2 l l) arg) (Foo4Sym3 l l arg) => + Foo4Sym2KindInference + type instance Apply (Foo4Sym2 l l) l = Foo4 l l l + instance SuppressUnusedWarnings Foo4Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo4Sym1KindInference) GHC.Tuple.()) + data Foo4Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (Foo4Sym1 l) arg) (Foo4Sym2 l arg) => + Foo4Sym1KindInference + type instance Apply (Foo4Sym1 l) l = Foo4Sym2 l l + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210 + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4Sym1 l + type Foo3Sym1 (t :: a0123456789876543210) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3 l + type Foo2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type Foo0Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Foo0 t t + instance SuppressUnusedWarnings Foo0Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo0Sym1KindInference) GHC.Tuple.()) + data Foo0Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (Foo0Sym1 l) arg) (Foo0Sym2 l arg) => + Foo0Sym1KindInference + type instance Apply (Foo0Sym1 l) l = Foo0 l l + instance SuppressUnusedWarnings Foo0Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo0Sym0KindInference) GHC.Tuple.()) + data Foo0Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => + Foo0Sym0KindInference + type instance Apply Foo0Sym0 l = Foo0Sym1 l + type family Foo8 (a :: Foo a b) :: a where + Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x + type family Foo7 (a :: a) (a :: b) :: b where + Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) + type family Foo6 (a :: a) (a :: b) :: a where + Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b + type family Foo5 (a :: a) (a :: b) :: b where + Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Foo4 (a :: a) (a :: b) (a :: c) :: a where + Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z + type family Foo3 (a :: a) :: a where + Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x + type family Foo2 (a :: a) (a :: b) :: a where + Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Foo1 (a :: a) (a :: b) :: a where + Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 + type family Foo0 (a :: a) (a :: b) :: a where + Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 + sFoo8 :: + forall (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) + sFoo7 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) + sFoo6 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) + sFoo5 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) + sFoo4 :: + forall (t :: a) (t :: b) (t :: c). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) + sFoo3 :: forall (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) + sFoo2 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo0 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) + sFoo8 (sX :: Sing x) + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { + SFoo (sA :: Sing a) _ -> sA } :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))) + sX + sFoo7 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { + STuple2 _ (sB :: Sing b) -> sB } :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) + sFoo6 (sA :: Sing a) (sB :: Sing b) + = (applySing + ((applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) + (\ sX + -> case sX of { + _ :: Sing x + -> (singFun1 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sX } :: + Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) }))) + sA)) + sB + sFoo5 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sX -> case sX of { _ :: Sing x -> sX }))) + sY + sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z)) + (\ sArg_0123456789876543210 sArg_0123456789876543210 + -> case + (GHC.Tuple.(,) sArg_0123456789876543210) sArg_0123456789876543210 + of { + GHC.Tuple.(,) (_ :: Sing arg_0123456789876543210) + (_ :: Sing arg_0123456789876543210) + -> case + (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + sArg_0123456789876543210)) + sArg_0123456789876543210 + of { + STuple2 _ _ -> sX } :: + Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) }))) + sY)) + sZ + sFoo3 (sX :: Sing x) + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sY -> case sY of { _ :: Sing y -> sY }))) + sX + sFoo2 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sX } :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY + sFoo1 + (sX :: Sing x) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sX } :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) + sA_0123456789876543210 + sFoo0 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) + (\ sX sY + -> case (GHC.Tuple.(,) sX) sY of { + GHC.Tuple.(,) (_ :: Sing x) (_ :: Sing y) -> sX }))) + sA_0123456789876543210)) + sA_0123456789876543210 + data instance Sing (z :: Foo a b) + where + SFoo :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Foo n n) + type SFoo = (Sing :: Foo a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Foo a b) where + type Demote (Foo a b) = Foo (Demote a) (Demote b) + fromSing (SFoo b b) = (Foo (fromSing b)) (fromSing b) + toSing (Foo (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) } + instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where + sing = (SFoo sing) sing diff --git a/tests/compile-and-dump/Singletons/Lambdas.hs b/tests/compile-and-dump/Singletons/Lambdas.hs --- a/tests/compile-and-dump/Singletons/Lambdas.hs +++ b/tests/compile-and-dump/Singletons/Lambdas.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-name-shadowing -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing -Wno-unused-imports #-} {-# LANGUAGE UnboxedTuples #-} -- We expect unused binds and name shadowing in foo5 test. diff --git a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc82.template b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc82.template +++ /dev/null @@ -1,71 +0,0 @@ -Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: [Nat] - foo - = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] - bar :: [Nat] - bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |] - ======> - foo :: [Nat] - foo - = (map (\ x -> ((either_ pred) Succ) x)) - [Left Zero, Right (Succ Zero)] - bar :: [Nat] - bar = (map ((either_ pred) Succ)) [Left Zero, Right (Succ Zero)] - type family Lambda_0123456789876543210 t where - Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x - type Lambda_0123456789876543210Sym1 t = - Lambda_0123456789876543210 t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l - type BarSym0 = Bar - type FooSym0 = Foo - type family Bar :: [Nat] where - = 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 - = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) - sBar :: Sing (BarSym0 :: [Nat]) - sFoo :: Sing (FooSym0 :: [Nat]) - sBar - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((applySing - ((applySing ((singFun3 @Either_Sym0) sEither_)) - ((singFun1 @PredSym0) sPred))) - ((singFun1 @SuccSym0) SSucc)))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @RightSym0) SRight)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) - sFoo - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((singFun1 @Lambda_0123456789876543210Sym0) - (\ sX - -> case sX of { - _ :: Sing x - -> (applySing - ((applySing - ((applySing ((singFun3 @Either_Sym0) sEither_)) - ((singFun1 @PredSym0) sPred))) - ((singFun1 @SuccSym0) SSucc))) - sX })))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @RightSym0) SRight)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) diff --git a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.template b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.template @@ -0,0 +1,71 @@ +Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: [Nat] + foo + = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] + bar :: [Nat] + bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |] + ======> + foo :: [Nat] + foo + = (map (\ x -> ((either_ pred) Succ) x)) + [Left Zero, Right (Succ Zero)] + bar :: [Nat] + bar = (map ((either_ pred) Succ)) [Left Zero, Right (Succ Zero)] + type family Lambda_0123456789876543210 t where + Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x + type Lambda_0123456789876543210Sym1 t = + Lambda_0123456789876543210 t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l + type BarSym0 = Bar + type FooSym0 = Foo + type family Bar :: [Nat] where + Bar = Apply (Apply MapSym0 (Apply (Apply Either_Sym0 PredSym0) SuccSym0)) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Foo :: [Nat] where + Foo = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + sBar :: Sing (BarSym0 :: [Nat]) + sFoo :: Sing (FooSym0 :: [Nat]) + sBar + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((applySing + ((applySing ((singFun3 @Either_Sym0) sEither_)) + ((singFun1 @PredSym0) sPred))) + ((singFun1 @SuccSym0) SSucc)))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @RightSym0) SRight)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sFoo + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((singFun1 @Lambda_0123456789876543210Sym0) + (\ sX + -> case sX of { + _ :: Sing x + -> (applySing + ((applySing + ((applySing ((singFun3 @Either_Sym0) sEither_)) + ((singFun1 @PredSym0) sPred))) + ((singFun1 @SuccSym0) SSucc))) + sX })))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @RightSym0) SRight)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc82.template b/tests/compile-and-dump/Singletons/LetStatements.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LetStatements.ghc82.template +++ /dev/null @@ -1,908 +0,0 @@ -Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo1 :: Nat -> Nat - foo1 x - = let - y :: Nat - y = Succ Zero - in y - foo2 :: Nat - foo2 - = let - y = Succ Zero - z = Succ y - in z - foo3 :: Nat -> Nat - foo3 x - = let - y :: Nat - y = Succ x - in y - foo4 :: Nat -> Nat - foo4 x - = let - f :: Nat -> Nat - f y = Succ y - in f x - foo5 :: Nat -> Nat - foo5 x - = let - f :: Nat -> Nat - f y - = let - z :: Nat - z = Succ y - in Succ z - in f x - foo6 :: Nat -> Nat - foo6 x - = let - f :: Nat -> Nat - f y = Succ y in - let - z :: Nat - z = f x - in z - foo7 :: Nat -> Nat - foo7 x - = let - x :: Nat - x = Zero - in x - foo8 :: Nat -> Nat - foo8 x - = let - z :: Nat - z = (\ x -> x) Zero - in z - foo9 :: Nat -> Nat - foo9 x - = let - z :: Nat -> Nat - z = (\ x -> x) - in z x - foo10 :: Nat -> Nat - foo10 x - = let - (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - in (Succ Zero) + x - foo11 :: Nat -> Nat - foo11 x - = let - (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - z :: Nat - z = x - in (Succ Zero) + z - foo12 :: Nat -> Nat - foo12 x - = let - (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + x) - in x + (Succ (Succ Zero)) - foo13 :: forall a. a -> a - foo13 x - = let - bar :: a - bar = x - in foo13_ bar - foo13_ :: a -> a - foo13_ y = y - foo14 :: Nat -> (Nat, Nat) - foo14 x = let (y, z) = (Succ x, x) in (z, y) |] - ======> - foo1 :: Nat -> Nat - foo1 x - = let - y :: Nat - y = Succ Zero - in y - foo2 :: Nat - foo2 - = let - y = Succ Zero - z = Succ y - in z - foo3 :: Nat -> Nat - foo3 x - = let - y :: Nat - y = Succ x - in y - foo4 :: Nat -> Nat - foo4 x - = let - f :: Nat -> Nat - f y = Succ y - in f x - foo5 :: Nat -> Nat - foo5 x - = let - f :: Nat -> Nat - f y - = let - z :: Nat - z = Succ y - in Succ z - in f x - foo6 :: Nat -> Nat - foo6 x - = let - f :: Nat -> Nat - f y = Succ y in - let - z :: Nat - z = f x - in z - foo7 :: Nat -> Nat - foo7 x - = let - x :: Nat - x = Zero - in x - foo8 :: Nat -> Nat - foo8 x - = let - z :: Nat - z = (\ x -> x) Zero - in z - foo9 :: Nat -> Nat - foo9 x - = let - z :: Nat -> Nat - z = \ x -> x - in z x - foo10 :: Nat -> Nat - foo10 x - = let - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - in ((Succ Zero) + x) - foo11 :: Nat -> Nat - foo11 x - = let - (+) :: Nat -> Nat -> Nat - z :: Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - z = x - in ((Succ Zero) + z) - foo12 :: Nat -> Nat - foo12 x - = let - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + x) - in (x + (Succ (Succ Zero))) - foo13 :: forall a. a -> a - foo13 x - = let - bar :: a - bar = x - in foo13_ bar - foo13_ :: a -> a - foo13_ y = y - foo14 :: Nat -> (Nat, Nat) - foo14 x = let (y, z) = (Succ x, x) in (z, y) - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x '(y_0123456789876543210, - _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x '(_z_0123456789876543210, - y_0123456789876543210) = y_0123456789876543210 - type Let0123456789876543210YSym1 t = Let0123456789876543210Y t - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210YSym0 l - = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0KindInference - type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l - type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l - type Let0123456789876543210X_0123456789876543210Sym1 t = - Let0123456789876543210X_0123456789876543210 t - instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210X_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210X_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => - Let0123456789876543210X_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210X_0123456789876543210Sym0 l = Let0123456789876543210X_0123456789876543210 l - type family Let0123456789876543210Y x where - Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) - type family Let0123456789876543210Z x where - Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) - type family Let0123456789876543210X_0123456789876543210 x where - Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x - type Let0123456789876543210BarSym1 t = Let0123456789876543210Bar t - instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210BarSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210BarSym0 l - = forall arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => - Let0123456789876543210BarSym0KindInference - type instance Apply Let0123456789876543210BarSym0 l = Let0123456789876543210Bar l - type family Let0123456789876543210Bar x :: a where - Let0123456789876543210Bar x = x - type (:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = - (:<<<%%%%%%%%%%%%%%%%%%%:+) t t t - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) l l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+) l l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l (l :: TyFun Nat (TyFun Nat Nat - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$) l - = forall arg. SameKind (Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$###) - type instance Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l - type family (:<<<%%%%%%%%%%%%%%%%%%%:+) x (a :: Nat) (a :: Nat) :: Nat where - (:<<<%%%%%%%%%%%%%%%%%%%:+) x Zero m = m - (:<<<%%%%%%%%%%%%%%%%%%%:+) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) n) x) - type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l - type (:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = - (:<<<%%%%%%%%%%%%%%%%%%%:+) t t t - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) l l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+) l l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l (l :: TyFun Nat (TyFun Nat Nat - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$) l - = forall arg. SameKind (Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$###) - type instance Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = x - type family (:<<<%%%%%%%%%%%%%%%%%%%:+) x (a :: Nat) (a :: Nat) :: Nat where - (:<<<%%%%%%%%%%%%%%%%%%%:+) x Zero m = m - (:<<<%%%%%%%%%%%%%%%%%%%:+) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) n) m) - type (:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = - (:<<<%%%%%%%%%%%%%%%%%%%:+) t t t - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$$) l l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+) l l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l (l :: TyFun Nat (TyFun Nat Nat - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$$###) - type instance Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$$) l l - instance SuppressUnusedWarnings (:<<<%%%%%%%%%%%%%%%%%%%:+$) where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%:+$###)) GHC.Tuple.()) - data (:<<<%%%%%%%%%%%%%%%%%%%:+$) l - = forall arg. SameKind (Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) arg) ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) arg) => - (:<<<%%%%%%%%%%%%%%%%%%%:+$###) - type instance Apply (:<<<%%%%%%%%%%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%%%%%%%%%%:+$$) l - type family (:<<<%%%%%%%%%%%%%%%%%%%:+) x (a :: Nat) (a :: Nat) :: Nat where - (:<<<%%%%%%%%%%%%%%%%%%%:+) x Zero m = m - (:<<<%%%%%%%%%%%%%%%%%%%:+) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) n) m) - type family Lambda_0123456789876543210 x a_0123456789876543210 t where - Lambda_0123456789876543210 x a_0123456789876543210 x = x - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Let0123456789876543210ZSym2 t (t :: Nat) = - Let0123456789876543210Z t t - instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym1 l (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => - Let0123456789876543210ZSym1KindInference - type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l - type family Let0123456789876543210Z x (a :: Nat) :: Nat where - Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 - type family Lambda_0123456789876543210 x t where - Lambda_0123456789876543210 x x = x - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 - type Let0123456789876543210XSym1 t = Let0123456789876543210X t - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210XSym0 l - = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0KindInference - type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l - type family Let0123456789876543210X x :: Nat where - Let0123456789876543210X x = ZeroSym0 - type Let0123456789876543210FSym2 t (t :: Nat) = - Let0123456789876543210F t t - instance SuppressUnusedWarnings Let0123456789876543210FSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => - Let0123456789876543210FSym1KindInference - type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym0 l - = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0KindInference - type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 y - type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x - type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t - instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => - Let0123456789876543210ZSym1KindInference - type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210ZSym0 l - = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0KindInference - type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l - type family Let0123456789876543210Z x y :: Nat where - Let0123456789876543210Z x y = Apply SuccSym0 y - type Let0123456789876543210FSym2 t (t :: Nat) = - Let0123456789876543210F t t - instance SuppressUnusedWarnings Let0123456789876543210FSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => - Let0123456789876543210FSym1KindInference - type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym0 l - = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0KindInference - type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y) - type Let0123456789876543210FSym2 t (t :: Nat) = - Let0123456789876543210F t t - instance SuppressUnusedWarnings Let0123456789876543210FSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => - Let0123456789876543210FSym1KindInference - type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210FSym0 l - = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0KindInference - type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 y - type Let0123456789876543210YSym1 t = Let0123456789876543210Y t - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210YSym0 l - = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0KindInference - type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l - type family Let0123456789876543210Y x :: Nat where - Let0123456789876543210Y x = Apply SuccSym0 x - type Let0123456789876543210YSym0 = Let0123456789876543210Y - type Let0123456789876543210ZSym0 = Let0123456789876543210Z - type family Let0123456789876543210Y where - = Apply SuccSym0 ZeroSym0 - type family Let0123456789876543210Z where - = Apply SuccSym0 Let0123456789876543210YSym0 - type Let0123456789876543210YSym1 t = Let0123456789876543210Y t - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210YSym0 l - = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0KindInference - type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l - type family Let0123456789876543210Y x :: Nat where - Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 - type Foo14Sym1 (t :: Nat) = Foo14 t - instance SuppressUnusedWarnings Foo14Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo14Sym0KindInference) GHC.Tuple.()) - data Foo14Sym0 (l :: TyFun Nat (Nat, Nat)) - = forall arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => - Foo14Sym0KindInference - type instance Apply Foo14Sym0 l = Foo14 l - type Foo13_Sym1 (t :: a0123456789876543210) = Foo13_ t - instance SuppressUnusedWarnings Foo13_Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo13_Sym0KindInference) GHC.Tuple.()) - data Foo13_Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => - Foo13_Sym0KindInference - type instance Apply Foo13_Sym0 l = Foo13_ l - type Foo13Sym1 (t :: a0123456789876543210) = Foo13 t - instance SuppressUnusedWarnings Foo13Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo13Sym0KindInference) GHC.Tuple.()) - data Foo13Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => - Foo13Sym0KindInference - type instance Apply Foo13Sym0 l = Foo13 l - type Foo12Sym1 (t :: Nat) = Foo12 t - instance SuppressUnusedWarnings Foo12Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo12Sym0KindInference) GHC.Tuple.()) - data Foo12Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => - Foo12Sym0KindInference - type instance Apply Foo12Sym0 l = Foo12 l - type Foo11Sym1 (t :: Nat) = Foo11 t - instance SuppressUnusedWarnings Foo11Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo11Sym0KindInference) GHC.Tuple.()) - data Foo11Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => - Foo11Sym0KindInference - type instance Apply Foo11Sym0 l = Foo11 l - type Foo10Sym1 (t :: Nat) = Foo10 t - instance SuppressUnusedWarnings Foo10Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo10Sym0KindInference) GHC.Tuple.()) - data Foo10Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => - Foo10Sym0KindInference - type instance Apply Foo10Sym0 l = Foo10 l - type Foo9Sym1 (t :: Nat) = Foo9 t - instance SuppressUnusedWarnings Foo9Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo9Sym0KindInference) GHC.Tuple.()) - data Foo9Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => - Foo9Sym0KindInference - type instance Apply Foo9Sym0 l = Foo9 l - type Foo8Sym1 (t :: Nat) = Foo8 t - instance SuppressUnusedWarnings Foo8Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.()) - data Foo8Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => - Foo8Sym0KindInference - type instance Apply Foo8Sym0 l = Foo8 l - type Foo7Sym1 (t :: Nat) = Foo7 t - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.()) - data Foo7Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0KindInference - type instance Apply Foo7Sym0 l = Foo7 l - type Foo6Sym1 (t :: Nat) = Foo6 t - instance SuppressUnusedWarnings Foo6Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.()) - data Foo6Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => - Foo6Sym0KindInference - type instance Apply Foo6Sym0 l = Foo6 l - type Foo5Sym1 (t :: Nat) = Foo5 t - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) - data Foo5Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0KindInference - type instance Apply Foo5Sym0 l = Foo5 l - type Foo4Sym1 (t :: Nat) = Foo4 t - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) - data Foo4Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0KindInference - type instance Apply Foo4Sym0 l = Foo4 l - type Foo3Sym1 (t :: Nat) = Foo3 t - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3 l - type Foo2Sym0 = Foo2 - type Foo1Sym1 (t :: Nat) = Foo1 t - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1 l - type family Foo14 (a :: Nat) :: (Nat, Nat) where - Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) - type family Foo13_ (a :: a) :: a where - Foo13_ y = y - type family Foo13 (a :: a) :: a where - Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x) - type family Foo12 (a :: Nat) :: Nat where - Foo12 x = Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) - type family Foo11 (a :: Nat) :: Nat where - Foo11 x = Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x) - type family Foo10 (a :: Nat) :: Nat where - Foo10 x = Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) (Apply SuccSym0 ZeroSym0)) x - type family Foo9 (a :: Nat) :: Nat where - Foo9 x = Apply (Let0123456789876543210ZSym1 x) x - type family Foo8 (a :: Nat) :: Nat where - Foo8 x = Let0123456789876543210ZSym1 x - type family Foo7 (a :: Nat) :: Nat where - Foo7 x = Let0123456789876543210XSym1 x - type family Foo6 (a :: Nat) :: Nat where - Foo6 x = Let0123456789876543210ZSym1 x - type family Foo5 (a :: Nat) :: Nat where - Foo5 x = Apply (Let0123456789876543210FSym1 x) x - type family Foo4 (a :: Nat) :: Nat where - Foo4 x = Apply (Let0123456789876543210FSym1 x) x - type family Foo3 (a :: Nat) :: Nat where - Foo3 x = Let0123456789876543210YSym1 x - type family Foo2 :: Nat where - = Let0123456789876543210ZSym0 - type family Foo1 (a :: Nat) :: Nat where - Foo1 x = Let0123456789876543210YSym1 x - sFoo14 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) - sFoo13_ :: - forall (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) - sFoo13 :: forall (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) - sFoo12 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat) - sFoo11 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat) - sFoo10 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat) - sFoo9 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat) - sFoo8 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat) - sFoo7 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat) - sFoo6 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat) - sFoo5 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat) - sFoo4 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat) - sFoo3 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat) - sFoo2 :: Sing (Foo2Sym0 :: Nat) - sFoo1 :: - forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) - sFoo14 (sX :: Sing x) - = let - sY :: Sing (Let0123456789876543210YSym1 x) - sZ :: Sing (Let0123456789876543210ZSym1 x) - sX_0123456789876543210 :: - Sing (Let0123456789876543210X_0123456789876543210Sym1 x) - sY - = case sX_0123456789876543210 of { - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) - sZ - = case sX_0123456789876543210 of { - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - ((applySing ((singFun1 @SuccSym0) SSucc)) sX))) - sX - in (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sZ)) sY - sFoo13_ (sY :: Sing y) = sY - sFoo13 (sX :: Sing x) - = let - sBar :: Sing (Let0123456789876543210BarSym1 x :: a) - sBar = sX - in (applySing ((singFun1 @Foo13_Sym0) sFoo13_)) sBar - sFoo12 (sX :: Sing x) - = let - (%:+) :: - forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) t) t :: Nat) - (%:+) SZero (sM :: Sing m) = sM - (%:+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - sN)) - sX) - in - (applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - sX)) - ((applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)) - sFoo11 (sX :: Sing x) - = let - sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) - (%:+) :: - forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) t) t :: Nat) - sZ = sX - (%:+) SZero (sM :: Sing m) = sM - (%:+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - sN)) - sM) - in - (applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - sZ - sFoo10 (sX :: Sing x) - = let - (%:+) :: - forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x) t) t :: Nat) - (%:+) SZero (sM :: Sing m) = sM - (%:+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - sN)) - sM) - in - (applySing - ((applySing ((singFun2 @((:<<<%%%%%%%%%%%%%%%%%%%:+$$) x)) (%:+))) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - sX - sFoo9 (sX :: Sing x) - = let - sZ :: - forall (t :: Nat). - Sing t -> Sing (Apply (Let0123456789876543210ZSym1 x) t :: Nat) - sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) - (\ sX -> case sX of { _ :: Sing x -> sX }))) - sA_0123456789876543210 - in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX - sFoo8 (sX :: Sing x) - = let - sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) - sZ - = (applySing - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) - (\ sX -> case sX of { _ :: Sing x -> sX }))) - SZero - in sZ - sFoo7 (sX :: Sing x) - = let - sX :: Sing (Let0123456789876543210XSym1 x :: Nat) - sX = SZero - in sX - sFoo6 (sX :: Sing x) - = let - sF :: - forall (t :: Nat). - Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) - sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in - let - sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) - sZ - = (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX - in sZ - sFoo5 (sX :: Sing x) - = let - sF :: - forall (t :: Nat). - Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) - sF (sY :: Sing y) - = let - sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat) - sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY - in (applySing ((singFun1 @SuccSym0) SSucc)) sZ - in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX - sFoo4 (sX :: Sing x) - = let - sF :: - forall (t :: Nat). - Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) - sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY - in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX - sFoo3 (sX :: Sing x) - = let - sY :: Sing (Let0123456789876543210YSym1 x :: Nat) - sY = (applySing ((singFun1 @SuccSym0) SSucc)) sX - in sY - sFoo2 - = let - sY :: Sing Let0123456789876543210YSym0 - sZ :: Sing Let0123456789876543210ZSym0 - sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero - sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY - in sZ - sFoo1 (sX :: Sing x) - = let - sY :: Sing (Let0123456789876543210YSym1 x :: Nat) - sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero - in sY diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc84.template b/tests/compile-and-dump/Singletons/LetStatements.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LetStatements.ghc84.template @@ -0,0 +1,908 @@ +Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = (\ x -> x) + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + in (Succ Zero) + x + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + z :: Nat + z = x + in (Succ Zero) + z + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + x) + in x + (Succ (Succ Zero)) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) |] + ======> + foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = \ x -> x + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + in ((Succ Zero) + x) + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + z :: Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + z = x + in ((Succ Zero) + z) + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + x) + in (x + (Succ (Succ Zero))) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x '(y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x '(_, + y_0123456789876543210) = y_0123456789876543210 + type Let0123456789876543210YSym1 t = Let0123456789876543210Y t + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210YSym0 l + = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0KindInference + type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l + type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l + type Let0123456789876543210X_0123456789876543210Sym1 t = + Let0123456789876543210X_0123456789876543210 t + instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210X_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210X_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => + Let0123456789876543210X_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210X_0123456789876543210Sym0 l = Let0123456789876543210X_0123456789876543210 l + type family Let0123456789876543210Y x where + Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) + type family Let0123456789876543210Z x where + Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) + type family Let0123456789876543210X_0123456789876543210 x where + Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x + type Let0123456789876543210BarSym1 t = Let0123456789876543210Bar t + instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210BarSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210BarSym0 l + = forall arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => + Let0123456789876543210BarSym0KindInference + type instance Apply Let0123456789876543210BarSym0 l = Let0123456789876543210Bar l + type family Let0123456789876543210Bar x :: a where + Let0123456789876543210Bar x = x + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) t t t + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l + = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x) + type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) t t t + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l + = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = x + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) t t t + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l + = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) + type family Lambda_0123456789876543210 x a_0123456789876543210 t where + Lambda_0123456789876543210 x a_0123456789876543210 x = x + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type Let0123456789876543210ZSym2 t (t :: Nat) = + Let0123456789876543210Z t t + instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym1 l (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => + Let0123456789876543210ZSym1KindInference + type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l + type family Let0123456789876543210Z x (a :: Nat) :: Nat where + Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x x = x + type Lambda_0123456789876543210Sym2 t t = + Lambda_0123456789876543210 t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 + type Let0123456789876543210XSym1 t = Let0123456789876543210X t + instance SuppressUnusedWarnings Let0123456789876543210XSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210XSym0 l + = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => + Let0123456789876543210XSym0KindInference + type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l + type family Let0123456789876543210X x :: Nat where + Let0123456789876543210X x = ZeroSym0 + type Let0123456789876543210FSym2 t (t :: Nat) = + Let0123456789876543210F t t + instance SuppressUnusedWarnings Let0123456789876543210FSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => + Let0123456789876543210FSym1KindInference + type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym0 l + = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0KindInference + type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 y + type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x + type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t + instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) => + Let0123456789876543210ZSym1KindInference + type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210ZSym0 l + = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0KindInference + type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l + type family Let0123456789876543210Z x y :: Nat where + Let0123456789876543210Z x y = Apply SuccSym0 y + type Let0123456789876543210FSym2 t (t :: Nat) = + Let0123456789876543210F t t + instance SuppressUnusedWarnings Let0123456789876543210FSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => + Let0123456789876543210FSym1KindInference + type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym0 l + = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0KindInference + type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y) + type Let0123456789876543210FSym2 t (t :: Nat) = + Let0123456789876543210F t t + instance SuppressUnusedWarnings Let0123456789876543210FSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) => + Let0123456789876543210FSym1KindInference + type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210FSym0 l + = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0KindInference + type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 y + type Let0123456789876543210YSym1 t = Let0123456789876543210Y t + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210YSym0 l + = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0KindInference + type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l + type family Let0123456789876543210Y x :: Nat where + Let0123456789876543210Y x = Apply SuccSym0 x + type Let0123456789876543210YSym0 = Let0123456789876543210Y + type Let0123456789876543210ZSym0 = Let0123456789876543210Z + type family Let0123456789876543210Y where + Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 + type family Let0123456789876543210Z where + Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 + type Let0123456789876543210YSym1 t = Let0123456789876543210Y t + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210YSym0 l + = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0KindInference + type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l + type family Let0123456789876543210Y x :: Nat where + Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 + type Foo14Sym1 (t :: Nat) = Foo14 t + instance SuppressUnusedWarnings Foo14Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo14Sym0KindInference) GHC.Tuple.()) + data Foo14Sym0 (l :: TyFun Nat (Nat, Nat)) + = forall arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => + Foo14Sym0KindInference + type instance Apply Foo14Sym0 l = Foo14 l + type Foo13_Sym1 (t :: a0123456789876543210) = Foo13_ t + instance SuppressUnusedWarnings Foo13_Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo13_Sym0KindInference) GHC.Tuple.()) + data Foo13_Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => + Foo13_Sym0KindInference + type instance Apply Foo13_Sym0 l = Foo13_ l + type Foo13Sym1 (t :: a0123456789876543210) = Foo13 t + instance SuppressUnusedWarnings Foo13Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo13Sym0KindInference) GHC.Tuple.()) + data Foo13Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => + Foo13Sym0KindInference + type instance Apply Foo13Sym0 l = Foo13 l + type Foo12Sym1 (t :: Nat) = Foo12 t + instance SuppressUnusedWarnings Foo12Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo12Sym0KindInference) GHC.Tuple.()) + data Foo12Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => + Foo12Sym0KindInference + type instance Apply Foo12Sym0 l = Foo12 l + type Foo11Sym1 (t :: Nat) = Foo11 t + instance SuppressUnusedWarnings Foo11Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo11Sym0KindInference) GHC.Tuple.()) + data Foo11Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => + Foo11Sym0KindInference + type instance Apply Foo11Sym0 l = Foo11 l + type Foo10Sym1 (t :: Nat) = Foo10 t + instance SuppressUnusedWarnings Foo10Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo10Sym0KindInference) GHC.Tuple.()) + data Foo10Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => + Foo10Sym0KindInference + type instance Apply Foo10Sym0 l = Foo10 l + type Foo9Sym1 (t :: Nat) = Foo9 t + instance SuppressUnusedWarnings Foo9Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo9Sym0KindInference) GHC.Tuple.()) + data Foo9Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => + Foo9Sym0KindInference + type instance Apply Foo9Sym0 l = Foo9 l + type Foo8Sym1 (t :: Nat) = Foo8 t + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.()) + data Foo8Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => + Foo8Sym0KindInference + type instance Apply Foo8Sym0 l = Foo8 l + type Foo7Sym1 (t :: Nat) = Foo7 t + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.()) + data Foo7Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0KindInference + type instance Apply Foo7Sym0 l = Foo7 l + type Foo6Sym1 (t :: Nat) = Foo6 t + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.()) + data Foo6Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => + Foo6Sym0KindInference + type instance Apply Foo6Sym0 l = Foo6 l + type Foo5Sym1 (t :: Nat) = Foo5 t + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5 l + type Foo4Sym1 (t :: Nat) = Foo4 t + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4 l + type Foo3Sym1 (t :: Nat) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3 l + type Foo2Sym0 = Foo2 + type Foo1Sym1 (t :: Nat) = Foo1 t + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1 l + type family Foo14 (a :: Nat) :: (Nat, Nat) where + Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) + type family Foo13_ (a :: a) :: a where + Foo13_ y = y + type family Foo13 (a :: a) :: a where + Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x) + type family Foo12 (a :: Nat) :: Nat where + Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) + type family Foo11 (a :: Nat) :: Nat where + Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x) + type family Foo10 (a :: Nat) :: Nat where + Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) x + type family Foo9 (a :: Nat) :: Nat where + Foo9 x = Apply (Let0123456789876543210ZSym1 x) x + type family Foo8 (a :: Nat) :: Nat where + Foo8 x = Let0123456789876543210ZSym1 x + type family Foo7 (a :: Nat) :: Nat where + Foo7 x = Let0123456789876543210XSym1 x + type family Foo6 (a :: Nat) :: Nat where + Foo6 x = Let0123456789876543210ZSym1 x + type family Foo5 (a :: Nat) :: Nat where + Foo5 x = Apply (Let0123456789876543210FSym1 x) x + type family Foo4 (a :: Nat) :: Nat where + Foo4 x = Apply (Let0123456789876543210FSym1 x) x + type family Foo3 (a :: Nat) :: Nat where + Foo3 x = Let0123456789876543210YSym1 x + type family Foo2 :: Nat where + Foo2 = Let0123456789876543210ZSym0 + type family Foo1 (a :: Nat) :: Nat where + Foo1 x = Let0123456789876543210YSym1 x + sFoo14 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) + sFoo13_ :: + forall (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) + sFoo13 :: forall (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) + sFoo12 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat) + sFoo11 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat) + sFoo10 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat) + sFoo9 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat) + sFoo8 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat) + sFoo7 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat) + sFoo6 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat) + sFoo5 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat) + sFoo4 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat) + sFoo3 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat) + sFoo2 :: Sing (Foo2Sym0 :: Nat) + sFoo1 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) + sFoo14 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x) + sZ :: Sing (Let0123456789876543210ZSym1 x) + sX_0123456789876543210 :: + Sing (Let0123456789876543210X_0123456789876543210Sym1 x) + sY + = case sX_0123456789876543210 of { + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) + sZ + = case sX_0123456789876543210 of { + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sX))) + sX + in (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sZ)) sY + sFoo13_ (sY :: Sing y) = sY + sFoo13 (sX :: Sing x) + = let + sBar :: Sing (Let0123456789876543210BarSym1 x :: a) + sBar = sX + in (applySing ((singFun1 @Foo13_Sym0) sFoo13_)) sBar + sFoo12 (sX :: Sing x) + = let + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sX) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sX)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)) + sFoo11 (sX :: Sing x) + = let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + sZ = sX + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sM) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sZ + sFoo10 (sX :: Sing x) + = let + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sM) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sX + sFoo9 (sX :: Sing x) + = let + sZ :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210ZSym1 x) t :: Nat) + sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) + (\ sX -> case sX of { _ :: Sing x -> sX }))) + sA_0123456789876543210 + in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX + sFoo8 (sX :: Sing x) + = let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + sZ + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sX -> case sX of { _ :: Sing x -> sX }))) + SZero + in sZ + sFoo7 (sX :: Sing x) + = let + sX :: Sing (Let0123456789876543210XSym1 x :: Nat) + sX = SZero + in sX + sFoo6 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in + let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + sZ + = (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + in sZ + sFoo5 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) + = let + sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat) + sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in (applySing ((singFun1 @SuccSym0) SSucc)) sZ + in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + sFoo4 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + sFoo3 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x :: Nat) + sY = (applySing ((singFun1 @SuccSym0) SSucc)) sX + in sY + sFoo2 + = let + sY :: Sing Let0123456789876543210YSym0 + sZ :: Sing Let0123456789876543210ZSym0 + sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero + sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in sZ + sFoo1 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x :: Nat) + sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero + in sY diff --git a/tests/compile-and-dump/Singletons/LetStatements.hs b/tests/compile-and-dump/Singletons/LetStatements.hs --- a/tests/compile-and-dump/Singletons/LetStatements.hs +++ b/tests/compile-and-dump/Singletons/LetStatements.hs @@ -1,5 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-matches - -fno-warn-name-shadowing -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-matches + -Wno-name-shadowing -Wno-unused-imports #-} module Singletons.LetStatements where diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc82.template b/tests/compile-and-dump/Singletons/Maybe.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Maybe.ghc82.template +++ /dev/null @@ -1,62 +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_0123456789876543210 (a :: Maybe k) (b :: Maybe k) :: Bool where - Equals_0123456789876543210 Nothing Nothing = TrueSym0 - Equals_0123456789876543210 (Just a) (Just b) = (:==) a b - Equals_0123456789876543210 (a :: Maybe k) (b :: Maybe k) = FalseSym0 - instance PEq (Maybe k) where - type (:==) (a :: Maybe k) (b :: Maybe k) = Equals_0123456789876543210 a b - type NothingSym0 = Nothing - type JustSym1 (t :: a0123456789876543210) = Just t - instance SuppressUnusedWarnings JustSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) JustSym0KindInference) GHC.Tuple.()) - data JustSym0 (l :: TyFun a0123456789876543210 (Maybe a0123456789876543210)) - = forall arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => - JustSym0KindInference - type instance Apply JustSym0 l = Just l - 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 Demote (Maybe a) = Maybe (Demote 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 diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc84.template b/tests/compile-and-dump/Singletons/Maybe.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Maybe.ghc84.template @@ -0,0 +1,145 @@ +Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Maybe a + = Nothing | Just a + deriving (Eq, Show) |] + ======> + data Maybe a + = Nothing | Just a + deriving (Eq, Show) + type NothingSym0 = Nothing + type JustSym1 (t :: a0123456789876543210) = Just t + instance SuppressUnusedWarnings JustSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) JustSym0KindInference) GHC.Tuple.()) + data JustSym0 (l :: TyFun a0123456789876543210 (Maybe a0123456789876543210)) + = forall arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => + JustSym0KindInference + type instance Apply JustSym0 l = Just l + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Maybe a0123456789876543210) (t :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Maybe a0123456789876543210) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow (Maybe a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where + Equals_0123456789876543210 Nothing Nothing = TrueSym0 + Equals_0123456789876543210 (Just a) (Just b) = (==) a b + Equals_0123456789876543210 (_ :: Maybe a) (_ :: Maybe a) = FalseSym0 + instance PEq (Maybe a) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: Maybe a) + where + SNothing :: Sing Nothing + SJust :: forall (n :: a). (Sing (n :: a)) -> Sing (Just n) + type SMaybe = (Sing :: Maybe a -> GHC.Types.Type) + instance SingKind a => SingKind (Maybe a) where + type Demote (Maybe a) = Maybe (Demote a) + fromSing SNothing = Nothing + fromSing (SJust b) = Just (fromSing b) + toSing Nothing = SomeSing SNothing + toSing (Just (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SJust c) } + instance SShow a => SShow (Maybe a) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) + (t2 :: Maybe a) + (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Maybe a) (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SNothing + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Nothing"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SJust (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Just ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + instance SEq a => SEq (Maybe a) where + (%==) SNothing SNothing = STrue + (%==) SNothing (SJust _) = SFalse + (%==) (SJust _) SNothing = SFalse + (%==) (SJust a) (SJust b) = ((%==) a) b + instance SDecide a => SDecide (Maybe a) where + (%~) SNothing SNothing = Proved Refl + (%~) SNothing (SJust _) = Disproved (\ x -> case x of) + (%~) (SJust _) SNothing = Disproved (\ x -> case x of) + (%~) (SJust a) (SJust b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance Data.Singletons.ShowSing.ShowSing a => + Data.Singletons.ShowSing.ShowSing (Maybe a) where + Data.Singletons.ShowSing.showsSingPrec _ SNothing + = showString "SNothing" + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SJust arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SJust ")) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: Maybe a)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI Nothing where + sing = SNothing + instance SingI n => SingI (Just (n :: a)) where + sing = SJust sing diff --git a/tests/compile-and-dump/Singletons/Maybe.hs b/tests/compile-and-dump/Singletons/Maybe.hs --- a/tests/compile-and-dump/Singletons/Maybe.hs +++ b/tests/compile-and-dump/Singletons/Maybe.hs @@ -1,10 +1,6 @@ -{-# 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) diff --git a/tests/compile-and-dump/Singletons/Nat.ghc82.template b/tests/compile-and-dump/Singletons/Nat.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Nat.ghc82.template +++ /dev/null @@ -1,119 +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_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (:==) a b - Equals_0123456789876543210 (a :: Nat) (b :: Nat) = FalseSym0 - instance PEq Nat where - type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789876543210 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. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type PredSym1 (t :: Nat) = Pred t - instance SuppressUnusedWarnings PredSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PredSym0KindInference) GHC.Tuple.()) - data PredSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => - PredSym0KindInference - type instance Apply PredSym0 l = Pred l - type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t - instance SuppressUnusedWarnings PlusSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PlusSym1KindInference) GHC.Tuple.()) - data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (PlusSym1 l) arg) (PlusSym2 l arg) => - PlusSym1KindInference - type instance Apply (PlusSym1 l) l = Plus l l - instance SuppressUnusedWarnings PlusSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PlusSym0KindInference) GHC.Tuple.()) - data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => - PlusSym0KindInference - type instance Apply PlusSym0 l = PlusSym1 l - type family Pred (a :: Nat) :: Nat where - Pred Zero = ZeroSym0 - Pred (Succ n) = n - type family Plus (a :: Nat) (a :: Nat) :: Nat where - Plus Zero m = m - Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) - sPred :: - forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) - sPlus :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) - sPred SZero = SZero - sPred (SSucc (sN :: Sing n)) = sN - sPlus SZero (sM :: Sing m) = sM - sPlus (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM) - data instance Sing (z :: Nat) - = 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 Demote 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 diff --git a/tests/compile-and-dump/Singletons/Nat.ghc84.template b/tests/compile-and-dump/Singletons/Nat.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Nat.ghc84.template @@ -0,0 +1,260 @@ +Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ (plus n m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read, Ord) |] + ======> + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read, Ord) + plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ ((plus n) m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = Succ l + type PredSym1 (t :: Nat) = Pred t + instance SuppressUnusedWarnings PredSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PredSym0KindInference) GHC.Tuple.()) + data PredSym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => + PredSym0KindInference + type instance Apply PredSym0 l = Pred l + type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t + instance SuppressUnusedWarnings PlusSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PlusSym1KindInference) GHC.Tuple.()) + data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (PlusSym1 l) arg) (PlusSym2 l arg) => + PlusSym1KindInference + type instance Apply (PlusSym1 l) l = Plus l l + instance SuppressUnusedWarnings PlusSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PlusSym0KindInference) GHC.Tuple.()) + data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => + PlusSym0KindInference + type instance Apply PlusSym0 l = PlusSym1 l + type family Pred (a :: Nat) :: Nat where + Pred Zero = ZeroSym0 + Pred (Succ n) = n + type family Plus (a :: Nat) (a :: Nat) :: Nat where + Plus Zero m = m + Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Nat) (t :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Nat) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Nat where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + sPred :: + forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) + sPlus :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) + sPred SZero = SZero + sPred (SSucc (sN :: Sing n)) = sN + sPlus SZero (sM :: Sing m) = sM + sPlus (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM) + data instance Sing (z :: Nat) + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SShow Nat => SShow Nat where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Nat) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SZero + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Zero"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SSucc (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Succ ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance Data.Singletons.ShowSing.ShowSing Nat => + Data.Singletons.ShowSing.ShowSing Nat where + Data.Singletons.ShowSing.showsSingPrec _ SZero = showString "SZero" + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SSucc arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SSucc ")) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + instance Data.Singletons.ShowSing.ShowSing Nat => + Show (Sing (z :: Nat)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing diff --git a/tests/compile-and-dump/Singletons/Nat.hs b/tests/compile-and-dump/Singletons/Nat.hs --- a/tests/compile-and-dump/Singletons/Nat.hs +++ b/tests/compile-and-dump/Singletons/Nat.hs @@ -1,17 +1,12 @@ -{-# 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) + deriving (Eq, Show, Read, Ord) plus :: Nat -> Nat -> Nat plus Zero m = m diff --git a/tests/compile-and-dump/Singletons/Operators.ghc82.template b/tests/compile-and-dump/Singletons/Operators.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Operators.ghc82.template +++ /dev/null @@ -1,101 +0,0 @@ -Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| child :: Foo -> Foo - child FLeaf = FLeaf - child (a :+: _) = a - (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - - data Foo - where - FLeaf :: Foo - (:+:) :: Foo -> Foo -> Foo |] - ======> - data Foo - where - FLeaf :: Foo - (:+:) :: Foo -> Foo -> Foo - child :: Foo -> Foo - child FLeaf = FLeaf - child (a :+: _) = a - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - type FLeafSym0 = FLeaf - type (:+:$$$) (t :: Foo) (t :: Foo) = (:+:) t t - instance SuppressUnusedWarnings (:+:$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+:$$###)) GHC.Tuple.()) - data (:+:$$) (l :: Foo) (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ((:+:$$) l) arg) ((:+:$$$) l arg) => - (:+:$$###) - type instance Apply ((:+:$$) l) l = (:+:) l l - instance SuppressUnusedWarnings (:+:$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+:$###)) GHC.Tuple.()) - data (:+:$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+:$) arg) ((:+:$$) arg) => - (:+:$###) - type instance Apply (:+:$) l = (:+:$$) l - type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t - instance SuppressUnusedWarnings (:+$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$$###)) GHC.Tuple.()) - data (:+$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((:+$$) l) arg) ((:+$$$) l arg) => - (:+$$###) - type instance Apply ((:+$$) l) l = (:+) l l - instance SuppressUnusedWarnings (:+$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$###)) GHC.Tuple.()) - data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+$) arg) ((:+$$) arg) => (:+$###) - type instance Apply (:+$) l = (:+$$) l - type ChildSym1 (t :: Foo) = Child t - instance SuppressUnusedWarnings ChildSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ChildSym0KindInference) GHC.Tuple.()) - data ChildSym0 (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => - ChildSym0KindInference - type instance Apply ChildSym0 l = Child l - type family (:+) (a :: Nat) (a :: Nat) :: Nat where - (:+) Zero m = m - (:+) (Succ n) m = Apply SuccSym0 (Apply (Apply (:+$) n) m) - type family Child (a :: Foo) :: Foo where - Child FLeaf = FLeafSym0 - Child ((:+:) a _z_0123456789876543210) = a - (%:+) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply (:+$) t) t :: Nat) - sChild :: - forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) - (%:+) SZero (sM :: Sing m) = sM - (%:+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @(:+$)) (%:+))) sN)) sM) - sChild SFLeaf = SFLeaf - sChild ((:%+:) (sA :: Sing a) _) = sA - data instance Sing (z :: Foo) - = 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 Demote 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 diff --git a/tests/compile-and-dump/Singletons/Operators.ghc84.template b/tests/compile-and-dump/Singletons/Operators.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Operators.ghc84.template @@ -0,0 +1,103 @@ +Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo |] + ======> + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo + child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + type FLeafSym0 = FLeaf + type (:+:@#@$$$) (t :: Foo) (t :: Foo) = (:+:) t t + instance SuppressUnusedWarnings (:+:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+:@#@$$###)) GHC.Tuple.()) + data (:+:@#@$$) (l :: Foo) (l :: TyFun Foo Foo) + = forall arg. SameKind (Apply ((:+:@#@$$) l) arg) ((:+:@#@$$$) l arg) => + (::+:@#@$$###) + type instance Apply ((:+:@#@$$) l) l = (:+:) l l + instance SuppressUnusedWarnings (:+:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::+:@#@$###)) GHC.Tuple.()) + data (:+:@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => + (::+:@#@$###) + type instance Apply (:+:@#@$) l = (:+:@#@$$) l + type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t + instance SuppressUnusedWarnings (+@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.()) + data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) => + (:+@#@$$###) + type instance Apply ((+@#@$$) l) l = (+) l l + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.()) + data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (:+@#@$###) + type instance Apply (+@#@$) l = (+@#@$$) l + type ChildSym1 (t :: Foo) = Child t + instance SuppressUnusedWarnings ChildSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ChildSym0KindInference) GHC.Tuple.()) + data ChildSym0 (l :: TyFun Foo Foo) + = forall arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => + ChildSym0KindInference + type instance Apply ChildSym0 l = Child l + type family (+) (a :: Nat) (a :: Nat) :: Nat where + (+) Zero m = m + (+) (Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) + type family Child (a :: Foo) :: Foo where + Child FLeaf = FLeafSym0 + Child ((:+:) a _) = a + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) + sChild :: + forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) + sChild SFLeaf = SFLeaf + sChild ((:%+:) (sA :: Sing a) _) = sA + data instance Sing (z :: Foo) + where + SFLeaf :: Sing FLeaf + (:%+:) :: forall (n :: Foo) (n :: Foo). + (Sing (n :: Foo)) -> (Sing (n :: Foo)) -> Sing ((:+:) n n) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SFLeaf = FLeaf + fromSing ((:%+:) b b) = ((:+:) (fromSing b)) (fromSing b) + toSing FLeaf = SomeSing SFLeaf + toSing ((:+:) (b :: Demote Foo) (b :: Demote Foo)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing Foo)) + (toSing b :: SomeSing Foo) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%+:) c) c) } + instance SingI FLeaf where + sing = SFLeaf + instance (SingI n, SingI n) => + SingI ((:+:) (n :: Foo) (n :: Foo)) where + sing = ((:%+:) sing) sing diff --git a/tests/compile-and-dump/Singletons/Operators.hs b/tests/compile-and-dump/Singletons/Operators.hs --- a/tests/compile-and-dump/Singletons/Operators.hs +++ b/tests/compile-and-dump/Singletons/Operators.hs @@ -1,8 +1,7 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.Operators where -import Data.Proxy import Data.Singletons import Data.Singletons.TH import Singletons.Nat diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc82.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/OrdDeriving.ghc82.template +++ /dev/null @@ -1,1109 +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_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (:==) a b - Equals_0123456789876543210 (a :: Nat) (b :: Nat) = FalseSym0 - instance PEq Nat where - type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789876543210 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. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type family Equals_0123456789876543210 (a :: Foo k k k k) (b :: Foo k k k k) :: Bool where - Equals_0123456789876543210 (A a a a a) (A b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (B a a a a) (B b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (C a a a a) (C b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (D a a a a) (D b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (E a a a a) (E b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (F a a a a) (F b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) - Equals_0123456789876543210 (a :: Foo k k k k) (b :: Foo k k k k) = FalseSym0 - instance PEq (Foo k k k k) where - type (:==) (a :: Foo k k k k) (b :: Foo k k k k) = Equals_0123456789876543210 a b - type ASym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - A t t t t - instance SuppressUnusedWarnings ASym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ASym3KindInference) GHC.Tuple.()) - data ASym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (ASym3 l l l) arg) (ASym4 l l l arg) => - ASym3KindInference - type instance Apply (ASym3 l l l) l = A l l l l - instance SuppressUnusedWarnings ASym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ASym2KindInference) GHC.Tuple.()) - data ASym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ASym2 l l) arg) (ASym3 l l arg) => - ASym2KindInference - type instance Apply (ASym2 l l) l = ASym3 l l l - instance SuppressUnusedWarnings ASym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ASym1KindInference) GHC.Tuple.()) - data ASym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ASym1 l) arg) (ASym2 l arg) => - ASym1KindInference - type instance Apply (ASym1 l) l = ASym2 l l - instance SuppressUnusedWarnings ASym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ASym0KindInference) GHC.Tuple.()) - data ASym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ASym0 arg) (ASym1 arg) => - ASym0KindInference - type instance Apply ASym0 l = ASym1 l - type BSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - B t t t t - instance SuppressUnusedWarnings BSym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BSym3KindInference) GHC.Tuple.()) - data BSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (BSym3 l l l) arg) (BSym4 l l l arg) => - BSym3KindInference - type instance Apply (BSym3 l l l) l = B l l l l - instance SuppressUnusedWarnings BSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BSym2KindInference) GHC.Tuple.()) - data BSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BSym2 l l) arg) (BSym3 l l arg) => - BSym2KindInference - type instance Apply (BSym2 l l) l = BSym3 l l l - instance SuppressUnusedWarnings BSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BSym1KindInference) GHC.Tuple.()) - data BSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BSym1 l) arg) (BSym2 l arg) => - BSym1KindInference - type instance Apply (BSym1 l) l = BSym2 l l - instance SuppressUnusedWarnings BSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BSym0KindInference) GHC.Tuple.()) - data BSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BSym0 arg) (BSym1 arg) => - BSym0KindInference - type instance Apply BSym0 l = BSym1 l - type CSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - C t t t t - instance SuppressUnusedWarnings CSym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) CSym3KindInference) GHC.Tuple.()) - data CSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (CSym3 l l l) arg) (CSym4 l l l arg) => - CSym3KindInference - type instance Apply (CSym3 l l l) l = C l l l l - instance SuppressUnusedWarnings CSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) CSym2KindInference) GHC.Tuple.()) - data CSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (CSym2 l l) arg) (CSym3 l l arg) => - CSym2KindInference - type instance Apply (CSym2 l l) l = CSym3 l l l - instance SuppressUnusedWarnings CSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) CSym1KindInference) GHC.Tuple.()) - data CSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (CSym1 l) arg) (CSym2 l arg) => - CSym1KindInference - type instance Apply (CSym1 l) l = CSym2 l l - instance SuppressUnusedWarnings CSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) CSym0KindInference) GHC.Tuple.()) - data CSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply CSym0 arg) (CSym1 arg) => - CSym0KindInference - type instance Apply CSym0 l = CSym1 l - type DSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - D t t t t - instance SuppressUnusedWarnings DSym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DSym3KindInference) GHC.Tuple.()) - data DSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (DSym3 l l l) arg) (DSym4 l l l arg) => - DSym3KindInference - type instance Apply (DSym3 l l l) l = D l l l l - instance SuppressUnusedWarnings DSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DSym2KindInference) GHC.Tuple.()) - data DSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (DSym2 l l) arg) (DSym3 l l arg) => - DSym2KindInference - type instance Apply (DSym2 l l) l = DSym3 l l l - instance SuppressUnusedWarnings DSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DSym1KindInference) GHC.Tuple.()) - data DSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (DSym1 l) arg) (DSym2 l arg) => - DSym1KindInference - type instance Apply (DSym1 l) l = DSym2 l l - instance SuppressUnusedWarnings DSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) DSym0KindInference) GHC.Tuple.()) - data DSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply DSym0 arg) (DSym1 arg) => - DSym0KindInference - type instance Apply DSym0 l = DSym1 l - type ESym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - E t t t t - instance SuppressUnusedWarnings ESym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ESym3KindInference) GHC.Tuple.()) - data ESym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (ESym3 l l l) arg) (ESym4 l l l arg) => - ESym3KindInference - type instance Apply (ESym3 l l l) l = E l l l l - instance SuppressUnusedWarnings ESym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ESym2KindInference) GHC.Tuple.()) - data ESym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ESym2 l l) arg) (ESym3 l l arg) => - ESym2KindInference - type instance Apply (ESym2 l l) l = ESym3 l l l - instance SuppressUnusedWarnings ESym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ESym1KindInference) GHC.Tuple.()) - data ESym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ESym1 l) arg) (ESym2 l arg) => - ESym1KindInference - type instance Apply (ESym1 l) l = ESym2 l l - instance SuppressUnusedWarnings ESym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ESym0KindInference) GHC.Tuple.()) - data ESym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ESym0 arg) (ESym1 arg) => - ESym0KindInference - type instance Apply ESym0 l = ESym1 l - type FSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - F t t t t - instance SuppressUnusedWarnings FSym3 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FSym3KindInference) GHC.Tuple.()) - data FSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (FSym3 l l l) arg) (FSym4 l l l arg) => - FSym3KindInference - type instance Apply (FSym3 l l l) l = F l l l l - instance SuppressUnusedWarnings FSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FSym2KindInference) GHC.Tuple.()) - data FSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FSym2 l l) arg) (FSym3 l l arg) => - FSym2KindInference - type instance Apply (FSym2 l l) l = FSym3 l l l - instance SuppressUnusedWarnings FSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FSym1KindInference) GHC.Tuple.()) - data FSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FSym1 l) arg) (FSym2 l arg) => - FSym1KindInference - type instance Apply (FSym1 l) l = FSym2 l l - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) - data FSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0KindInference - type instance Apply FSym0 l = FSym1 l - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 Zero (Succ _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (Succ _z_0123456789876543210) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Nat where - type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where - Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (A _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (B _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (C _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (D _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - Compare_0123456789876543210 (F _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) (E _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210 _z_0123456789876543210) = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd (Foo a b c d) where - type Compare (a :: Foo a b c d) (a :: Foo a b c d) = Apply (Apply Compare_0123456789876543210Sym0 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 Demote 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 Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d) - fromSing (SA b b b b) - = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SB b b b b) - = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SC b b b b) - = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SD b b b b) - = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SE b b b b) - = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SF b b b b) - = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - toSing (A b 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 (t1 :: Nat) (t2 :: Nat). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1 :: TyFun Nat Ordering - -> GHC.Types.Type) t2 :: Ordering) - sCompare SZero SZero - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - instance (SOrd a, SOrd b, SOrd c, SOrd d) => - SOrd (Foo a b c d) where - sCompare :: - forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1 :: TyFun (Foo a b c d) Ordering - -> GHC.Types.Type) t2 :: Ordering) - sCompare - (SA (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SA (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SB (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SB (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SC (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SC (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SD (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SD (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SE (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SE (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SF (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SF (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT - instance 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 diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template @@ -0,0 +1,999 @@ +Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = Succ l + type ASym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + A t t t t + instance SuppressUnusedWarnings ASym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ASym3KindInference) GHC.Tuple.()) + data ASym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (ASym3 l l l) arg) (ASym4 l l l arg) => + ASym3KindInference + type instance Apply (ASym3 l l l) l = A l l l l + instance SuppressUnusedWarnings ASym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ASym2KindInference) GHC.Tuple.()) + data ASym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ASym2 l l) arg) (ASym3 l l arg) => + ASym2KindInference + type instance Apply (ASym2 l l) l = ASym3 l l l + instance SuppressUnusedWarnings ASym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ASym1KindInference) GHC.Tuple.()) + data ASym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ASym1 l) arg) (ASym2 l arg) => + ASym1KindInference + type instance Apply (ASym1 l) l = ASym2 l l + instance SuppressUnusedWarnings ASym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ASym0KindInference) GHC.Tuple.()) + data ASym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ASym0 arg) (ASym1 arg) => + ASym0KindInference + type instance Apply ASym0 l = ASym1 l + type BSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + B t t t t + instance SuppressUnusedWarnings BSym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BSym3KindInference) GHC.Tuple.()) + data BSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (BSym3 l l l) arg) (BSym4 l l l arg) => + BSym3KindInference + type instance Apply (BSym3 l l l) l = B l l l l + instance SuppressUnusedWarnings BSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BSym2KindInference) GHC.Tuple.()) + data BSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BSym2 l l) arg) (BSym3 l l arg) => + BSym2KindInference + type instance Apply (BSym2 l l) l = BSym3 l l l + instance SuppressUnusedWarnings BSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BSym1KindInference) GHC.Tuple.()) + data BSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (BSym1 l) arg) (BSym2 l arg) => + BSym1KindInference + type instance Apply (BSym1 l) l = BSym2 l l + instance SuppressUnusedWarnings BSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BSym0KindInference) GHC.Tuple.()) + data BSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply BSym0 arg) (BSym1 arg) => + BSym0KindInference + type instance Apply BSym0 l = BSym1 l + type CSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + C t t t t + instance SuppressUnusedWarnings CSym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) CSym3KindInference) GHC.Tuple.()) + data CSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (CSym3 l l l) arg) (CSym4 l l l arg) => + CSym3KindInference + type instance Apply (CSym3 l l l) l = C l l l l + instance SuppressUnusedWarnings CSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) CSym2KindInference) GHC.Tuple.()) + data CSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (CSym2 l l) arg) (CSym3 l l arg) => + CSym2KindInference + type instance Apply (CSym2 l l) l = CSym3 l l l + instance SuppressUnusedWarnings CSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) CSym1KindInference) GHC.Tuple.()) + data CSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (CSym1 l) arg) (CSym2 l arg) => + CSym1KindInference + type instance Apply (CSym1 l) l = CSym2 l l + instance SuppressUnusedWarnings CSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) CSym0KindInference) GHC.Tuple.()) + data CSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply CSym0 arg) (CSym1 arg) => + CSym0KindInference + type instance Apply CSym0 l = CSym1 l + type DSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + D t t t t + instance SuppressUnusedWarnings DSym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DSym3KindInference) GHC.Tuple.()) + data DSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (DSym3 l l l) arg) (DSym4 l l l arg) => + DSym3KindInference + type instance Apply (DSym3 l l l) l = D l l l l + instance SuppressUnusedWarnings DSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DSym2KindInference) GHC.Tuple.()) + data DSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (DSym2 l l) arg) (DSym3 l l arg) => + DSym2KindInference + type instance Apply (DSym2 l l) l = DSym3 l l l + instance SuppressUnusedWarnings DSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DSym1KindInference) GHC.Tuple.()) + data DSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (DSym1 l) arg) (DSym2 l arg) => + DSym1KindInference + type instance Apply (DSym1 l) l = DSym2 l l + instance SuppressUnusedWarnings DSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) DSym0KindInference) GHC.Tuple.()) + data DSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply DSym0 arg) (DSym1 arg) => + DSym0KindInference + type instance Apply DSym0 l = DSym1 l + type ESym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + E t t t t + instance SuppressUnusedWarnings ESym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ESym3KindInference) GHC.Tuple.()) + data ESym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (ESym3 l l l) arg) (ESym4 l l l arg) => + ESym3KindInference + type instance Apply (ESym3 l l l) l = E l l l l + instance SuppressUnusedWarnings ESym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ESym2KindInference) GHC.Tuple.()) + data ESym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ESym2 l l) arg) (ESym3 l l arg) => + ESym2KindInference + type instance Apply (ESym2 l l) l = ESym3 l l l + instance SuppressUnusedWarnings ESym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ESym1KindInference) GHC.Tuple.()) + data ESym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ESym1 l) arg) (ESym2 l arg) => + ESym1KindInference + type instance Apply (ESym1 l) l = ESym2 l l + instance SuppressUnusedWarnings ESym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ESym0KindInference) GHC.Tuple.()) + data ESym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ESym0 arg) (ESym1 arg) => + ESym0KindInference + type instance Apply ESym0 l = ESym1 l + type FSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = + F t t t t + instance SuppressUnusedWarnings FSym3 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FSym3KindInference) GHC.Tuple.()) + data FSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + = forall arg. SameKind (Apply (FSym3 l l l) arg) (FSym4 l l l arg) => + FSym3KindInference + type instance Apply (FSym3 l l l) l = F l l l l + instance SuppressUnusedWarnings FSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FSym2KindInference) GHC.Tuple.()) + data FSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (FSym2 l l) arg) (FSym3 l l arg) => + FSym2KindInference + type instance Apply (FSym2 l l) l = FSym3 l l l + instance SuppressUnusedWarnings FSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FSym1KindInference) GHC.Tuple.()) + data FSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (FSym1 l) arg) (FSym2 l arg) => + FSym1KindInference + type instance Apply (FSym1 l) l = FSym2 l l + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) + data FSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0KindInference + type instance Apply FSym0 l = FSym1 l + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where + Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd (Foo a b c d) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: Foo a b c d) (b :: Foo a b c d) :: Bool where + Equals_0123456789876543210 (A a a a a) (A b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (B a a a a) (B b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (C a a a a) (C b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (D a a a a) (D b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (E a a a a) (E b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (F a a a a) (F b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (_ :: Foo a b c d) (_ :: Foo a b c d) = FalseSym0 + instance PEq (Foo a b c d) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: Nat) + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + data instance Sing (z :: Foo a b c d) + where + SA :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (A n n n n) + SB :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (B n n n n) + SC :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (C n n n n) + SD :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (D n n n n) + SE :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (E n n n n) + SF :: forall (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (F n n n n) + type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type) + instance (SingKind a, SingKind b, SingKind c, SingKind d) => + SingKind (Foo a b c d) where + type Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d) + fromSing (SA b b b b) + = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SB b b b b) + = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SC b b b b) + = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SD b b b b) + = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SE b b b b) + = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SF b b b b) + = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + toSing + (A (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SA c) c) c) c) } + toSing + (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SB c) c) c) c) } + toSing + (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SC c) c) c) c) } + toSing + (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SD c) c) c) c) } + toSing + (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SE c) c) c) c) } + toSing + (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SF c) c) c) c) } + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance (SOrd a, SOrd b, SOrd c, SOrd d) => + SOrd (Foo a b c d) where + sCompare :: + forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare + (SA (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SA (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SB (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SB (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SC (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SC (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SD (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SD (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SE (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SE (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SF (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SF (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance (SEq a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where + (%==) (SA a a a a) (SA b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SB a a a a) (SB b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SC a a a a) (SC b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SD a a a a) (SD b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SE a a a a) (SE b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SF a a a a) (SF b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + instance (SDecide a, SDecide b, SDecide c, SDecide d) => + SDecide (Foo a b c d) where + (%~) (SA a a a a) (SA b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB a a a a) (SB b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC a a a a) (SC b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD a a a a) (SD b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE a a a a) (SE b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF a a a a) (SF b b b b) + = case + (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) + (((%~) a) b) + of + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SA sing) sing) sing) sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SB sing) sing) sing) sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SC sing) sing) sing) sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SD sing) sing) sing) sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SE sing) sing) sing) sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SF sing) sing) sing) sing diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.hs b/tests/compile-and-dump/Singletons/OrdDeriving.hs --- a/tests/compile-and-dump/Singletons/OrdDeriving.hs +++ b/tests/compile-and-dump/Singletons/OrdDeriving.hs @@ -15,7 +15,7 @@ | F a b c d deriving (Eq,Ord) |]) -foo1a :: Proxy (Zero :< Succ Zero) +foo1a :: Proxy (Zero < Succ Zero) foo1a = Proxy foo1b :: Proxy True diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template @@ -0,0 +1,31 @@ +Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| symId :: Symbol -> Symbol + symId x = x + foo :: Symbol + foo = symId "foo" |] + ======> + symId :: Symbol -> Symbol + symId x = x + foo :: Symbol + foo = symId "foo" + type SymIdSym1 (t :: Symbol) = SymId t + instance SuppressUnusedWarnings SymIdSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SymIdSym0KindInference) GHC.Tuple.()) + data SymIdSym0 (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => + SymIdSym0KindInference + type instance Apply SymIdSym0 l = SymId l + type FooSym0 = Foo + type family SymId (a :: Symbol) :: Symbol where + SymId x = x + type family Foo :: Symbol where + Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") + sSymId :: + forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol) + sFoo :: Sing (FooSym0 :: Symbol) + sSymId (sX :: Sing x) = sX + sFoo + = (applySing ((singFun1 @SymIdSym0) sSymId)) + (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo")) diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.hs b/tests/compile-and-dump/Singletons/OverloadedStrings.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OverloadedStrings.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} +module OverloadedStrings where + +import Data.Singletons.TH +import Data.Singletons.TypeLits + +$(singletons + [d| symId :: Symbol -> Symbol + symId x = x + + foo :: Symbol + foo = symId "foo" + |]) diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc82.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PatternMatching.ghc82.template +++ /dev/null @@ -1,450 +0,0 @@ -Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| pr = Pair (Succ Zero) ([Zero]) - complex = Pair (Pair (Just Zero) Zero) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - - data Pair a b - = Pair a b - deriving Show |] - ======> - data Pair a b - = Pair a b - deriving Show - pr = (Pair (Succ Zero)) [Zero] - complex = (Pair ((Pair (Just Zero)) Zero)) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type AListSym0 = AList - type TupleSym0 = Tuple - type ComplexSym0 = Complex - type PrSym0 = Pr - type family AList where - = Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) - type family Tuple where - = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 - type family Complex where - = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 - type family Pr where - = 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 @(:$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) - sTuple - = (applySing - ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - STrue - sComplex - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - SZero))) - SFalse - sPr - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SZero)) SNil) - data instance Sing (z :: Pair a b) - = 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 Demote (Pair a b) = Pair (Demote a) (Demote 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 :: (a, b) -> a - foo1 (x, y) = (\ _ -> x) y - foo2 :: (# a, b #) -> a - foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } - silly :: a -> () - silly x = case x of { _ -> GHC.Tuple.() } - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x _z_0123456789876543210 = Tuple0Sym0 - type Let0123456789876543210TSym2 t t = Let0123456789876543210T t t - instance SuppressUnusedWarnings Let0123456789876543210TSym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210TSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210TSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210TSym1 l) arg) (Let0123456789876543210TSym2 l arg) => - Let0123456789876543210TSym1KindInference - type instance Apply (Let0123456789876543210TSym1 l) l = Let0123456789876543210T l l - instance SuppressUnusedWarnings Let0123456789876543210TSym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Let0123456789876543210TSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210TSym0 l - = forall arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => - Let0123456789876543210TSym0KindInference - type instance Apply Let0123456789876543210TSym0 l = Let0123456789876543210TSym1 l - type family Let0123456789876543210T x y where - Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y - type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where - Case_0123456789876543210 x y a b arg_0123456789876543210 _z_0123456789876543210 = a - type family Lambda_0123456789876543210 x y a b t where - Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym5 t t t t t = - Lambda_0123456789876543210 t t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym4 l l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) => - Lambda_0123456789876543210Sym4KindInference - type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x y t where - Case_0123456789876543210 x y '(a, - b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _z_0123456789876543210 = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_z_0123456789876543210, - y_0123456789876543210, - Succ _z_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_z_0123456789876543210, - _z_0123456789876543210, - Succ y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(y_0123456789876543210, - _z_0123456789876543210, - _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(_z_0123456789876543210, - y_0123456789876543210, - _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(_z_0123456789876543210, - _z_0123456789876543210, - y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair y_0123456789876543210 _z_0123456789876543210) _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair _z_0123456789876543210 y_0123456789876543210) _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair _z_0123456789876543210 _z_0123456789876543210) y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair y_0123456789876543210 _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair _z_0123456789876543210 y_0123456789876543210) = y_0123456789876543210 - type SillySym1 (t :: a0123456789876543210) = Silly t - instance SuppressUnusedWarnings SillySym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) SillySym0KindInference) GHC.Tuple.()) - data SillySym0 (l :: TyFun a0123456789876543210 ()) - = forall arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => - SillySym0KindInference - type instance Apply SillySym0 l = Silly l - type Foo2Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = - Foo2 t - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun (a0123456789876543210, - b0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2 l - type Foo1Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = - Foo1 t - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun (a0123456789876543210, - b0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1 l - type LszSym0 = Lsz - type BlimySym0 = Blimy - type TfSym0 = Tf - type TjzSym0 = Tjz - type TtSym0 = Tt - type JzSym0 = Jz - type ZzSym0 = Zz - type FlsSym0 = Fls - type SzSym0 = Sz - type LzSym0 = Lz - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type family Silly (a :: a) :: () where - Silly x = Case_0123456789876543210 x x - type family Foo2 (a :: (a, b)) :: a where - Foo2 '(x, - y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) - type family Foo1 (a :: (a, b)) :: a where - Foo1 '(x, - y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Lsz :: Nat where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Blimy where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tf where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tjz where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tt where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Jz where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Zz where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Fls :: Bool where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Sz where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Lz where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - = PrSym0 - type family X_0123456789876543210 where - = ComplexSym0 - type family X_0123456789876543210 where - = TupleSym0 - type family X_0123456789876543210 where - = AListSym0 - sSilly :: forall (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) - sFoo2 :: - forall (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) - sFoo1 :: - forall (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) - sLsz :: Sing (LszSym0 :: Nat) - sBlimy :: Sing BlimySym0 - sTf :: Sing TfSym0 - sTjz :: Sing TjzSym0 - sTt :: Sing TtSym0 - sJz :: Sing JzSym0 - sZz :: Sing ZzSym0 - sFls :: Sing (FlsSym0 :: Bool) - sSz :: Sing SzSym0 - sLz :: Sing LzSym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sSilly (sX :: Sing x) - = case sX of { _ -> STuple0 } :: - Sing (Case_0123456789876543210 x x :: ()) - sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) - = let - sT :: Sing (Let0123456789876543210TSym2 x y) - sT - = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY - in case sT of { - STuple2 (sA :: Sing a) (sB :: Sing b) - -> (applySing - ((singFun1 - @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sA } :: - Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) }))) - sB } :: - Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a) - sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) - sY - sLsz - = case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons (SSucc _) SNil)) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat) - sBlimy - = case sX_0123456789876543210 of { - SCons _ - (SCons _ - (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) - SNil)) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTf - = case sX_0123456789876543210 of { - STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTjz - = case sX_0123456789876543210 of { - STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTt - = case sX_0123456789876543210 of { - STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sJz - = case sX_0123456789876543210 of { - SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) - _) - _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sZz - = case sX_0123456789876543210 of { - SPair (SPair _ - (sY_0123456789876543210 :: Sing y_0123456789876543210)) - _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sFls - = case sX_0123456789876543210 of { - SPair (SPair _ _) - (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sSz - = case sX_0123456789876543210 of { - SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sLz - = case sX_0123456789876543210 of { - SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sX_0123456789876543210 = sPr - sX_0123456789876543210 = sComplex - sX_0123456789876543210 = sTuple - sX_0123456789876543210 = sAList diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template @@ -0,0 +1,544 @@ +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving Show |] + ======> + data Pair a b + = Pair a b + deriving Show + pr = (Pair (Succ Zero)) [Zero] + complex = (Pair ((Pair (Just Zero)) Zero)) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) + data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = Pair l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) + data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow (Pair a b) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sTuple + = (applySing + ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + STrue + sComplex + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + SZero))) + SFalse + sPr + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) + data instance Sing (z :: Pair a b) + where + SPair :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance (SShow a, SShow b) => SShow (Pair a b) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Pair a b) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Pair ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Data.Singletons.ShowSing.ShowSing (Pair a b) where + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SPair arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SPair ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + (((.) GHC.Show.showSpace) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)))) + instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Show (Sing (z :: Pair a b)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = (SPair sing) sing +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, (Succ blimy)] = aList + lsz :: Nat + fls :: Bool + foo1 :: (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: a -> () + silly x = case x of { _ -> () } |] + ======> + Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, Succ blimy] = aList + lsz :: Nat + fls :: Bool + foo1 :: (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: a -> () + silly x = case x of { _ -> GHC.Tuple.() } + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x _ = Tuple0Sym0 + type Let0123456789876543210TSym2 t t = Let0123456789876543210T t t + instance SuppressUnusedWarnings Let0123456789876543210TSym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210TSym1KindInference) + GHC.Tuple.()) + data Let0123456789876543210TSym1 l l + = forall arg. SameKind (Apply (Let0123456789876543210TSym1 l) arg) (Let0123456789876543210TSym2 l arg) => + Let0123456789876543210TSym1KindInference + type instance Apply (Let0123456789876543210TSym1 l) l = Let0123456789876543210T l l + instance SuppressUnusedWarnings Let0123456789876543210TSym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Let0123456789876543210TSym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210TSym0 l + = forall arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => + Let0123456789876543210TSym0KindInference + type instance Apply Let0123456789876543210TSym0 l = Let0123456789876543210TSym1 l + type family Let0123456789876543210T x y where + Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y + type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where + Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a + type family Lambda_0123456789876543210 x y a b t where + Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym5 t t t t t = + Lambda_0123456789876543210 t t t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym4 l l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) => + Lambda_0123456789876543210Sym4KindInference + type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym3 l l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => + Lambda_0123456789876543210Sym3KindInference + type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 x y t where + Case_0123456789876543210 x y '(a, + b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 t t t = + Lambda_0123456789876543210 t t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym2 l l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => + Lambda_0123456789876543210Sym2KindInference + type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + y_0123456789876543210, + Succ _] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + _, + Succ y_0123456789876543210] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(y_0123456789876543210, + _, + _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(_, + y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(_, + _, + y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Pair (Pair y_0123456789876543210 _) _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Pair (Pair _ y_0123456789876543210) _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Pair (Pair _ _) y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Pair y_0123456789876543210 _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Pair _ y_0123456789876543210) = y_0123456789876543210 + type SillySym1 (t :: a0123456789876543210) = Silly t + instance SuppressUnusedWarnings SillySym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) SillySym0KindInference) GHC.Tuple.()) + data SillySym0 (l :: TyFun a0123456789876543210 ()) + = forall arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => + SillySym0KindInference + type instance Apply SillySym0 l = Silly l + type Foo2Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = + Foo2 t + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun (a0123456789876543210, + b0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2 l + type Foo1Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = + Foo1 t + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun (a0123456789876543210, + b0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1 l + type LszSym0 = Lsz + type BlimySym0 = Blimy + type TfSym0 = Tf + type TjzSym0 = Tjz + type TtSym0 = Tt + type JzSym0 = Jz + type ZzSym0 = Zz + type FlsSym0 = Fls + type SzSym0 = Sz + type LzSym0 = Lz + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type family Silly (a :: a) :: () where + Silly x = Case_0123456789876543210 x x + type family Foo2 (a :: (a, b)) :: a where + Foo2 '(x, + y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) + type family Foo1 (a :: (a, b)) :: a where + Foo1 '(x, + y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Lsz :: Nat where + Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Blimy where + Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tf where + Tf = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tjz where + Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tt where + Tt = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Jz where + Jz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Zz where + Zz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Fls :: Bool where + Fls = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Sz where + Sz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Lz where + Lz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = PrSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = ComplexSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = TupleSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = AListSym0 + sSilly :: forall (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) + sFoo2 :: + forall (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) + sFoo1 :: + forall (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) + sLsz :: Sing (LszSym0 :: Nat) + sBlimy :: Sing BlimySym0 + sTf :: Sing TfSym0 + sTjz :: Sing TjzSym0 + sTt :: Sing TtSym0 + sJz :: Sing JzSym0 + sZz :: Sing ZzSym0 + sFls :: Sing (FlsSym0 :: Bool) + sSz :: Sing SzSym0 + sLz :: Sing LzSym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sSilly (sX :: Sing x) + = case sX of { _ -> STuple0 } :: + Sing (Case_0123456789876543210 x x :: ()) + sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) + = let + sT :: Sing (Let0123456789876543210TSym2 x y) + sT + = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY + in case sT of { + STuple2 (sA :: Sing a) (sB :: Sing b) + -> (applySing + ((singFun1 + @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sA } :: + Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) }))) + sB } :: + Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a) + sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sX } :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY + sLsz + = case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons (SSucc _) SNil)) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat) + sBlimy + = case sX_0123456789876543210 of { + SCons _ + (SCons _ + (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) + SNil)) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTf + = case sX_0123456789876543210 of { + STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTjz + = case sX_0123456789876543210 of { + STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTt + = case sX_0123456789876543210 of { + STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sJz + = case sX_0123456789876543210 of { + SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) + _) + _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sZz + = case sX_0123456789876543210 of { + SPair (SPair _ + (sY_0123456789876543210 :: Sing y_0123456789876543210)) + _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sFls + = case sX_0123456789876543210 of { + SPair (SPair _ _) + (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sSz + = case sX_0123456789876543210 of { + SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sLz + = case sX_0123456789876543210 of { + SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sX_0123456789876543210 = sPr + sX_0123456789876543210 = sComplex + sX_0123456789876543210 = sTuple + sX_0123456789876543210 = sAList diff --git a/tests/compile-and-dump/Singletons/PatternMatching.hs b/tests/compile-and-dump/Singletons/PatternMatching.hs --- a/tests/compile-and-dump/Singletons/PatternMatching.hs +++ b/tests/compile-and-dump/Singletons/PatternMatching.hs @@ -1,9 +1,10 @@ -{-# OPTIONS_GHC -fno-warn-unused-matches #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.PatternMatching where import Data.Singletons.Prelude +import Data.Singletons.Prelude.Show import Data.Singletons.TH import Singletons.Nat diff --git a/tests/compile-and-dump/Singletons/PolyKinds.ghc82.template b/tests/compile-and-dump/Singletons/PolyKinds.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PolyKinds.ghc82.template +++ /dev/null @@ -1,22 +0,0 @@ -Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| class Cls (a :: k) where - fff :: Proxy (a :: k) -> () |] - ======> - class Cls (a :: k) where - fff :: Proxy (a :: k) -> () - type FffSym1 (t :: Proxy (a0123456789876543210 :: k0123456789876543210)) = - Fff t - instance SuppressUnusedWarnings FffSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FffSym0KindInference) GHC.Tuple.()) - data FffSym0 (l :: TyFun (Proxy (a0123456789876543210 :: k0123456789876543210)) ()) - = forall arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) => - FffSym0KindInference - type instance Apply FffSym0 l = Fff l - class PCls (a :: k) where - type Fff (arg :: Proxy (a :: k)) :: () - class SCls (a :: k) where - sFff :: - forall (t :: Proxy (a :: k)). - Sing t -> Sing (Apply FffSym0 t :: ()) diff --git a/tests/compile-and-dump/Singletons/PolyKinds.ghc84.template b/tests/compile-and-dump/Singletons/PolyKinds.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PolyKinds.ghc84.template @@ -0,0 +1,22 @@ +Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Cls (a :: k) where + fff :: Proxy (a :: k) -> () |] + ======> + class Cls (a :: k) where + fff :: Proxy (a :: k) -> () + type FffSym1 (t :: Proxy (a0123456789876543210 :: k0123456789876543210)) = + Fff t + instance SuppressUnusedWarnings FffSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FffSym0KindInference) GHC.Tuple.()) + data FffSym0 (l :: TyFun (Proxy (a0123456789876543210 :: k0123456789876543210)) ()) + = forall arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) => + FffSym0KindInference + type instance Apply FffSym0 l = Fff l + class PCls (a :: k) where + type Fff (arg :: Proxy (a :: k)) :: () + class SCls (a :: k) where + sFff :: + forall (t :: Proxy (a :: k)). + Sing t -> Sing (Apply FffSym0 t :: ()) diff --git a/tests/compile-and-dump/Singletons/PolyKindsApp.ghc82.template b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PolyKindsApp.ghc82.template +++ /dev/null @@ -1,12 +0,0 @@ -Singletons/PolyKindsApp.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| class Cls (a :: k -> Type) where - fff :: (a :: k -> Type) (b :: k) |] - ======> - class Cls (a :: k -> Type) where - fff :: (a :: k -> Type) (b :: k) - type FffSym0 = Fff - class PCls (a :: k -> Type) where - type Fff :: (a :: k -> Type) (b :: k) - class SCls (a :: k -> Type) where - sFff :: Sing (FffSym0 :: (a :: k -> Type) (b :: k)) diff --git a/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.template b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.template @@ -0,0 +1,12 @@ +Singletons/PolyKindsApp.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Cls (a :: k -> Type) where + fff :: (a :: k -> Type) (b :: k) |] + ======> + class Cls (a :: k -> Type) where + fff :: (a :: k -> Type) (b :: k) + type FffSym0 = Fff + class PCls (a :: k -> Type) where + type Fff :: (a :: k -> Type) (b :: k) + class SCls (a :: k -> Type) where + sFff :: Sing (FffSym0 :: (a :: k -> Type) (b :: k)) diff --git a/tests/compile-and-dump/Singletons/Records.ghc82.template b/tests/compile-and-dump/Singletons/Records.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Records.ghc82.template +++ /dev/null @@ -1,60 +0,0 @@ -Singletons/Records.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] - ======> - data Record a = MkRecord {field1 :: a, field2 :: Bool} - type Field1Sym1 (t :: Record a0123456789876543210) = Field1 t - instance SuppressUnusedWarnings Field1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Field1Sym0KindInference) GHC.Tuple.()) - data Field1Sym0 (l :: TyFun (Record a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => - Field1Sym0KindInference - type instance Apply Field1Sym0 l = Field1 l - type Field2Sym1 (t :: Record a0123456789876543210) = Field2 t - instance SuppressUnusedWarnings Field2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Field2Sym0KindInference) GHC.Tuple.()) - data Field2Sym0 (l :: TyFun (Record a0123456789876543210) Bool) - = forall arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => - Field2Sym0KindInference - type instance Apply Field2Sym0 l = Field2 l - type family Field1 (a :: Record a) :: a where - Field1 (MkRecord field _z_0123456789876543210) = field - type family Field2 (a :: Record a) :: Bool where - Field2 (MkRecord _z_0123456789876543210 field) = field - type MkRecordSym2 (t :: a0123456789876543210) (t :: Bool) = - MkRecord t t - instance SuppressUnusedWarnings MkRecordSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MkRecordSym1KindInference) GHC.Tuple.()) - data MkRecordSym1 (l :: a0123456789876543210) (l :: TyFun Bool (Record a0123456789876543210)) - = forall arg. SameKind (Apply (MkRecordSym1 l) arg) (MkRecordSym2 l arg) => - MkRecordSym1KindInference - type instance Apply (MkRecordSym1 l) l = MkRecord l l - instance SuppressUnusedWarnings MkRecordSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MkRecordSym0KindInference) GHC.Tuple.()) - data MkRecordSym0 (l :: TyFun a0123456789876543210 (TyFun Bool (Record a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => - MkRecordSym0KindInference - type instance Apply MkRecordSym0 l = MkRecordSym1 l - data instance Sing (z :: Record a) - = 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 Demote (Record a) = Record (Demote 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 diff --git a/tests/compile-and-dump/Singletons/Records.ghc84.template b/tests/compile-and-dump/Singletons/Records.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Records.ghc84.template @@ -0,0 +1,61 @@ +Singletons/Records.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] + ======> + data Record a = MkRecord {field1 :: a, field2 :: Bool} + type Field1Sym1 (t :: Record a0123456789876543210) = Field1 t + instance SuppressUnusedWarnings Field1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Field1Sym0KindInference) GHC.Tuple.()) + data Field1Sym0 (l :: TyFun (Record a0123456789876543210) a0123456789876543210) + = forall arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => + Field1Sym0KindInference + type instance Apply Field1Sym0 l = Field1 l + type Field2Sym1 (t :: Record a0123456789876543210) = Field2 t + instance SuppressUnusedWarnings Field2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Field2Sym0KindInference) GHC.Tuple.()) + data Field2Sym0 (l :: TyFun (Record a0123456789876543210) Bool) + = forall arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => + Field2Sym0KindInference + type instance Apply Field2Sym0 l = Field2 l + type family Field1 (a :: Record a) :: a where + Field1 (MkRecord field _) = field + type family Field2 (a :: Record a) :: Bool where + Field2 (MkRecord _ field) = field + type MkRecordSym2 (t :: a0123456789876543210) (t :: Bool) = + MkRecord t t + instance SuppressUnusedWarnings MkRecordSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkRecordSym1KindInference) GHC.Tuple.()) + data MkRecordSym1 (l :: a0123456789876543210) (l :: TyFun Bool (Record a0123456789876543210)) + = forall arg. SameKind (Apply (MkRecordSym1 l) arg) (MkRecordSym2 l arg) => + MkRecordSym1KindInference + type instance Apply (MkRecordSym1 l) l = MkRecord l l + instance SuppressUnusedWarnings MkRecordSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkRecordSym0KindInference) GHC.Tuple.()) + data MkRecordSym0 (l :: TyFun a0123456789876543210 (TyFun Bool (Record a0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => + MkRecordSym0KindInference + type instance Apply MkRecordSym0 l = MkRecordSym1 l + data instance Sing (z :: Record a) + where + SMkRecord :: forall (n :: a) (n :: Bool). + {sField1 :: (Sing (n :: a)), sField2 :: (Sing (n :: Bool))} + -> Sing (MkRecord n n) + type SRecord = (Sing :: Record a -> GHC.Types.Type) + instance SingKind a => SingKind (Record a) where + type Demote (Record a) = Record (Demote a) + fromSing (SMkRecord b b) = (MkRecord (fromSing b)) (fromSing b) + toSing (MkRecord (b :: Demote a) (b :: Demote Bool)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) + (toSing b :: SomeSing Bool) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing ((SMkRecord c) c) } + instance (SingI n, SingI n) => + SingI (MkRecord (n :: a) (n :: Bool)) where + sing = (SMkRecord sing) sing diff --git a/tests/compile-and-dump/Singletons/Records.hs b/tests/compile-and-dump/Singletons/Records.hs --- a/tests/compile-and-dump/Singletons/Records.hs +++ b/tests/compile-and-dump/Singletons/Records.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.Records where import Data.Singletons.SuppressUnusedWarnings diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc82.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/ReturnFunc.ghc82.template +++ /dev/null @@ -1,76 +0,0 @@ -Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| returnFunc :: Nat -> Nat -> Nat - returnFunc _ = Succ - id :: a -> a - id x = x - idFoo :: c -> a -> a - idFoo _ = id |] - ======> - returnFunc :: Nat -> Nat -> Nat - returnFunc _ = Succ - id :: a -> a - id x = x - idFoo :: c -> a -> a - idFoo _ = id - type IdSym1 (t :: a0123456789876543210) = Id t - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.()) - data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0KindInference - type instance Apply IdSym0 l = Id l - type IdFooSym2 (t :: c0123456789876543210) (t :: a0123456789876543210) = - IdFoo t t - instance SuppressUnusedWarnings IdFooSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) IdFooSym1KindInference) GHC.Tuple.()) - data IdFooSym1 (l :: c0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (IdFooSym1 l) arg) (IdFooSym2 l arg) => - IdFooSym1KindInference - type instance Apply (IdFooSym1 l) l = IdFoo l l - instance SuppressUnusedWarnings IdFooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) IdFooSym0KindInference) GHC.Tuple.()) - data IdFooSym0 (l :: TyFun c0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => - IdFooSym0KindInference - type instance Apply IdFooSym0 l = IdFooSym1 l - type ReturnFuncSym2 (t :: Nat) (t :: Nat) = ReturnFunc t t - instance SuppressUnusedWarnings ReturnFuncSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ReturnFuncSym1KindInference) GHC.Tuple.()) - data ReturnFuncSym1 (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (ReturnFuncSym1 l) arg) (ReturnFuncSym2 l arg) => - ReturnFuncSym1KindInference - type instance Apply (ReturnFuncSym1 l) l = ReturnFunc l l - instance SuppressUnusedWarnings ReturnFuncSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ReturnFuncSym0KindInference) GHC.Tuple.()) - data ReturnFuncSym0 (l :: TyFun Nat (TyFun Nat Nat - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => - ReturnFuncSym0KindInference - type instance Apply ReturnFuncSym0 l = ReturnFuncSym1 l - type family Id (a :: a) :: a where - Id x = x - type family IdFoo (a :: c) (a :: a) :: a where - IdFoo _z_0123456789876543210 a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 - type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where - ReturnFunc _z_0123456789876543210 a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 - sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) - sIdFoo :: - forall (t :: c) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) - sReturnFunc :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) - sId (sX :: Sing x) = sX - sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210 - sReturnFunc - _ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.template @@ -0,0 +1,76 @@ +Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: a -> a + id x = x + idFoo :: c -> a -> a + idFoo _ = id |] + ======> + returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: a -> a + id x = x + idFoo :: c -> a -> a + idFoo _ = id + type IdSym1 (t :: a0123456789876543210) = Id t + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.()) + data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => + IdSym0KindInference + type instance Apply IdSym0 l = Id l + type IdFooSym2 (t :: c0123456789876543210) (t :: a0123456789876543210) = + IdFoo t t + instance SuppressUnusedWarnings IdFooSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) IdFooSym1KindInference) GHC.Tuple.()) + data IdFooSym1 (l :: c0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply (IdFooSym1 l) arg) (IdFooSym2 l arg) => + IdFooSym1KindInference + type instance Apply (IdFooSym1 l) l = IdFoo l l + instance SuppressUnusedWarnings IdFooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) IdFooSym0KindInference) GHC.Tuple.()) + data IdFooSym0 (l :: TyFun c0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => + IdFooSym0KindInference + type instance Apply IdFooSym0 l = IdFooSym1 l + type ReturnFuncSym2 (t :: Nat) (t :: Nat) = ReturnFunc t t + instance SuppressUnusedWarnings ReturnFuncSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ReturnFuncSym1KindInference) GHC.Tuple.()) + data ReturnFuncSym1 (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (ReturnFuncSym1 l) arg) (ReturnFuncSym2 l arg) => + ReturnFuncSym1KindInference + type instance Apply (ReturnFuncSym1 l) l = ReturnFunc l l + instance SuppressUnusedWarnings ReturnFuncSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ReturnFuncSym0KindInference) GHC.Tuple.()) + data ReturnFuncSym0 (l :: TyFun Nat (TyFun Nat Nat + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => + ReturnFuncSym0KindInference + type instance Apply ReturnFuncSym0 l = ReturnFuncSym1 l + type family Id (a :: a) :: a where + Id x = x + type family IdFoo (a :: c) (a :: a) :: a where + IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 + type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where + ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 + sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sIdFoo :: + forall (t :: c) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) + sReturnFunc :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) + sId (sX :: Sing x) = sX + sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210 + sReturnFunc + _ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.hs b/tests/compile-and-dump/Singletons/ReturnFunc.hs --- a/tests/compile-and-dump/Singletons/ReturnFunc.hs +++ b/tests/compile-and-dump/Singletons/ReturnFunc.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.ReturnFunc where diff --git a/tests/compile-and-dump/Singletons/Sections.ghc82.template b/tests/compile-and-dump/Singletons/Sections.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Sections.ghc82.template +++ /dev/null @@ -1,112 +0,0 @@ -Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - foo1 :: [Nat] - foo1 = map ((Succ Zero) +) [Zero, Succ Zero] - foo2 :: [Nat] - foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] - foo3 :: [Nat] - foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] - ======> - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - foo1 :: [Nat] - foo1 = (map (Succ Zero +)) [Zero, Succ Zero] - foo2 :: [Nat] - foo2 = (map (+ Succ Zero)) [Zero, Succ Zero] - foo3 :: [Nat] - foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] - type family Lambda_0123456789876543210 t where - Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (:+$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) - type Lambda_0123456789876543210Sym1 t = - Lambda_0123456789876543210 t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l - type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t - instance SuppressUnusedWarnings (:+$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$$###)) GHC.Tuple.()) - data (:+$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((:+$$) l) arg) ((:+$$$) l arg) => - (:+$$###) - type instance Apply ((:+$$) l) l = (:+) l l - instance SuppressUnusedWarnings (:+$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:+$###)) GHC.Tuple.()) - data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+$) arg) ((:+$$) arg) => (:+$###) - type instance Apply (:+$) l = (:+$$) l - type Foo1Sym0 = Foo1 - type Foo2Sym0 = Foo2 - type Foo3Sym0 = Foo3 - type family (:+) (a :: Nat) (a :: Nat) :: Nat where - (:+) Zero m = m - (:+) (Succ n) m = Apply SuccSym0 (Apply (Apply (:+$) n) m) - type family Foo1 :: [Nat] where - = Apply (Apply MapSym0 (Apply (:+$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) '[])) - type family Foo2 :: [Nat] where - = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) '[])) - type family Foo3 :: [Nat] where - = Apply (Apply (Apply ZipWithSym0 (:+$)) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) '[])) - (%:+) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply (:+$) t) t :: Nat) - sFoo1 :: Sing (Foo1Sym0 :: [Nat]) - sFoo2 :: Sing (Foo2Sym0 :: [Nat]) - sFoo3 :: Sing (Foo3Sym0 :: [Nat]) - (%:+) SZero (sM :: Sing m) = sM - (%:+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @(:+$)) (%:+))) sN)) sM) - sFoo1 - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((applySing ((singFun2 @(:+$)) (%:+))) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) - sFoo2 - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((singFun1 @Lambda_0123456789876543210Sym0) - (\ sLhs_0123456789876543210 - -> case sLhs_0123456789876543210 of { - _ :: Sing lhs_0123456789876543210 - -> (applySing - ((applySing ((singFun2 @(:+$)) (%:+))) sLhs_0123456789876543210)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) })))) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) - sFoo3 - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(:+$)) (%:+)))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)))) - ((applySing ((applySing ((singFun2 @(:$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) diff --git a/tests/compile-and-dump/Singletons/Sections.ghc84.template b/tests/compile-and-dump/Singletons/Sections.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Sections.ghc84.template @@ -0,0 +1,113 @@ +Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + foo1 :: [Nat] + foo1 = map ((Succ Zero) +) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] + ======> + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + foo1 :: [Nat] + foo1 = (map (Succ Zero +)) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = (map (+ Succ Zero)) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] + type family Lambda_0123456789876543210 t where + Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) + type Lambda_0123456789876543210Sym1 t = + Lambda_0123456789876543210 t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l + type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t + instance SuppressUnusedWarnings (+@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.()) + data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) => + (:+@#@$$###) + type instance Apply ((+@#@$$) l) l = (+) l l + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.()) + data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (:+@#@$###) + type instance Apply (+@#@$) l = (+@#@$$) l + type Foo1Sym0 = Foo1 + type Foo2Sym0 = Foo2 + type Foo3Sym0 = Foo3 + type family (+) (a :: Nat) (a :: Nat) :: Nat where + (+) Zero m = m + (+) (Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) + type family Foo1 :: [Nat] where + Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + type family Foo2 :: [Nat] where + Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + type family Foo3 :: [Nat] where + Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) + sFoo1 :: Sing (Foo1Sym0 :: [Nat]) + sFoo2 :: Sing (Foo2Sym0 :: [Nat]) + sFoo3 :: Sing (Foo3Sym0 :: [Nat]) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) + sFoo1 + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((applySing ((singFun2 @(+@#@$)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) + sFoo2 + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((singFun1 @Lambda_0123456789876543210Sym0) + (\ sLhs_0123456789876543210 + -> case sLhs_0123456789876543210 of { + _ :: Sing lhs_0123456789876543210 + -> (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) sLhs_0123456789876543210)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) })))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) + sFoo3 + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 @(+@#@$)) (%+)))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template b/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template @@ -0,0 +1,591 @@ +Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 5 `MkFoo2b`, :*:, :&: + + data Foo1 + = MkFoo1 + deriving Show + data Foo2 a + = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a + deriving Show + data Foo3 + = MkFoo3 {getFoo3a :: Bool, *** :: Bool} + deriving Show |] + ======> + data Foo1 + = MkFoo1 + deriving Show + infixl 5 `MkFoo2b` + infixl 5 :*: + infixl 5 :&: + data Foo2 a + = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a + deriving Show + data Foo3 + = MkFoo3 {getFoo3a :: Bool, *** :: Bool} + deriving Show + type GetFoo3aSym1 (t :: Foo3) = GetFoo3a t + instance SuppressUnusedWarnings GetFoo3aSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) GetFoo3aSym0KindInference) GHC.Tuple.()) + data GetFoo3aSym0 (l :: TyFun Foo3 Bool) + = forall arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => + GetFoo3aSym0KindInference + type instance Apply GetFoo3aSym0 l = GetFoo3a l + type (***@#@$$) (t :: Foo3) = (***) t + instance SuppressUnusedWarnings (***@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:***@#@$###)) GHC.Tuple.()) + data (***@#@$) (l :: TyFun Foo3 Bool) + = forall arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => + (:***@#@$###) + type instance Apply (***@#@$) l = (***) l + type family GetFoo3a (a :: Foo3) :: Bool where + GetFoo3a (MkFoo3 field _) = field + type family (***) (a :: Foo3) :: Bool where + (***) (MkFoo3 _ field) = field + type MkFoo1Sym0 = MkFoo1 + type MkFoo2aSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = + MkFoo2a t t + instance SuppressUnusedWarnings MkFoo2aSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo2aSym1KindInference) GHC.Tuple.()) + data MkFoo2aSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) + = forall arg. SameKind (Apply (MkFoo2aSym1 l) arg) (MkFoo2aSym2 l arg) => + MkFoo2aSym1KindInference + type instance Apply (MkFoo2aSym1 l) l = MkFoo2a l l + instance SuppressUnusedWarnings MkFoo2aSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo2aSym0KindInference) GHC.Tuple.()) + data MkFoo2aSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => + MkFoo2aSym0KindInference + type instance Apply MkFoo2aSym0 l = MkFoo2aSym1 l + type MkFoo2bSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = + MkFoo2b t t + instance SuppressUnusedWarnings MkFoo2bSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo2bSym1KindInference) GHC.Tuple.()) + data MkFoo2bSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) + = forall arg. SameKind (Apply (MkFoo2bSym1 l) arg) (MkFoo2bSym2 l arg) => + MkFoo2bSym1KindInference + type instance Apply (MkFoo2bSym1 l) l = MkFoo2b l l + instance SuppressUnusedWarnings MkFoo2bSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo2bSym0KindInference) GHC.Tuple.()) + data MkFoo2bSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => + MkFoo2bSym0KindInference + type instance Apply MkFoo2bSym0 l = MkFoo2bSym1 l + type (:*:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = + (:*:) t t + instance SuppressUnusedWarnings (:*:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) + data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) + = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => + (::*:@#@$$###) + type instance Apply ((:*:@#@$$) l) l = (:*:) l l + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) + data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (::*:@#@$###) + type instance Apply (:*:@#@$) l = (:*:@#@$$) l + type (:&:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = + (:&:) t t + instance SuppressUnusedWarnings (:&:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::&:@#@$$###)) GHC.Tuple.()) + data (:&:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) + = forall arg. SameKind (Apply ((:&:@#@$$) l) arg) ((:&:@#@$$$) l arg) => + (::&:@#@$$###) + type instance Apply ((:&:@#@$$) l) l = (:&:) l l + instance SuppressUnusedWarnings (:&:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::&:@#@$###)) GHC.Tuple.()) + data (:&:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => + (::&:@#@$###) + type instance Apply (:&:@#@$) l = (:&:@#@$$) l + type MkFoo3Sym2 (t :: Bool) (t :: Bool) = MkFoo3 t t + instance SuppressUnusedWarnings MkFoo3Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo3Sym1KindInference) GHC.Tuple.()) + data MkFoo3Sym1 (l :: Bool) (l :: TyFun Bool Foo3) + = forall arg. SameKind (Apply (MkFoo3Sym1 l) arg) (MkFoo3Sym2 l arg) => + MkFoo3Sym1KindInference + type instance Apply (MkFoo3Sym1 l) l = MkFoo3 l l + instance SuppressUnusedWarnings MkFoo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.()) + data MkFoo3Sym0 (l :: TyFun Bool (TyFun Bool Foo3 + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => + MkFoo3Sym0KindInference + type instance Apply MkFoo3Sym0 l = MkFoo3Sym1 l + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo1) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo1) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo1 (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo1 (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Foo1 where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2a arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo2a ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo2 a0123456789876543210) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo2 a0123456789876543210) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow (Foo2 a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo3) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo3) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo3 (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo3 (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Foo3 where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + infixl 5 :%&: + infixl 5 :%*: + infixl 5 `SMkFoo2b` + data instance Sing (z :: Foo1) where SMkFoo1 :: Sing MkFoo1 + type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type) + instance SingKind Foo1 where + type Demote Foo1 = Foo1 + fromSing SMkFoo1 = MkFoo1 + toSing MkFoo1 = SomeSing SMkFoo1 + data instance Sing (z :: Foo2 a) + where + SMkFoo2a :: forall (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n) + SMkFoo2b :: forall (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n) + (:%*:) :: forall (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n) + (:%&:) :: forall (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:&:) n n) + type SFoo2 = (Sing :: Foo2 a -> GHC.Types.Type) + instance SingKind a => SingKind (Foo2 a) where + type Demote (Foo2 a) = Foo2 (Demote a) + fromSing (SMkFoo2a b b) = (MkFoo2a (fromSing b)) (fromSing b) + fromSing (SMkFoo2b b b) = (MkFoo2b (fromSing b)) (fromSing b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + fromSing ((:%&:) b b) = ((:&:) (fromSing b)) (fromSing b) + toSing (MkFoo2a (b :: Demote a) (b :: Demote a)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing ((SMkFoo2a c) c) } + toSing (MkFoo2b (b :: Demote a) (b :: Demote a)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing ((SMkFoo2b c) c) } + toSing ((:*:) (b :: Demote a) (b :: Demote a)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%*:) c) c) } + toSing ((:&:) (b :: Demote a) (b :: Demote a)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%&:) c) c) } + data instance Sing (z :: Foo3) + where + SMkFoo3 :: forall (n :: Bool) (n :: Bool). + {sGetFoo3a :: (Sing (n :: Bool)), %*** :: (Sing (n :: Bool))} + -> Sing (MkFoo3 n n) + type SFoo3 = (Sing :: Foo3 -> GHC.Types.Type) + instance SingKind Foo3 where + type Demote Foo3 = Foo3 + fromSing (SMkFoo3 b b) = (MkFoo3 (fromSing b)) (fromSing b) + toSing (MkFoo3 (b :: Demote Bool) (b :: Demote Bool)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) + (toSing b :: SomeSing Bool) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing ((SMkFoo3 c) c) } + instance SShow Foo1 where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo1) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo1 (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SMkFoo1 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo1"))) + sA_0123456789876543210 + instance SShow a => SShow (Foo2 a) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo2 a) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Foo2 a) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo2a (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo2a ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo2b (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 5))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " `MkFoo2b` ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%*:) (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "(:*:) ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%&:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 5))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " :&: ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + instance SShow Bool => SShow Foo3 where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo3) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo3 (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo3 (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo3 ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowCharSym0) sShowChar)) + (sing :: Sing "{")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "getFoo3a = ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 0)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowCommaSpaceSym0) sShowCommaSpace))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "(***) = ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 0)))) + sArg_0123456789876543210))) + ((applySing ((singFun2 @ShowCharSym0) sShowChar)) + (sing :: Sing "}"))))))))))) + sA_0123456789876543210 + instance Data.Singletons.ShowSing.ShowSing Foo1 where + Data.Singletons.ShowSing.showsSingPrec _ SMkFoo1 + = showString "SMkFoo1" + instance Show (Sing (z :: Foo1)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance Data.Singletons.ShowSing.ShowSing a => + Data.Singletons.ShowSing.ShowSing (Foo2 a) where + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SMkFoo2a arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SMkFoo2a ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + (((.) GHC.Show.showSpace) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)))) + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SMkFoo2b argL_0123456789876543210 argR_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 9)) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argL_0123456789876543210)) + (((.) (showString " `SMkFoo2b` ")) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argR_0123456789876543210))) + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + ((:%*:) arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "(:%*:) ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)) + (((.) GHC.Show.showSpace) + ((Data.Singletons.ShowSing.showsSingPrec 11) + arg_0123456789876543210)))) + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + ((:%&:) argL_0123456789876543210 argR_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 9)) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argL_0123456789876543210)) + (((.) (showString " :%&: ")) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argR_0123456789876543210))) + instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: Foo2 a)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance Data.Singletons.ShowSing.ShowSing Bool => + Data.Singletons.ShowSing.ShowSing Foo3 where + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + (SMkFoo3 arg_0123456789876543210 arg_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 10)) + (((.) (showString "SMkFoo3 ")) + (((.) (showChar '{')) + (((.) (showString "sGetFoo3a = ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 0) + arg_0123456789876543210)) + (((.) GHC.Show.showCommaSpace) + (((.) (showString "(%***) = ")) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 0) + arg_0123456789876543210)) + (showChar '}')))))))) + instance Data.Singletons.ShowSing.ShowSing Bool => + Show (Sing (z :: Foo3)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI MkFoo1 where + sing = SMkFoo1 + instance (SingI n, SingI n) => + SingI (MkFoo2a (n :: a) (n :: a)) where + sing = (SMkFoo2a sing) sing + instance (SingI n, SingI n) => + SingI (MkFoo2b (n :: a) (n :: a)) where + sing = (SMkFoo2b sing) sing + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: a)) where + sing = ((:%*:) sing) sing + instance (SingI n, SingI n) => + SingI ((:&:) (n :: a) (n :: a)) where + sing = ((:%&:) sing) sing + instance (SingI n, SingI n) => + SingI (MkFoo3 (n :: Bool) (n :: Bool)) where + sing = (SMkFoo3 sing) sing diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.hs b/tests/compile-and-dump/Singletons/ShowDeriving.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ShowDeriving.hs @@ -0,0 +1,41 @@ +module Singletons.ShowDeriving where + +import Data.Type.Equality +import Data.Singletons.Prelude +import Data.Singletons.Prelude.Show +import Data.Singletons.TH + +$(singletons [d| + data Foo1 = MkFoo1 deriving Show + + infixl 5 `MkFoo2b`, :*:, :&: + data Foo2 a = MkFoo2a a a + | a `MkFoo2b` a + | (:*:) a a + | a :&: a + deriving Show + + data Foo3 = MkFoo3 { getFoo3a :: Bool, (***) :: Bool } deriving Show + + |]) + +foo1 :: "MkFoo1" :~: Show_ MkFoo1 +foo1 = Refl + +foo2a :: "(MkFoo2a LT GT)" :~: ShowsPrec 11 (MkFoo2a LT GT) "" +foo2a = Refl + +foo2b :: "True `MkFoo2b` False" :~: Show_ (True `MkFoo2b` False) +foo2b = Refl + +foo2c :: "(:*:) () ()" :~: Show_ ('() :*: '()) +foo2c = Refl + +foo2d' :: "False :&: True" :~: ShowsPrec 5 (False :&: True) "" +foo2d' = Refl + +foo2d'' :: "(False :&: True)" :~: ShowsPrec 6 (False :&: True) "" +foo2d'' = Refl + +foo3 :: "MkFoo3 {getFoo3a = True, (***) = False}" :~: Show_ (MkFoo3 True False) +foo3 = Refl diff --git a/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template b/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template @@ -0,0 +1,454 @@ +Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 6 :*: + + data T a b = a :*: b + data S = S1 | S2 + + deriving instance Enum S + deriving instance Bounded S + deriving instance Show S + deriving instance Ord S + deriving instance Eq S + deriving instance Show a => Show (T a ()) + deriving instance Ord a => Ord (T a ()) + deriving instance Eq a => Eq (T a ()) |] + ======> + infixl 6 :*: + data T a b = a :*: b + data S = S1 | S2 + deriving instance Eq a => Eq (T a ()) + deriving instance Ord a => Ord (T a ()) + deriving instance Show a => Show (T a ()) + deriving instance Eq S + deriving instance Ord S + deriving instance Show S + deriving instance Bounded S + deriving instance Enum S + type (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) = + (:*:) t t + instance SuppressUnusedWarnings (:*:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) + data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => + (::*:@#@$$###) + type instance Apply ((:*:@#@$$) l) l = (:*:) l l + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) + data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (::*:@#@$###) + type instance Apply (:*:@#@$) l = (:*:@#@$$) l + type S1Sym0 = S1 + type S2Sym0 = S2 + type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where + Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) + type Compare_0123456789876543210Sym2 (t :: T a0123456789876543210 ()) (t :: T a0123456789876543210 ()) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: T a0123456789876543210 ()) (l :: TyFun (T a0123456789876543210 ()) Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun (T a0123456789876543210 ()) (TyFun (T a0123456789876543210 ()) Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd (T a ()) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: T a0123456789876543210 ()) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T a0123456789876543210 ()) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow (T a ()) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where + Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 S1 S2 = LTSym0 + Compare_0123456789876543210 S2 S1 = GTSym0 + type Compare_0123456789876543210Sym2 (t :: S) (t :: S) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: S) (l :: TyFun S Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun S (TyFun S Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd S where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: S) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: S) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun S (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun S (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow S where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family MinBound_0123456789876543210 :: S where + MinBound_0123456789876543210 = S1Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: S where + MaxBound_0123456789876543210 = S2Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded S where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = S2Sym0 + Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = S1Sym0 + Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789876543210 t + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat S) + = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0KindInference + type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l + type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where + FromEnum_0123456789876543210 S1 = FromInteger 0 + FromEnum_0123456789876543210 S2 = FromInteger 1 + type FromEnum_0123456789876543210Sym1 (t :: S) = + FromEnum_0123456789876543210 t + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FromEnum_0123456789876543210Sym0 (l :: TyFun S GHC.Types.Nat) + = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0KindInference + type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l + instance PEnum S where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + type family Equals_0123456789876543210 (a :: T a ()) (b :: T a ()) :: Bool where + Equals_0123456789876543210 ((:*:) a a) ((:*:) b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: T a ()) (_ :: T a ()) = FalseSym0 + instance PEq (T a ()) where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: S) (b :: S) :: Bool where + Equals_0123456789876543210 S1 S1 = TrueSym0 + Equals_0123456789876543210 S2 S2 = TrueSym0 + Equals_0123456789876543210 (_ :: S) (_ :: S) = FalseSym0 + instance PEq S where + type (==) a b = Equals_0123456789876543210 a b + infixl 6 :%*: + data instance Sing (z :: T a b) + where + (:%*:) :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) + type ST = (Sing :: T a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (T a b) where + type Demote (T a b) = T (Demote a) (Demote b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + toSing ((:*:) (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%*:) c) c) } + data instance Sing (z :: S) + where + SS1 :: Sing S1 + SS2 :: Sing S2 + type SS = (Sing :: S -> GHC.Types.Type) + instance SingKind S where + type Demote S = S + fromSing SS1 = S1 + fromSing SS2 = S2 + toSing S1 = SomeSing SS1 + toSing S2 = SomeSing SS2 + instance SOrd a => SOrd (T a ()) where + sCompare :: + forall (t1 :: T a ()) (t2 :: T a ()). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (T a ()) (TyFun (T a ()) Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare + ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)) + instance SShow a => SShow (T a ()) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: T a ()) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (T a ()) (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%*:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 6))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 7)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " :*: ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 7)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + instance SOrd S where + sCompare :: + forall (t1 :: S) (t2 :: S). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun S (TyFun S Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare SS1 SS1 + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SS2 SS2 + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SS1 SS2 = SLT + sCompare SS2 SS1 = SGT + instance SShow S where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: S) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun S (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SS1 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "S1"))) + sA_0123456789876543210 + sShowsPrec + _ + SS2 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "S2"))) + sA_0123456789876543210 + instance SBounded S where + sMinBound :: Sing (MinBoundSym0 :: S) + sMaxBound :: Sing (MaxBoundSym0 :: S) + sMinBound = SS1 + sMaxBound = SS2 + instance SEnum S where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat S + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: S). + Sing t + -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> SS1 + SFalse + -> case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (sFromInteger (sing :: Sing 1)) + of + STrue -> SS2 + SFalse -> sError (sing :: Sing "toEnum: bad argument") :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0))) + sFromEnum SS1 = sFromInteger (sing :: Sing 0) + sFromEnum SS2 = sFromInteger (sing :: Sing 1) + instance SEq a => SEq (T a ()) where + (%==) ((:%*:) a a) ((:%*:) b b) + = ((%&&) (((%==) a) b)) (((%==) a) b) + instance SDecide a => SDecide (T a ()) where + (%~) ((:%*:) a a) ((:%*:) b b) + = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of + GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl + GHC.Tuple.(,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq S where + (%==) SS1 SS1 = STrue + (%==) SS1 SS2 = SFalse + (%==) SS2 SS1 = SFalse + (%==) SS2 SS2 = STrue + instance SDecide S where + (%~) SS1 SS1 = Proved Refl + (%~) SS1 SS2 = Disproved (\ x -> case x of) + (%~) SS2 SS1 = Disproved (\ x -> case x of) + (%~) SS2 SS2 = Proved Refl + instance Data.Singletons.ShowSing.ShowSing a => + Data.Singletons.ShowSing.ShowSing (T a ()) where + Data.Singletons.ShowSing.showsSingPrec + p_0123456789876543210 + ((:%*:) argL_0123456789876543210 argR_0123456789876543210) + = (showParen (((>) p_0123456789876543210) 9)) + (((.) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argL_0123456789876543210)) + (((.) (showString " :%*: ")) + ((Data.Singletons.ShowSing.showsSingPrec 10) + argR_0123456789876543210))) + instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: T a ())) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance Data.Singletons.ShowSing.ShowSing S where + Data.Singletons.ShowSing.showsSingPrec _ SS1 = showString "SS1" + Data.Singletons.ShowSing.showsSingPrec _ SS2 = showString "SS2" + instance Show (Sing (z :: S)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: b)) where + sing = ((:%*:) sing) sing + instance SingI S1 where + sing = SS1 + instance SingI S2 where + sing = SS2 diff --git a/tests/compile-and-dump/Singletons/StandaloneDeriving.hs b/tests/compile-and-dump/Singletons/StandaloneDeriving.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/StandaloneDeriving.hs @@ -0,0 +1,30 @@ +module Singletons.StandaloneDeriving where + +import Data.Singletons.Prelude +import Data.Singletons.Prelude.Show +import Data.Singletons.TH + +$(singletons [d| + + infixl 6 :*: + data T a b = a :*: b + data S = S1 | S2 + + deriving instance Eq a => Eq (T a ()) + deriving instance Ord a => Ord (T a ()) + deriving instance Show a => Show (T a ()) + + deriving instance Eq S + deriving instance Ord S + deriving instance Show S + deriving instance Bounded S + deriving instance Enum S + + |]) + +-- Ensure that the fixity is discovered +test1 :: "() :*: ()" :~: ShowsPrec 6 ('() :*: '()) "" +test1 = Refl + +test2 :: "(() :*: ())" :~: ShowsPrec 7 ('() :*: '()) "" +test2 = Refl diff --git a/tests/compile-and-dump/Singletons/Star.ghc82.template b/tests/compile-and-dump/Singletons/Star.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Star.ghc82.template +++ /dev/null @@ -1,364 +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_0123456789876543210 (a :: Type) (b :: Type) :: Bool where - Equals_0123456789876543210 Nat Nat = TrueSym0 - Equals_0123456789876543210 Int Int = TrueSym0 - Equals_0123456789876543210 String String = TrueSym0 - Equals_0123456789876543210 (Maybe a) (Maybe b) = (:==) a b - Equals_0123456789876543210 (Vec a a) (Vec b b) = (:&&) ((:==) a b) ((:==) a b) - Equals_0123456789876543210 (a :: Type) (b :: Type) = FalseSym0 - instance PEq Type where - type (:==) (a :: Type) (b :: Type) = Equals_0123456789876543210 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. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => - MaybeSym0KindInference - type instance Apply MaybeSym0 l = Maybe 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. SameKind (Apply (VecSym1 l) arg) (VecSym2 l arg) => - VecSym1KindInference - type instance Apply (VecSym1 l) l = Vec 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. SameKind (Apply VecSym0 arg) (VecSym1 arg) => - VecSym0KindInference - type instance Apply VecSym0 l = VecSym1 l - type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where - Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) - Compare_0123456789876543210 Nat Int = LTSym0 - Compare_0123456789876543210 Nat String = LTSym0 - Compare_0123456789876543210 Nat (Maybe _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 Nat (Vec _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 Int Nat = GTSym0 - Compare_0123456789876543210 Int String = LTSym0 - Compare_0123456789876543210 Int (Maybe _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 Int (Vec _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 String Nat = GTSym0 - Compare_0123456789876543210 String Int = GTSym0 - Compare_0123456789876543210 String (Maybe _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 String (Vec _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (Maybe _z_0123456789876543210) Nat = GTSym0 - Compare_0123456789876543210 (Maybe _z_0123456789876543210) Int = GTSym0 - Compare_0123456789876543210 (Maybe _z_0123456789876543210) String = GTSym0 - Compare_0123456789876543210 (Maybe _z_0123456789876543210) (Vec _z_0123456789876543210 _z_0123456789876543210) = LTSym0 - Compare_0123456789876543210 (Vec _z_0123456789876543210 _z_0123456789876543210) Nat = GTSym0 - Compare_0123456789876543210 (Vec _z_0123456789876543210 _z_0123456789876543210) Int = GTSym0 - Compare_0123456789876543210 (Vec _z_0123456789876543210 _z_0123456789876543210) String = GTSym0 - Compare_0123456789876543210 (Vec _z_0123456789876543210 _z_0123456789876543210) (Maybe _z_0123456789876543210) = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Type) (t :: Type) = - Compare_0123456789876543210 t t - instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Type) (l :: TyFun Type Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Type (TyFun Type Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Type where - type Compare (a :: Type) (a :: Type) = Apply (Apply Compare_0123456789876543210Sym0 a) a - instance (SOrd Type, SOrd Nat) => SOrd Type where - sCompare :: - forall (t1 :: Type) (t2 :: Type). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Type (TyFun Type Ordering - -> Type) - -> Type) t1 :: TyFun Type Ordering - -> Type) t2 :: Ordering) - sCompare SNat SNat - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SInt SInt - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SString SString - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare - (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)) - sCompare SNat SInt = SLT - sCompare SNat SString = SLT - sCompare SNat (SMaybe _) = SLT - sCompare SNat (SVec _ _) = SLT - sCompare SInt SNat = SGT - sCompare SInt SString = SLT - sCompare SInt (SMaybe _) = SLT - sCompare SInt (SVec _ _) = SLT - sCompare SString SNat = SGT - sCompare SString SInt = SGT - sCompare SString (SMaybe _) = SLT - sCompare SString (SVec _ _) = SLT - sCompare (SMaybe _) SNat = SGT - sCompare (SMaybe _) SInt = SGT - sCompare (SMaybe _) SString = SGT - sCompare (SMaybe _) (SVec _ _) = SLT - sCompare (SVec _ _) SNat = SGT - sCompare (SVec _ _) SInt = SGT - sCompare (SVec _ _) SString = SGT - sCompare (SVec _ _) (SMaybe _) = SGT - 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 Demote Type = Rep - fromSing SNat = Singletons.Star.Nat - fromSing SInt = Singletons.Star.Int - fromSing SString = Singletons.Star.String - fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) - fromSing (SVec b b) - = (Singletons.Star.Vec (fromSing b)) (fromSing b) - toSing Singletons.Star.Nat = SomeSing SNat - toSing Singletons.Star.Int = SomeSing SInt - toSing Singletons.Star.String = SomeSing SString - toSing (Singletons.Star.Maybe b) - = 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 diff --git a/tests/compile-and-dump/Singletons/Star.ghc84.template b/tests/compile-and-dump/Singletons/Star.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Star.ghc84.template @@ -0,0 +1,405 @@ +Singletons/Star.hs:0:0:: Splicing declarations + singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec] + ======> + data Rep + = Singletons.Star.Nat | + Singletons.Star.Int | + Singletons.Star.String | + Singletons.Star.Maybe Rep | + Singletons.Star.Vec Rep Nat + deriving (Eq, Ord, Read, Show) + type NatSym0 = Nat + type IntSym0 = Int + type StringSym0 = String + type MaybeSym1 (t :: Type) = Maybe t + instance SuppressUnusedWarnings MaybeSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MaybeSym0KindInference) GHC.Tuple.()) + data MaybeSym0 (l :: TyFun Type Type) + = forall arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => + MaybeSym0KindInference + type instance Apply MaybeSym0 l = Maybe l + type VecSym2 (t :: Type) (t :: Nat) = Vec t t + instance SuppressUnusedWarnings VecSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) VecSym1KindInference) GHC.Tuple.()) + data VecSym1 (l :: Type) (l :: TyFun Nat Type) + = forall arg. SameKind (Apply (VecSym1 l) arg) (VecSym2 l arg) => + VecSym1KindInference + type instance Apply (VecSym1 l) l = Vec l l + instance SuppressUnusedWarnings VecSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) VecSym0KindInference) GHC.Tuple.()) + data VecSym0 (l :: TyFun Type (TyFun Nat Type -> Type)) + = forall arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => + VecSym0KindInference + type instance Apply VecSym0 l = VecSym1 l + type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where + Equals_0123456789876543210 Nat Nat = TrueSym0 + Equals_0123456789876543210 Int Int = TrueSym0 + Equals_0123456789876543210 String String = TrueSym0 + Equals_0123456789876543210 (Maybe a) (Maybe b) = (==) a b + Equals_0123456789876543210 (Vec a a) (Vec b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: Type) (_ :: Type) = FalseSym0 + instance PEq Type where + type (==) a b = Equals_0123456789876543210 a b + type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where + Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) + Compare_0123456789876543210 Nat Int = LTSym0 + Compare_0123456789876543210 Nat String = LTSym0 + Compare_0123456789876543210 Nat (Maybe _) = LTSym0 + Compare_0123456789876543210 Nat (Vec _ _) = LTSym0 + Compare_0123456789876543210 Int Nat = GTSym0 + Compare_0123456789876543210 Int String = LTSym0 + Compare_0123456789876543210 Int (Maybe _) = LTSym0 + Compare_0123456789876543210 Int (Vec _ _) = LTSym0 + Compare_0123456789876543210 String Nat = GTSym0 + Compare_0123456789876543210 String Int = GTSym0 + Compare_0123456789876543210 String (Maybe _) = LTSym0 + Compare_0123456789876543210 String (Vec _ _) = LTSym0 + Compare_0123456789876543210 (Maybe _) Nat = GTSym0 + Compare_0123456789876543210 (Maybe _) Int = GTSym0 + Compare_0123456789876543210 (Maybe _) String = GTSym0 + Compare_0123456789876543210 (Maybe _) (Vec _ _) = LTSym0 + Compare_0123456789876543210 (Vec _ _) Nat = GTSym0 + Compare_0123456789876543210 (Vec _ _) Int = GTSym0 + Compare_0123456789876543210 (Vec _ _) String = GTSym0 + Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Type) (t :: Type) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Type) (l :: TyFun Type Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Type (TyFun Type Ordering + -> Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Type where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ Nat a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nat") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Int a_0123456789876543210 = Apply (Apply ShowStringSym0 "Int") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Type) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Type) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Type (TyFun Symbol Symbol + -> Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Type (TyFun Symbol Symbol + -> Type) + -> Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Type where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + data instance Sing (z :: Type) + where + SNat :: Sing Nat + SInt :: Sing Int + SString :: Sing String + SMaybe :: forall (n :: Type). (Sing (n :: Type)) -> Sing (Maybe n) + SVec :: forall (n :: Type) (n :: Nat). + (Sing (n :: Type)) -> (Sing (n :: Nat)) -> Sing (Vec n n) + type SRep = (Sing :: Type -> Type) + instance SingKind Type where + type Demote Type = Rep + fromSing SNat = Singletons.Star.Nat + fromSing SInt = Singletons.Star.Int + fromSing SString = Singletons.Star.String + fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) + fromSing (SVec b b) + = (Singletons.Star.Vec (fromSing b)) (fromSing b) + toSing Singletons.Star.Nat = SomeSing SNat + toSing Singletons.Star.Int = SomeSing SInt + toSing Singletons.Star.String = SomeSing SString + toSing (Singletons.Star.Maybe (b :: Demote Type)) + = case toSing b :: SomeSing Type of { + SomeSing c -> SomeSing (SMaybe c) } + toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing Type)) + (toSing b :: SomeSing Nat) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SVec c) c) } + instance (SEq Type, SEq Nat) => SEq Type where + (%==) SNat SNat = STrue + (%==) SNat SInt = SFalse + (%==) SNat SString = SFalse + (%==) SNat (SMaybe _) = SFalse + (%==) SNat (SVec _ _) = SFalse + (%==) SInt SNat = SFalse + (%==) SInt SInt = STrue + (%==) SInt SString = SFalse + (%==) SInt (SMaybe _) = SFalse + (%==) SInt (SVec _ _) = SFalse + (%==) SString SNat = SFalse + (%==) SString SInt = SFalse + (%==) SString SString = STrue + (%==) SString (SMaybe _) = SFalse + (%==) SString (SVec _ _) = SFalse + (%==) (SMaybe _) SNat = SFalse + (%==) (SMaybe _) SInt = SFalse + (%==) (SMaybe _) SString = SFalse + (%==) (SMaybe a) (SMaybe b) = ((%==) a) b + (%==) (SMaybe _) (SVec _ _) = SFalse + (%==) (SVec _ _) SNat = SFalse + (%==) (SVec _ _) SInt = SFalse + (%==) (SVec _ _) SString = SFalse + (%==) (SVec _ _) (SMaybe _) = SFalse + (%==) (SVec a a) (SVec b b) = ((%&&) (((%==) a) b)) (((%==) a) b) + instance (SDecide Type, SDecide Nat) => SDecide Type where + (%~) SNat SNat = Proved Refl + (%~) SNat SInt = Disproved (\ x -> case x of) + (%~) SNat SString = Disproved (\ x -> case x of) + (%~) SNat (SMaybe _) = Disproved (\ x -> case x of) + (%~) SNat (SVec _ _) = Disproved (\ x -> case x of) + (%~) SInt SNat = Disproved (\ x -> case x of) + (%~) SInt SInt = Proved Refl + (%~) SInt SString = Disproved (\ x -> case x of) + (%~) SInt (SMaybe _) = Disproved (\ x -> case x of) + (%~) SInt (SVec _ _) = Disproved (\ x -> case x of) + (%~) SString SNat = Disproved (\ x -> case x of) + (%~) SString SInt = Disproved (\ x -> case x of) + (%~) SString SString = Proved Refl + (%~) SString (SMaybe _) = Disproved (\ x -> case x of) + (%~) SString (SVec _ _) = Disproved (\ x -> case x of) + (%~) (SMaybe _) SNat = Disproved (\ x -> case x of) + (%~) (SMaybe _) SInt = Disproved (\ x -> case x of) + (%~) (SMaybe _) SString = Disproved (\ x -> case x of) + (%~) (SMaybe a) (SMaybe b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SMaybe _) (SVec _ _) = Disproved (\ x -> case x of) + (%~) (SVec _ _) SNat = Disproved (\ x -> case x of) + (%~) (SVec _ _) SInt = Disproved (\ x -> case x of) + (%~) (SVec _ _) SString = Disproved (\ x -> case x of) + (%~) (SVec _ _) (SMaybe _) = Disproved (\ x -> case x of) + (%~) (SVec a a) (SVec b b) + = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of + GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl + GHC.Tuple.(,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance (SOrd Type, SOrd Nat) => SOrd Type where + sCompare :: + forall (t1 :: Type) (t2 :: Type). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Type (TyFun Type Ordering + -> Type) + -> Type) t1) t2) + sCompare SNat SNat + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SInt SInt + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SString SString + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare + (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)) + sCompare SNat SInt = SLT + sCompare SNat SString = SLT + sCompare SNat (SMaybe _) = SLT + sCompare SNat (SVec _ _) = SLT + sCompare SInt SNat = SGT + sCompare SInt SString = SLT + sCompare SInt (SMaybe _) = SLT + sCompare SInt (SVec _ _) = SLT + sCompare SString SNat = SGT + sCompare SString SInt = SGT + sCompare SString (SMaybe _) = SLT + sCompare SString (SVec _ _) = SLT + sCompare (SMaybe _) SNat = SGT + sCompare (SMaybe _) SInt = SGT + sCompare (SMaybe _) SString = SGT + sCompare (SMaybe _) (SVec _ _) = SLT + sCompare (SVec _ _) SNat = SGT + sCompare (SVec _ _) SInt = SGT + sCompare (SVec _ _) SString = SGT + sCompare (SVec _ _) (SMaybe _) = SGT + instance (SShow Type, SShow Nat) => SShow Type where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Type) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Type (TyFun Symbol Symbol + -> Type) + -> Type) + -> Type) t1) t2) t3) + sShowsPrec + _ + SNat + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Nat"))) + sA_0123456789876543210 + sShowsPrec + _ + SInt + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Int"))) + sA_0123456789876543210 + sShowsPrec + _ + SString + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "String"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMaybe (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Maybe ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SVec (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Vec ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance SingI Nat where + sing = SNat + instance SingI Int where + sing = SInt + instance SingI String where + sing = SString + instance SingI n => SingI (Maybe (n :: Type)) where + sing = SMaybe sing + instance (SingI n, SingI n) => + SingI (Vec (n :: Type) (n :: Nat)) where + sing = (SVec sing) sing diff --git a/tests/compile-and-dump/Singletons/Star.hs b/tests/compile-and-dump/Singletons/Star.hs --- a/tests/compile-and-dump/Singletons/Star.hs +++ b/tests/compile-and-dump/Singletons/Star.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.Star where @@ -8,7 +8,7 @@ import Singletons.Nat import Data.Kind -data Vec :: * -> Nat -> * where +data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) diff --git a/tests/compile-and-dump/Singletons/T124.ghc82.template b/tests/compile-and-dump/Singletons/T124.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T124.ghc82.template +++ /dev/null @@ -1,29 +0,0 @@ -Singletons/T124.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: Bool -> () - foo True = () - foo False = () |] - ======> - foo :: Bool -> () - foo True = GHC.Tuple.() - foo False = GHC.Tuple.() - type FooSym1 (t :: Bool) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun Bool ()) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Foo (a :: Bool) :: () where - Foo True = Tuple0Sym0 - Foo False = Tuple0Sym0 - sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) - sFoo STrue = STuple0 - sFoo SFalse = STuple0 -Singletons/T124.hs:0:0:: Splicing expression - sCases ''Bool [| b |] [| STuple0 |] - ======> - case b of - SFalse -> STuple0 - STrue -> STuple0 diff --git a/tests/compile-and-dump/Singletons/T124.ghc84.template b/tests/compile-and-dump/Singletons/T124.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T124.ghc84.template @@ -0,0 +1,29 @@ +Singletons/T124.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> () + foo True = () + foo False = () |] + ======> + foo :: Bool -> () + foo True = GHC.Tuple.() + foo False = GHC.Tuple.() + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool ()) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type family Foo (a :: Bool) :: () where + Foo True = Tuple0Sym0 + Foo False = Tuple0Sym0 + sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo STrue = STuple0 + sFoo SFalse = STuple0 +Singletons/T124.hs:0:0:: Splicing expression + sCases ''Bool [| b |] [| STuple0 |] + ======> + case b of + SFalse -> STuple0 + STrue -> STuple0 diff --git a/tests/compile-and-dump/Singletons/T136.ghc82.template b/tests/compile-and-dump/Singletons/T136.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T136.ghc82.template +++ /dev/null @@ -1,171 +0,0 @@ -Singletons/T136.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| instance Enum BiNat where - succ [] = [True] - succ (False : as) = True : as - succ (True : as) = False : succ as - pred [] = error "pred 0" - pred (False : as) = True : pred as - pred (True : as) = False : as - toEnum i - | i < 0 = error "negative toEnum" - | i == 0 = [] - | otherwise = succ (toEnum (pred i)) - fromEnum [] = 0 - fromEnum (False : as) = 2 * fromEnum as - fromEnum (True : as) = 1 + 2 * fromEnum as |] - ======> - instance Enum BiNat where - succ GHC.Types.[] = [True] - succ (False GHC.Types.: as) = (True GHC.Types.: as) - succ (True GHC.Types.: as) = (False GHC.Types.: (succ as)) - pred GHC.Types.[] = error "pred 0" - pred (False GHC.Types.: as) = (True GHC.Types.: (pred as)) - pred (True GHC.Types.: as) = (False GHC.Types.: as) - toEnum i - | (i < 0) = error "negative toEnum" - | (i == 0) = [] - | otherwise = succ (toEnum (pred i)) - fromEnum GHC.Types.[] = 0 - fromEnum (False GHC.Types.: as) = (2 * (fromEnum as)) - fromEnum (True GHC.Types.: as) = (1 + (2 * (fromEnum as))) - type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where - Succ_0123456789876543210 '[] = Apply (Apply (:$) TrueSym0) '[] - Succ_0123456789876543210 ((:) False as) = Apply (Apply (:$) TrueSym0) as - Succ_0123456789876543210 ((:) True as) = Apply (Apply (:$) FalseSym0) (Apply SuccSym0 as) - type Succ_0123456789876543210Sym1 (t :: [Bool]) = - Succ_0123456789876543210 t - instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Succ_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Succ_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => - Succ_0123456789876543210Sym0KindInference - type instance Apply Succ_0123456789876543210Sym0 l = Succ_0123456789876543210 l - type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where - Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0" - Pred_0123456789876543210 ((:) False as) = Apply (Apply (:$) TrueSym0) (Apply PredSym0 as) - Pred_0123456789876543210 ((:) True as) = Apply (Apply (:$) FalseSym0) as - type Pred_0123456789876543210Sym1 (t :: [Bool]) = - Pred_0123456789876543210 t - instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Pred_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Pred_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => - Pred_0123456789876543210Sym0KindInference - type instance Apply Pred_0123456789876543210Sym0 l = Pred_0123456789876543210 l - type family Case_0123456789876543210 i arg_0123456789876543210 t where - Case_0123456789876543210 i arg_0123456789876543210 True = '[] - Case_0123456789876543210 i arg_0123456789876543210 False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) - type family Case_0123456789876543210 i arg_0123456789876543210 t where - Case_0123456789876543210 i arg_0123456789876543210 True = Apply ErrorSym0 "negative toEnum" - Case_0123456789876543210 i arg_0123456789876543210 False = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (:==$) i) (FromInteger 0)) - type family Case_0123456789876543210 arg_0123456789876543210 t where - Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (:<$) i) (FromInteger 0)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where - ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat [Bool]) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where - FromEnum_0123456789876543210 '[] = FromInteger 0 - FromEnum_0123456789876543210 ((:) False as) = Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as) - FromEnum_0123456789876543210 ((:) True as) = Apply (Apply (:+$) (FromInteger 1)) (Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as)) - type FromEnum_0123456789876543210Sym1 (t :: [Bool]) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun [Bool] GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum [Bool] where - type Succ (a :: [Bool]) = Apply Succ_0123456789876543210Sym0 a - type Pred (a :: [Bool]) = Apply Pred_0123456789876543210Sym0 a - type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum (a :: [Bool]) = Apply FromEnum_0123456789876543210Sym0 a - instance SEnum [Bool] where - sSucc :: - forall (t :: [Bool]). - Sing t - -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] - -> GHC.Types.Type) t :: [Bool]) - sPred :: - forall (t :: [Bool]). - Sing t - -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] - -> GHC.Types.Type) t :: [Bool]) - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool] - -> GHC.Types.Type) t :: [Bool]) - sFromEnum :: - forall (t :: [Bool]). - Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat - -> GHC.Types.Type) t :: GHC.Types.Nat) - sSucc SNil - = (applySing ((applySing ((singFun2 @(:$)) SCons)) STrue)) SNil - sSucc (SCons SFalse (sAs :: Sing as)) - = (applySing ((applySing ((singFun2 @(:$)) SCons)) STrue)) sAs - sSucc (SCons STrue (sAs :: Sing as)) - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SFalse)) - ((applySing ((singFun1 @SuccSym0) sSucc)) sAs) - sPred SNil = sError (sing :: Sing "pred 0") - sPred (SCons SFalse (sAs :: Sing as)) - = (applySing ((applySing ((singFun2 @(:$)) SCons)) STrue)) - ((applySing ((singFun1 @PredSym0) sPred)) sAs) - sPred (SCons STrue (sAs :: Sing as)) - = (applySing ((applySing ((singFun2 @(:$)) SCons)) SFalse)) sAs - sToEnum (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - = case sArg_0123456789876543210 of { - sI :: Sing i - -> case - (applySing ((applySing ((singFun2 @(:<$)) (%:<))) sI)) - (sFromInteger (sing :: Sing 0)) - of - STrue -> sError (sing :: Sing "negative toEnum") - SFalse - -> case - (applySing ((applySing ((singFun2 @(:==$)) (%:==))) sI)) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SNil - SFalse - -> (applySing ((singFun1 @SuccSym0) sSucc)) - ((applySing ((singFun1 @ToEnumSym0) sToEnum)) - ((applySing ((singFun1 @PredSym0) sPred)) sI)) :: - Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (:==$) i) (FromInteger 0)) :: [Bool]) :: - Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (:<$) i) (FromInteger 0)) :: [Bool]) } :: - Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 :: [Bool]) - sFromEnum SNil = sFromInteger (sing :: Sing 0) - sFromEnum (SCons SFalse (sAs :: Sing as)) - = (applySing - ((applySing ((singFun2 @(:*$)) (%:*))) - (sFromInteger (sing :: Sing 2)))) - ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs) - sFromEnum (SCons STrue (sAs :: Sing as)) - = (applySing - ((applySing ((singFun2 @(:+$)) (%:+))) - (sFromInteger (sing :: Sing 1)))) - ((applySing - ((applySing ((singFun2 @(:*$)) (%:*))) - (sFromInteger (sing :: Sing 2)))) - ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs)) diff --git a/tests/compile-and-dump/Singletons/T136.ghc84.template b/tests/compile-and-dump/Singletons/T136.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136.ghc84.template @@ -0,0 +1,171 @@ +Singletons/T136.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance Enum BiNat where + succ [] = [True] + succ (False : as) = True : as + succ (True : as) = False : succ as + pred [] = error "pred 0" + pred (False : as) = True : pred as + pred (True : as) = False : as + toEnum i + | i < 0 = error "negative toEnum" + | i == 0 = [] + | otherwise = succ (toEnum (pred i)) + fromEnum [] = 0 + fromEnum (False : as) = 2 * fromEnum as + fromEnum (True : as) = 1 + 2 * fromEnum as |] + ======> + instance Enum BiNat where + succ GHC.Types.[] = [True] + succ (False GHC.Types.: as) = (True GHC.Types.: as) + succ (True GHC.Types.: as) = (False GHC.Types.: (succ as)) + pred GHC.Types.[] = error "pred 0" + pred (False GHC.Types.: as) = (True GHC.Types.: (pred as)) + pred (True GHC.Types.: as) = (False GHC.Types.: as) + toEnum i + | (i < 0) = error "negative toEnum" + | (i == 0) = [] + | otherwise = succ (toEnum (pred i)) + fromEnum GHC.Types.[] = 0 + fromEnum (False GHC.Types.: as) = (2 * (fromEnum as)) + fromEnum (True GHC.Types.: as) = (1 + (2 * (fromEnum as))) + type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where + Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) '[] + Succ_0123456789876543210 ((:) False as) = Apply (Apply (:@#@$) TrueSym0) as + Succ_0123456789876543210 ((:) True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as) + type Succ_0123456789876543210Sym1 (t :: [Bool]) = + Succ_0123456789876543210 t + instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Succ_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Succ_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => + Succ_0123456789876543210Sym0KindInference + type instance Apply Succ_0123456789876543210Sym0 l = Succ_0123456789876543210 l + type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where + Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0" + Pred_0123456789876543210 ((:) False as) = Apply (Apply (:@#@$) TrueSym0) (Apply PredSym0 as) + Pred_0123456789876543210 ((:) True as) = Apply (Apply (:@#@$) FalseSym0) as + type Pred_0123456789876543210Sym1 (t :: [Bool]) = + Pred_0123456789876543210 t + instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Pred_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Pred_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => + Pred_0123456789876543210Sym0KindInference + type instance Apply Pred_0123456789876543210Sym0 l = Pred_0123456789876543210 l + type family Case_0123456789876543210 i arg_0123456789876543210 t where + Case_0123456789876543210 i arg_0123456789876543210 True = '[] + Case_0123456789876543210 i arg_0123456789876543210 False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) + type family Case_0123456789876543210 i arg_0123456789876543210 t where + Case_0123456789876543210 i arg_0123456789876543210 True = Apply ErrorSym0 "negative toEnum" + Case_0123456789876543210 i arg_0123456789876543210 False = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)) + type family Case_0123456789876543210 arg_0123456789876543210 t where + Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where + ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 + type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789876543210 t + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat [Bool]) + = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0KindInference + type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l + type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where + FromEnum_0123456789876543210 '[] = FromInteger 0 + FromEnum_0123456789876543210 ((:) False as) = Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as) + FromEnum_0123456789876543210 ((:) True as) = Apply (Apply (+@#@$) (FromInteger 1)) (Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as)) + type FromEnum_0123456789876543210Sym1 (t :: [Bool]) = + FromEnum_0123456789876543210 t + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FromEnum_0123456789876543210Sym0 (l :: TyFun [Bool] GHC.Types.Nat) + = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0KindInference + type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l + instance PEnum [Bool] where + type Succ a = Apply Succ_0123456789876543210Sym0 a + type Pred a = Apply Pred_0123456789876543210Sym0 a + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + instance SEnum [Bool] where + sSucc :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t) + sPred :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t) + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool] + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat + -> GHC.Types.Type) t) + sSucc SNil + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) SNil + sSucc (SCons SFalse (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) sAs + sSucc (SCons STrue (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) + ((applySing ((singFun1 @SuccSym0) sSucc)) sAs) + sPred SNil = sError (sing :: Sing "pred 0") + sPred (SCons SFalse (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) + ((applySing ((singFun1 @PredSym0) sPred)) sAs) + sPred (SCons STrue (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) sAs + sToEnum (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + = case sArg_0123456789876543210 of { + sI :: Sing i + -> case + (applySing ((applySing ((singFun2 @(<@#@$)) (%<))) sI)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> sError (sing :: Sing "negative toEnum") + SFalse + -> case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sI)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> SNil + SFalse + -> (applySing ((singFun1 @SuccSym0) sSucc)) + ((applySing ((singFun1 @ToEnumSym0) sToEnum)) + ((applySing ((singFun1 @PredSym0) sPred)) sI)) :: + Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0))) :: + Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0))) } :: + Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210) + sFromEnum SNil = sFromInteger (sing :: Sing 0) + sFromEnum (SCons SFalse (sAs :: Sing as)) + = (applySing + ((applySing ((singFun2 @(*@#@$)) (%*))) + (sFromInteger (sing :: Sing 2)))) + ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs) + sFromEnum (SCons STrue (sAs :: Sing as)) + = (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) + (sFromInteger (sing :: Sing 1)))) + ((applySing + ((applySing ((singFun2 @(*@#@$)) (%*))) + (sFromInteger (sing :: Sing 2)))) + ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs)) diff --git a/tests/compile-and-dump/Singletons/T136b.ghc82.template b/tests/compile-and-dump/Singletons/T136b.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T136b.ghc82.template +++ /dev/null @@ -1,49 +0,0 @@ -Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| class C a where - meth :: a -> a |] - ======> - class C a where - meth :: a -> a - type MethSym1 (t :: a0123456789876543210) = Meth t - instance SuppressUnusedWarnings MethSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.()) - data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => - MethSym0KindInference - type instance Apply MethSym0 l = Meth l - class PC (a :: GHC.Types.Type) where - type Meth (arg :: a) :: a - class SC a where - sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) -Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| instance C Bool where - meth = not |] - ======> - instance C Bool where - meth = not - type family Meth_0123456789876543210 (a :: Bool) :: Bool where - Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym1 (t :: Bool) = - Meth_0123456789876543210 t - instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => - Meth_0123456789876543210Sym0KindInference - type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l - instance PC Bool where - type Meth (a :: Bool) = Apply Meth_0123456789876543210Sym0 a - instance SC Bool where - sMeth :: - forall (t :: Bool). - Sing t - -> Sing (Apply (MethSym0 :: TyFun Bool Bool - -> GHC.Types.Type) t :: Bool) - sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T136b.ghc84.template b/tests/compile-and-dump/Singletons/T136b.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136b.ghc84.template @@ -0,0 +1,48 @@ +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class C a where + meth :: a -> a |] + ======> + class C a where + meth :: a -> a + type MethSym1 (t :: a0123456789876543210) = Meth t + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.()) + data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => + MethSym0KindInference + type instance Apply MethSym0 l = Meth l + class PC (a :: GHC.Types.Type) where + type Meth (arg :: a) :: a + class SC a where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance C Bool where + meth = not |] + ======> + instance C Bool where + meth = not + type family Meth_0123456789876543210 (a :: Bool) :: Bool where + Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 + type Meth_0123456789876543210Sym1 (t :: Bool) = + Meth_0123456789876543210 t + instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => + Meth_0123456789876543210Sym0KindInference + type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l + instance PC Bool where + type Meth a = Apply Meth_0123456789876543210Sym0 a + instance SC Bool where + sMeth :: + forall (t :: Bool). + Sing t + -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> GHC.Types.Type) t) + sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T145.ghc82.template b/tests/compile-and-dump/Singletons/T145.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T145.ghc82.template +++ /dev/null @@ -1,30 +0,0 @@ -Singletons/T145.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| class Column (f :: Type -> Type) where - col :: f a -> a -> Bool |] - ======> - class Column (f :: Type -> Type) where - col :: f a -> a -> Bool - type ColSym2 (t :: f0123456789876543210 a0123456789876543210) (t :: a0123456789876543210) = - Col t t - instance SuppressUnusedWarnings ColSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ColSym1KindInference) GHC.Tuple.()) - data ColSym1 (l :: f0123456789876543210 a0123456789876543210) (l :: TyFun a0123456789876543210 Bool) - = forall arg. SameKind (Apply (ColSym1 l) arg) (ColSym2 l arg) => - ColSym1KindInference - type instance Apply (ColSym1 l) l = Col l l - instance SuppressUnusedWarnings ColSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) ColSym0KindInference) GHC.Tuple.()) - data ColSym0 (l :: TyFun (f0123456789876543210 a0123456789876543210) (TyFun a0123456789876543210 Bool - -> Type)) - = forall arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) => - ColSym0KindInference - type instance Apply ColSym0 l = ColSym1 l - class PColumn (f :: Type -> Type) where - type Col (arg :: f a) (arg :: a) :: Bool - class SColumn (f :: Type -> Type) where - sCol :: - forall (t :: f a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool) diff --git a/tests/compile-and-dump/Singletons/T145.ghc84.template b/tests/compile-and-dump/Singletons/T145.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T145.ghc84.template @@ -0,0 +1,30 @@ +Singletons/T145.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Column (f :: Type -> Type) where + col :: f a -> a -> Bool |] + ======> + class Column (f :: Type -> Type) where + col :: f a -> a -> Bool + type ColSym2 (t :: f0123456789876543210 a0123456789876543210) (t :: a0123456789876543210) = + Col t t + instance SuppressUnusedWarnings ColSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ColSym1KindInference) GHC.Tuple.()) + data ColSym1 (l :: f0123456789876543210 a0123456789876543210) (l :: TyFun a0123456789876543210 Bool) + = forall arg. SameKind (Apply (ColSym1 l) arg) (ColSym2 l arg) => + ColSym1KindInference + type instance Apply (ColSym1 l) l = Col l l + instance SuppressUnusedWarnings ColSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ColSym0KindInference) GHC.Tuple.()) + data ColSym0 (l :: TyFun (f0123456789876543210 a0123456789876543210) (TyFun a0123456789876543210 Bool + -> Type)) + = forall arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) => + ColSym0KindInference + type instance Apply ColSym0 l = ColSym1 l + class PColumn (f :: Type -> Type) where + type Col (arg :: f a) (arg :: a) :: Bool + class SColumn (f :: Type -> Type) where + sCol :: + forall (t :: f a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool) diff --git a/tests/compile-and-dump/Singletons/T153.ghc82.template b/tests/compile-and-dump/Singletons/T153.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T153.ghc82.template +++ /dev/null diff --git a/tests/compile-and-dump/Singletons/T153.ghc84.template b/tests/compile-and-dump/Singletons/T153.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T153.ghc84.template diff --git a/tests/compile-and-dump/Singletons/T157.ghc82.template b/tests/compile-and-dump/Singletons/T157.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T157.ghc82.template +++ /dev/null diff --git a/tests/compile-and-dump/Singletons/T157.ghc84.template b/tests/compile-and-dump/Singletons/T157.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T157.ghc84.template diff --git a/tests/compile-and-dump/Singletons/T159.ghc82.template b/tests/compile-and-dump/Singletons/T159.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T159.ghc82.template +++ /dev/null @@ -1,181 +0,0 @@ -Singletons/T159.hs:0:0:: Splicing declarations - genSingletons [''T0, ''T1] - ======> - type ASym0 = A - type BSym0 = B - type CSym0 = C - type DSym0 = D - type ESym0 = E - type FSym0 = F - data instance Sing (z :: T0) - = z ~ A => SA | - z ~ B => SB | - z ~ C => SC | - z ~ D => SD | - z ~ E => SE | - z ~ F => SF - type ST0 = (Sing :: T0 -> GHC.Types.Type) - instance SingKind T0 where - type Demote T0 = T0 - fromSing SA = A - fromSing SB = B - fromSing SC = C - fromSing SD = D - fromSing SE = E - fromSing SF = F - toSing A = SomeSing SA - toSing B = SomeSing SB - toSing C = SomeSing SC - toSing D = SomeSing SD - toSing E = SomeSing SE - toSing F = SomeSing SF - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI C where - sing = SC - instance SingI D where - sing = SD - instance SingI E where - sing = SE - instance SingI F where - sing = SF - type N1Sym0 = N1 - type C1Sym2 (t :: T0) (t :: T1) = C1 t t - instance SuppressUnusedWarnings C1Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) C1Sym1KindInference) GHC.Tuple.()) - data C1Sym1 (l :: T0) (l :: TyFun T1 T1) - = forall arg. SameKind (Apply (C1Sym1 l) arg) (C1Sym2 l arg) => - C1Sym1KindInference - type instance Apply (C1Sym1 l) l = C1 l l - instance SuppressUnusedWarnings C1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) C1Sym0KindInference) GHC.Tuple.()) - data C1Sym0 (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) - = forall arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => - C1Sym0KindInference - type instance Apply C1Sym0 l = C1Sym1 l - type (:&&$$$) (t :: T0) (t :: T1) = (:&&) t t - instance SuppressUnusedWarnings (:&&$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:&&$$###)) GHC.Tuple.()) - data (:&&$$) (l :: T0) (l :: TyFun T1 T1) - = forall arg. SameKind (Apply ((:&&$$) l) arg) ((:&&$$$) l arg) => - (:&&$$###) - type instance Apply ((:&&$$) l) l = (:&&) l l - instance SuppressUnusedWarnings (:&&$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:&&$###)) GHC.Tuple.()) - data (:&&$) (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:&&$) arg) ((:&&$$) arg) => - (:&&$###) - type instance Apply (:&&$) l = (:&&$$) l - data instance Sing (z :: T1) - = z ~ N1 => SN1 | - forall (n :: T0) (n :: T1). z ~ C1 n n => - SC1 (Sing (n :: T0)) (Sing (n :: T1)) | - forall (n :: T0) (n :: T1). z ~ (:&&) n n => - (:%&&) (Sing (n :: T0)) (Sing (n :: T1)) - type ST1 = (Sing :: T1 -> GHC.Types.Type) - instance SingKind T1 where - type Demote T1 = T1 - fromSing SN1 = N1 - fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b) - fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b) - toSing N1 = SomeSing SN1 - toSing (C1 b b) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) } - toSing ((:&&) b b) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%&&) c) c) } - infixr 5 `SC1` - infixr 5 :%&& - instance SingI N1 where - sing = SN1 - instance (SingI n, SingI n) => SingI (C1 (n :: T0) (n :: T1)) where - sing = (SC1 sing) sing - instance (SingI n, SingI n) => - SingI ((:&&) (n :: T0) (n :: T1)) where - sing = ((:%&&) sing) sing -Singletons/T159.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixr 5 :|| - infixr 5 `C2` - - data T2 = N2 | C2 T0 T2 | T0 :|| T2 |] - ======> - data T2 = N2 | C2 T0 T2 | T0 :|| T2 - infixr 5 `C2` - infixr 5 :|| - type N2Sym0 = N2 - type C2Sym2 (t :: T0) (t :: T2) = C2 t t - instance SuppressUnusedWarnings C2Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) C2Sym1KindInference) GHC.Tuple.()) - data C2Sym1 (l :: T0) (l :: TyFun T2 T2) - = forall arg. SameKind (Apply (C2Sym1 l) arg) (C2Sym2 l arg) => - C2Sym1KindInference - type instance Apply (C2Sym1 l) l = C2 l l - instance SuppressUnusedWarnings C2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) C2Sym0KindInference) GHC.Tuple.()) - data C2Sym0 (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) - = forall arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => - C2Sym0KindInference - type instance Apply C2Sym0 l = C2Sym1 l - type (:||$$$) (t :: T0) (t :: T2) = (:||) t t - instance SuppressUnusedWarnings (:||$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:||$$###)) GHC.Tuple.()) - data (:||$$) (l :: T0) (l :: TyFun T2 T2) - = forall arg. SameKind (Apply ((:||$$) l) arg) ((:||$$$) l arg) => - (:||$$###) - type instance Apply ((:||$$) l) l = (:||) l l - instance SuppressUnusedWarnings (:||$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:||$###)) GHC.Tuple.()) - data (:||$) (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:||$) arg) ((:||$$) arg) => - (:||$###) - type instance Apply (:||$) l = (:||$$) l - infixr 5 :%|| - infixr 5 `SC2` - data instance Sing (z :: T2) - = z ~ N2 => SN2 | - forall (n :: T0) (n :: T2). z ~ C2 n n => - SC2 (Sing (n :: T0)) (Sing (n :: T2)) | - forall (n :: T0) (n :: T2). z ~ (:||) n n => - (:%||) (Sing (n :: T0)) (Sing (n :: T2)) - type ST2 = (Sing :: T2 -> GHC.Types.Type) - instance SingKind T2 where - type Demote T2 = T2 - fromSing SN2 = N2 - fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b) - fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b) - toSing N2 = SomeSing SN2 - toSing (C2 b b) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) } - toSing ((:||) b b) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%||) c) c) } - instance SingI N2 where - sing = SN2 - instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where - sing = (SC2 sing) sing - instance (SingI n, SingI n) => - SingI ((:||) (n :: T0) (n :: T2)) where - sing = ((:%||) sing) sing diff --git a/tests/compile-and-dump/Singletons/T159.ghc84.template b/tests/compile-and-dump/Singletons/T159.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T159.ghc84.template @@ -0,0 +1,184 @@ +Singletons/T159.hs:0:0:: Splicing declarations + genSingletons [''T0, ''T1] + ======> + type ASym0 = A + type BSym0 = B + type CSym0 = C + type DSym0 = D + type ESym0 = E + type FSym0 = F + data instance Sing (z :: T0) + where + SA :: Sing A + SB :: Sing B + SC :: Sing C + SD :: Sing D + SE :: Sing E + SF :: Sing F + type ST0 = (Sing :: T0 -> GHC.Types.Type) + instance SingKind T0 where + type Demote T0 = T0 + fromSing SA = A + fromSing SB = B + fromSing SC = C + fromSing SD = D + fromSing SE = E + fromSing SF = F + toSing A = SomeSing SA + toSing B = SomeSing SB + toSing C = SomeSing SC + toSing D = SomeSing SD + toSing E = SomeSing SE + toSing F = SomeSing SF + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI C where + sing = SC + instance SingI D where + sing = SD + instance SingI E where + sing = SE + instance SingI F where + sing = SF + type N1Sym0 = N1 + type C1Sym2 (t :: T0) (t :: T1) = C1 t t + instance SuppressUnusedWarnings C1Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) C1Sym1KindInference) GHC.Tuple.()) + data C1Sym1 (l :: T0) (l :: TyFun T1 T1) + = forall arg. SameKind (Apply (C1Sym1 l) arg) (C1Sym2 l arg) => + C1Sym1KindInference + type instance Apply (C1Sym1 l) l = C1 l l + instance SuppressUnusedWarnings C1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) C1Sym0KindInference) GHC.Tuple.()) + data C1Sym0 (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) + = forall arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => + C1Sym0KindInference + type instance Apply C1Sym0 l = C1Sym1 l + type (:&&@#@$$$) (t :: T0) (t :: T1) = (:&&) t t + instance SuppressUnusedWarnings (:&&@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::&&@#@$$###)) GHC.Tuple.()) + data (:&&@#@$$) (l :: T0) (l :: TyFun T1 T1) + = forall arg. SameKind (Apply ((:&&@#@$$) l) arg) ((:&&@#@$$$) l arg) => + (::&&@#@$$###) + type instance Apply ((:&&@#@$$) l) l = (:&&) l l + instance SuppressUnusedWarnings (:&&@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::&&@#@$###)) GHC.Tuple.()) + data (:&&@#@$) (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => + (::&&@#@$###) + type instance Apply (:&&@#@$) l = (:&&@#@$$) l + data instance Sing (z :: T1) + where + SN1 :: Sing N1 + SC1 :: forall (n :: T0) (n :: T1). + (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing (C1 n n) + (:%&&) :: forall (n :: T0) (n :: T1). + (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ((:&&) n n) + type ST1 = (Sing :: T1 -> GHC.Types.Type) + instance SingKind T1 where + type Demote T1 = T1 + fromSing SN1 = N1 + fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b) + fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b) + toSing N1 = SomeSing SN1 + toSing (C1 (b :: Demote T0) (b :: Demote T1)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) } + toSing ((:&&) (b :: Demote T0) (b :: Demote T1)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%&&) c) c) } + infixr 5 `SC1` + infixr 5 :%&& + instance SingI N1 where + sing = SN1 + instance (SingI n, SingI n) => SingI (C1 (n :: T0) (n :: T1)) where + sing = (SC1 sing) sing + instance (SingI n, SingI n) => + SingI ((:&&) (n :: T0) (n :: T1)) where + sing = ((:%&&) sing) sing +Singletons/T159.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixr 5 :|| + infixr 5 `C2` + + data T2 = N2 | C2 T0 T2 | T0 :|| T2 |] + ======> + data T2 = N2 | C2 T0 T2 | T0 :|| T2 + infixr 5 `C2` + infixr 5 :|| + type N2Sym0 = N2 + type C2Sym2 (t :: T0) (t :: T2) = C2 t t + instance SuppressUnusedWarnings C2Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) C2Sym1KindInference) GHC.Tuple.()) + data C2Sym1 (l :: T0) (l :: TyFun T2 T2) + = forall arg. SameKind (Apply (C2Sym1 l) arg) (C2Sym2 l arg) => + C2Sym1KindInference + type instance Apply (C2Sym1 l) l = C2 l l + instance SuppressUnusedWarnings C2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) C2Sym0KindInference) GHC.Tuple.()) + data C2Sym0 (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) + = forall arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => + C2Sym0KindInference + type instance Apply C2Sym0 l = C2Sym1 l + type (:||@#@$$$) (t :: T0) (t :: T2) = (:||) t t + instance SuppressUnusedWarnings (:||@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::||@#@$$###)) GHC.Tuple.()) + data (:||@#@$$) (l :: T0) (l :: TyFun T2 T2) + = forall arg. SameKind (Apply ((:||@#@$$) l) arg) ((:||@#@$$$) l arg) => + (::||@#@$$###) + type instance Apply ((:||@#@$$) l) l = (:||) l l + instance SuppressUnusedWarnings (:||@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::||@#@$###)) GHC.Tuple.()) + data (:||@#@$) (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => + (::||@#@$###) + type instance Apply (:||@#@$) l = (:||@#@$$) l + infixr 5 :%|| + infixr 5 `SC2` + data instance Sing (z :: T2) + where + SN2 :: Sing N2 + SC2 :: forall (n :: T0) (n :: T2). + (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing (C2 n n) + (:%||) :: forall (n :: T0) (n :: T2). + (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing ((:||) n n) + type ST2 = (Sing :: T2 -> GHC.Types.Type) + instance SingKind T2 where + type Demote T2 = T2 + fromSing SN2 = N2 + fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b) + fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b) + toSing N2 = SomeSing SN2 + toSing (C2 (b :: Demote T0) (b :: Demote T2)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) } + toSing ((:||) (b :: Demote T0) (b :: Demote T2)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%||) c) c) } + instance SingI N2 where + sing = SN2 + instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where + sing = (SC2 sing) sing + instance (SingI n, SingI n) => + SingI ((:||) (n :: T0) (n :: T2)) where + sing = ((:%||) sing) sing diff --git a/tests/compile-and-dump/Singletons/T163.ghc84.template b/tests/compile-and-dump/Singletons/T163.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T163.ghc84.template @@ -0,0 +1,37 @@ +Singletons/T163.hs:0:0:: Splicing declarations + singletons [d| data a + b = L a | R b |] + ======> + data (+) a b = L a | R b + type LSym1 (t :: a0123456789876543210) = L t + instance SuppressUnusedWarnings LSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) LSym0KindInference) GHC.Tuple.()) + data LSym0 (l :: TyFun a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply LSym0 arg) (LSym1 arg) => + LSym0KindInference + type instance Apply LSym0 l = L l + type RSym1 (t :: b0123456789876543210) = R t + instance SuppressUnusedWarnings RSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) RSym0KindInference) GHC.Tuple.()) + data RSym0 (l :: TyFun b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply RSym0 arg) (RSym1 arg) => + RSym0KindInference + type instance Apply RSym0 l = R l + data instance Sing (z :: (+) a b) + where + SL :: forall (n :: a). (Sing (n :: a)) -> Sing (L n) + SR :: forall (n :: b). (Sing (n :: b)) -> Sing (R n) + type %+ = (Sing :: (+) a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind ((+) a b) where + type Demote ((+) a b) = (+) (Demote a) (Demote b) + fromSing (SL b) = L (fromSing b) + fromSing (SR b) = R (fromSing b) + toSing (L (b :: Demote a)) + = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SL c) } + toSing (R (b :: Demote b)) + = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SR c) } + instance SingI n => SingI (L (n :: a)) where + sing = SL sing + instance SingI n => SingI (R (n :: b)) where + sing = SR sing diff --git a/tests/compile-and-dump/Singletons/T163.hs b/tests/compile-and-dump/Singletons/T163.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T163.hs @@ -0,0 +1,5 @@ +module T163 where + +import Data.Singletons.TH + +$(singletons [d| data a + b = L a | R b |]) diff --git a/tests/compile-and-dump/Singletons/T166.ghc82.template b/tests/compile-and-dump/Singletons/T166.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T166.ghc82.template +++ /dev/null @@ -1,11 +0,0 @@ - -Singletons/T166.hs:0:0: error: - Function being promoted to FooSym0 has too many arguments. - | -14 | $(singletonsOnly [d| - | ^^^^^^^^^^^^^^^^^^... - -Singletons/T166.hs:0:0: error: Q monad failure - | -14 | $(singletonsOnly [d| - | ^^^^^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T166.ghc84.template b/tests/compile-and-dump/Singletons/T166.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T166.ghc84.template @@ -0,0 +1,11 @@ + +Singletons/T166.hs:0:0: error: + Function being promoted to FooSym0 has too many arguments. + | +14 | $(singletonsOnly [d| + | ^^^^^^^^^^^^^^^^^^... + +Singletons/T166.hs:0:0: error: Q monad failure + | +14 | $(singletonsOnly [d| + | ^^^^^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T167.ghc82.template b/tests/compile-and-dump/Singletons/T167.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T167.ghc82.template +++ /dev/null @@ -1,149 +0,0 @@ -Singletons/T167.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| class Foo a where - foosPrec :: Nat -> a -> DiffList - fooList :: a -> DiffList - fooList = undefined - - instance Foo a => Foo [a] where - foosPrec _ = fooList |] - ======> - type FoosPrecSym3 (t :: Nat) (t :: a0123456789876543210) (t :: [Bool]) = - FoosPrec t t t - instance SuppressUnusedWarnings FoosPrecSym2 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FoosPrecSym2KindInference) GHC.Tuple.()) - data FoosPrecSym2 (l :: Nat) (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply (FoosPrecSym2 l l) arg) (FoosPrecSym3 l l arg) => - FoosPrecSym2KindInference - type instance Apply (FoosPrecSym2 l l) l = FoosPrec l l l - instance SuppressUnusedWarnings FoosPrecSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FoosPrecSym1KindInference) GHC.Tuple.()) - data FoosPrecSym1 (l :: Nat) (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FoosPrecSym1 l) arg) (FoosPrecSym2 l arg) => - FoosPrecSym1KindInference - type instance Apply (FoosPrecSym1 l) l = FoosPrecSym2 l l - instance SuppressUnusedWarnings FoosPrecSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FoosPrecSym0KindInference) GHC.Tuple.()) - data FoosPrecSym0 (l :: TyFun Nat (TyFun a0123456789876543210 (TyFun [Bool] [Bool] - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => - FoosPrecSym0KindInference - type instance Apply FoosPrecSym0 l = FoosPrecSym1 l - type FooListSym2 (t :: a0123456789876543210) (t :: [Bool]) = - FooList t t - instance SuppressUnusedWarnings FooListSym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooListSym1KindInference) GHC.Tuple.()) - data FooListSym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply (FooListSym1 l) arg) (FooListSym2 l arg) => - FooListSym1KindInference - type instance Apply (FooListSym1 l) l = FooList l l - instance SuppressUnusedWarnings FooListSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooListSym0KindInference) GHC.Tuple.()) - data FooListSym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => - FooListSym0KindInference - type instance Apply FooListSym0 l = FooListSym1 l - type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where - FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply Any a_0123456789876543210) a_0123456789876543210 - type FooList_0123456789876543210Sym2 (t :: a0123456789876543210) (t :: [Bool]) = - FooList_0123456789876543210 t t - instance SuppressUnusedWarnings FooList_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FooList_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data FooList_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply (FooList_0123456789876543210Sym1 l) arg) (FooList_0123456789876543210Sym2 l arg) => - FooList_0123456789876543210Sym1KindInference - type instance Apply (FooList_0123456789876543210Sym1 l) l = FooList_0123456789876543210 l l - instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FooList_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FooList_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => - FooList_0123456789876543210Sym0KindInference - type instance Apply FooList_0123456789876543210Sym0 l = FooList_0123456789876543210Sym1 l - class PFoo (a :: GHC.Types.Type) where - type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] - type FooList (arg :: a) (arg :: [Bool]) :: [Bool] - type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a - type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where - FoosPrec_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 - type FoosPrec_0123456789876543210Sym3 (t :: Nat) (t :: [a0123456789876543210]) (t :: [Bool]) = - FoosPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym2 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data FoosPrec_0123456789876543210Sym2 (l :: Nat) (l :: [a0123456789876543210]) (l :: TyFun [Bool] [Bool]) - = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 l l) arg) (FoosPrec_0123456789876543210Sym3 l l arg) => - FoosPrec_0123456789876543210Sym2KindInference - type instance Apply (FoosPrec_0123456789876543210Sym2 l l) l = FoosPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data FoosPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun [a0123456789876543210] (TyFun [Bool] [Bool] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 l) arg) (FoosPrec_0123456789876543210Sym2 l arg) => - FoosPrec_0123456789876543210Sym1KindInference - type instance Apply (FoosPrec_0123456789876543210Sym1 l) l = FoosPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FoosPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun [a0123456789876543210] (TyFun [Bool] [Bool] - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => - FoosPrec_0123456789876543210Sym0KindInference - type instance Apply FoosPrec_0123456789876543210Sym0 l = FoosPrec_0123456789876543210Sym1 l - instance PFoo [a] where - type FoosPrec (a :: Nat) (a :: [a]) (a :: [Bool]) = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a - class SFoo a where - sFoosPrec :: - forall (t :: Nat) (t :: a) (t :: [Bool]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) - sFooList :: - forall (t :: a) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) - default sFooList :: - forall (t :: a) (t :: [Bool]). - (Apply (Apply FooListSym0 t) t :: [Bool]) ~ Apply (Apply FooList_0123456789876543210Sym0 t) t => - Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) - sFooList - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = undefined - instance SFoo a => SFoo [a] where - sFoosPrec :: - forall (t :: Nat) (t :: [a]) (t :: [Bool]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) - sFoosPrec - _ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @FooListSym0) sFooList)) - sA_0123456789876543210)) - sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T167.ghc84.template b/tests/compile-and-dump/Singletons/T167.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T167.ghc84.template @@ -0,0 +1,149 @@ +Singletons/T167.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [d| class Foo a where + foosPrec :: Nat -> a -> DiffList + fooList :: a -> DiffList + fooList = undefined + + instance Foo a => Foo [a] where + foosPrec _ = fooList |] + ======> + type FoosPrecSym3 (t :: Nat) (t :: a0123456789876543210) (t :: [Bool]) = + FoosPrec t t t + instance SuppressUnusedWarnings FoosPrecSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FoosPrecSym2KindInference) GHC.Tuple.()) + data FoosPrecSym2 (l :: Nat) (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply (FoosPrecSym2 l l) arg) (FoosPrecSym3 l l arg) => + FoosPrecSym2KindInference + type instance Apply (FoosPrecSym2 l l) l = FoosPrec l l l + instance SuppressUnusedWarnings FoosPrecSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FoosPrecSym1KindInference) GHC.Tuple.()) + data FoosPrecSym1 (l :: Nat) (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (FoosPrecSym1 l) arg) (FoosPrecSym2 l arg) => + FoosPrecSym1KindInference + type instance Apply (FoosPrecSym1 l) l = FoosPrecSym2 l l + instance SuppressUnusedWarnings FoosPrecSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FoosPrecSym0KindInference) GHC.Tuple.()) + data FoosPrecSym0 (l :: TyFun Nat (TyFun a0123456789876543210 (TyFun [Bool] [Bool] + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => + FoosPrecSym0KindInference + type instance Apply FoosPrecSym0 l = FoosPrecSym1 l + type FooListSym2 (t :: a0123456789876543210) (t :: [Bool]) = + FooList t t + instance SuppressUnusedWarnings FooListSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooListSym1KindInference) GHC.Tuple.()) + data FooListSym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply (FooListSym1 l) arg) (FooListSym2 l arg) => + FooListSym1KindInference + type instance Apply (FooListSym1 l) l = FooList l l + instance SuppressUnusedWarnings FooListSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooListSym0KindInference) GHC.Tuple.()) + data FooListSym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => + FooListSym0KindInference + type instance Apply FooListSym0 l = FooListSym1 l + type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where + FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210 + type FooList_0123456789876543210Sym2 (t :: a0123456789876543210) (t :: [Bool]) = + FooList_0123456789876543210 t t + instance SuppressUnusedWarnings FooList_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FooList_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data FooList_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply (FooList_0123456789876543210Sym1 l) arg) (FooList_0123456789876543210Sym2 l arg) => + FooList_0123456789876543210Sym1KindInference + type instance Apply (FooList_0123456789876543210Sym1 l) l = FooList_0123456789876543210 l l + instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FooList_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FooList_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => + FooList_0123456789876543210Sym0KindInference + type instance Apply FooList_0123456789876543210Sym0 l = FooList_0123456789876543210Sym1 l + class PFoo (a :: GHC.Types.Type) where + type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] + type FooList (arg :: a) (arg :: [Bool]) :: [Bool] + type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a + type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where + FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 + type FoosPrec_0123456789876543210Sym3 (t :: Nat) (t :: [a0123456789876543210]) (t :: [Bool]) = + FoosPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data FoosPrec_0123456789876543210Sym2 (l :: Nat) (l :: [a0123456789876543210]) (l :: TyFun [Bool] [Bool]) + = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 l l) arg) (FoosPrec_0123456789876543210Sym3 l l arg) => + FoosPrec_0123456789876543210Sym2KindInference + type instance Apply (FoosPrec_0123456789876543210Sym2 l l) l = FoosPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data FoosPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun [a0123456789876543210] (TyFun [Bool] [Bool] + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 l) arg) (FoosPrec_0123456789876543210Sym2 l arg) => + FoosPrec_0123456789876543210Sym1KindInference + type instance Apply (FoosPrec_0123456789876543210Sym1 l) l = FoosPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FoosPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun [a0123456789876543210] (TyFun [Bool] [Bool] + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => + FoosPrec_0123456789876543210Sym0KindInference + type instance Apply FoosPrec_0123456789876543210Sym0 l = FoosPrec_0123456789876543210Sym1 l + instance PFoo [a] where + type FoosPrec a a a = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a + class SFoo a where + sFoosPrec :: + forall (t :: Nat) (t :: a) (t :: [Bool]). + Sing t + -> Sing t + -> Sing t + -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) + sFooList :: + forall (t :: a) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) + default sFooList :: + forall (t :: a) (t :: [Bool]). + (Apply (Apply FooListSym0 t) t :: [Bool]) ~ Apply (Apply FooList_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) + sFooList + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (sUndefined sA_0123456789876543210) sA_0123456789876543210 + instance SFoo a => SFoo [a] where + sFoosPrec :: + forall (t :: Nat) (t :: [a]) (t :: [Bool]). + Sing t + -> Sing t + -> Sing t + -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) + sFoosPrec + _ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @FooListSym0) sFooList)) + sA_0123456789876543210)) + sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T172.ghc82.template b/tests/compile-and-dump/Singletons/T172.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T172.ghc82.template +++ /dev/null @@ -1,30 +0,0 @@ -Singletons/T172.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| ($>) :: Nat -> Nat -> Nat - ($>) = (+) |] - ======> - type ($>$$$) (t :: Nat) (t :: Nat) = ($>) t t - instance SuppressUnusedWarnings ($>$$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:$>$$###)) GHC.Tuple.()) - data ($>$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (($>$$) l) arg) (($>$$$) l arg) => - (:$>$$###) - type instance Apply (($>$$) l) l = ($>) l l - instance SuppressUnusedWarnings ($>$) where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) (:$>$###)) GHC.Tuple.()) - data ($>$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply ($>$) arg) (($>$$) arg) => (:$>$###) - type instance Apply ($>$) l = ($>$$) l - type family ($>) (a :: Nat) (a :: Nat) :: Nat where - ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (:+$) a_0123456789876543210) a_0123456789876543210 - (%$>) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply ($>$) t) t :: Nat) - (%$>) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @(:+$)) (%:+))) sA_0123456789876543210)) - sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T172.ghc84.template b/tests/compile-and-dump/Singletons/T172.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T172.ghc84.template @@ -0,0 +1,31 @@ +Singletons/T172.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [d| ($>) :: Nat -> Nat -> Nat + ($>) = (+) |] + ======> + type ($>@#@$$$) (t :: Nat) (t :: Nat) = ($>) t t + instance SuppressUnusedWarnings ($>@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$>@#@$$###)) GHC.Tuple.()) + data ($>@#@$$) (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. SameKind (Apply (($>@#@$$) l) arg) (($>@#@$$$) l arg) => + (:$>@#@$$###) + type instance Apply (($>@#@$$) l) l = ($>) l l + instance SuppressUnusedWarnings ($>@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$>@#@$###)) GHC.Tuple.()) + data ($>@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => + (:$>@#@$###) + type instance Apply ($>@#@$) l = ($>@#@$$) l + type family ($>) (a :: Nat) (a :: Nat) :: Nat where + ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 + (%$>) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Nat) + (%$>) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) sA_0123456789876543210)) + sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T175.ghc82.template b/tests/compile-and-dump/Singletons/T175.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T175.ghc82.template +++ /dev/null @@ -1,45 +0,0 @@ -Singletons/T175.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| quux2 :: Bar2 a => a - quux2 = baz - - class Foo a where - baz :: a - class Foo a => Bar1 a where - quux1 :: a - quux1 = baz - class Foo a => Bar2 a |] - ======> - class Foo a where - baz :: a - class Foo a => Bar1 a where - quux1 :: a - quux1 = baz - class Foo a => Bar2 a - quux2 :: Bar2 a => a - quux2 = baz - type Quux2Sym0 = Quux2 - type family Quux2 :: a where - = BazSym0 - type BazSym0 = Baz - class PFoo (a :: GHC.Types.Type) where - type Baz :: a - type Quux1Sym0 = Quux1 - type family Quux1_0123456789876543210 :: a where - = BazSym0 - type Quux1_0123456789876543210Sym0 = Quux1_0123456789876543210 - class PFoo a => PBar1 (a :: GHC.Types.Type) where - type Quux1 :: a - type Quux1 = Quux1_0123456789876543210Sym0 - class PFoo a => PBar2 (a :: GHC.Types.Type) - sQuux2 :: SBar2 a => Sing (Quux2Sym0 :: a) - sQuux2 = sBaz - class SFoo a where - sBaz :: Sing (BazSym0 :: a) - class SFoo a => SBar1 a where - sQuux1 :: Sing (Quux1Sym0 :: a) - default sQuux1 :: - (Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0 => - Sing (Quux1Sym0 :: a) - sQuux1 = sBaz - class SFoo a => SBar2 a diff --git a/tests/compile-and-dump/Singletons/T175.ghc84.template b/tests/compile-and-dump/Singletons/T175.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T175.ghc84.template @@ -0,0 +1,45 @@ +Singletons/T175.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| quux2 :: Bar2 a => a + quux2 = baz + + class Foo a where + baz :: a + class Foo a => Bar1 a where + quux1 :: a + quux1 = baz + class Foo a => Bar2 a |] + ======> + class Foo a where + baz :: a + class Foo a => Bar1 a where + quux1 :: a + quux1 = baz + class Foo a => Bar2 a + quux2 :: Bar2 a => a + quux2 = baz + type Quux2Sym0 = Quux2 + type family Quux2 :: a where + Quux2 = BazSym0 + type BazSym0 = Baz + class PFoo (a :: GHC.Types.Type) where + type Baz :: a + type Quux1Sym0 = Quux1 + type family Quux1_0123456789876543210 :: a where + Quux1_0123456789876543210 = BazSym0 + type Quux1_0123456789876543210Sym0 = Quux1_0123456789876543210 + class PFoo a => PBar1 (a :: GHC.Types.Type) where + type Quux1 :: a + type Quux1 = Quux1_0123456789876543210Sym0 + class PFoo a => PBar2 (a :: GHC.Types.Type) + sQuux2 :: SBar2 a => Sing (Quux2Sym0 :: a) + sQuux2 = sBaz + class SFoo a where + sBaz :: Sing (BazSym0 :: a) + class SFoo a => SBar1 a where + sQuux1 :: Sing (Quux1Sym0 :: a) + default sQuux1 :: + (Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0 => + Sing (Quux1Sym0 :: a) + sQuux1 = sBaz + class SFoo a => SBar2 a diff --git a/tests/compile-and-dump/Singletons/T176.ghc82.template b/tests/compile-and-dump/Singletons/T176.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T176.ghc82.template +++ /dev/null @@ -1,137 +0,0 @@ -Singletons/T176.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| quux1 :: Foo1 a => a -> a - quux1 x = x `bar1` \ _ -> baz1 - quux2 :: Foo2 a => a -> a - quux2 x = x `bar2` baz2 - - class Foo1 a where - bar1 :: a -> (a -> b) -> b - baz1 :: a - class Foo2 a where - bar2 :: a -> b -> b - baz2 :: a |] - ======> - class Foo1 a where - bar1 :: a -> (a -> b) -> b - baz1 :: a - quux1 :: Foo1 a => a -> a - quux1 x = (x `bar1` (\ _ -> baz1)) - class Foo2 a where - bar2 :: a -> b -> b - baz2 :: a - quux2 :: Foo2 a => a -> a - quux2 x = (x `bar2` baz2) - type family Case_0123456789876543210 x arg_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 _z_0123456789876543210 = Baz1Sym0 - type family Lambda_0123456789876543210 x t where - Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Quux2Sym1 (t :: a0123456789876543210) = Quux2 t - instance SuppressUnusedWarnings Quux2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Quux2Sym0KindInference) GHC.Tuple.()) - data Quux2Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => - Quux2Sym0KindInference - type instance Apply Quux2Sym0 l = Quux2 l - type Quux1Sym1 (t :: a0123456789876543210) = Quux1 t - instance SuppressUnusedWarnings Quux1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Quux1Sym0KindInference) GHC.Tuple.()) - data Quux1Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => - Quux1Sym0KindInference - type instance Apply Quux1Sym0 l = Quux1 l - type family Quux2 (a :: a) :: a where - Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 - type family Quux1 (a :: a) :: a where - Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) - type Bar1Sym2 (t :: a0123456789876543210) (t :: TyFun a0123456789876543210 b0123456789876543210 - -> Type) = - Bar1 t t - instance SuppressUnusedWarnings Bar1Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Bar1Sym1KindInference) GHC.Tuple.()) - data Bar1Sym1 (l :: a0123456789876543210) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> Type) b0123456789876543210) - = forall arg. SameKind (Apply (Bar1Sym1 l) arg) (Bar1Sym2 l arg) => - Bar1Sym1KindInference - type instance Apply (Bar1Sym1 l) l = Bar1 l l - instance SuppressUnusedWarnings Bar1Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Bar1Sym0KindInference) GHC.Tuple.()) - data Bar1Sym0 (l :: TyFun a0123456789876543210 (TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> Type) b0123456789876543210 - -> Type)) - = forall arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => - Bar1Sym0KindInference - type instance Apply Bar1Sym0 l = Bar1Sym1 l - type Baz1Sym0 = Baz1 - class PFoo1 (a :: Type) where - type Bar1 (arg :: a) (arg :: TyFun a b -> Type) :: b - type Baz1 :: a - type Bar2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Bar2 t t - instance SuppressUnusedWarnings Bar2Sym1 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Bar2Sym1KindInference) GHC.Tuple.()) - data Bar2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply (Bar2Sym1 l) arg) (Bar2Sym2 l arg) => - Bar2Sym1KindInference - type instance Apply (Bar2Sym1 l) l = Bar2 l l - instance SuppressUnusedWarnings Bar2Sym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) Bar2Sym0KindInference) GHC.Tuple.()) - data Bar2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 - -> Type)) - = forall arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => - Bar2Sym0KindInference - type instance Apply Bar2Sym0 l = Bar2Sym1 l - type Baz2Sym0 = Baz2 - class PFoo2 (a :: Type) where - type Bar2 (arg :: a) (arg :: b) :: b - type Baz2 :: a - sQuux2 :: - forall (t :: a). SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a) - sQuux1 :: - forall (t :: a). SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a) - sQuux2 (sX :: Sing x) - = (applySing ((applySing ((singFun2 @Bar2Sym0) sBar2)) sX)) sBaz2 - sQuux1 (sX :: Sing x) - = (applySing ((applySing ((singFun2 @Bar1Sym0) sBar1)) sX)) - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sBaz1 } :: - Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) })) - class SFoo1 a where - sBar1 :: - forall (t :: a) (t :: TyFun a b -> Type). - Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b) - sBaz1 :: Sing (Baz1Sym0 :: a) - class SFoo2 a where - sBar2 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b) - sBaz2 :: Sing (Baz2Sym0 :: a) diff --git a/tests/compile-and-dump/Singletons/T176.ghc84.template b/tests/compile-and-dump/Singletons/T176.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T176.ghc84.template @@ -0,0 +1,137 @@ +Singletons/T176.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| quux1 :: Foo1 a => a -> a + quux1 x = x `bar1` \ _ -> baz1 + quux2 :: Foo2 a => a -> a + quux2 x = x `bar2` baz2 + + class Foo1 a where + bar1 :: a -> (a -> b) -> b + baz1 :: a + class Foo2 a where + bar2 :: a -> b -> b + baz2 :: a |] + ======> + class Foo1 a where + bar1 :: a -> (a -> b) -> b + baz1 :: a + quux1 :: Foo1 a => a -> a + quux1 x = (x `bar1` (\ _ -> baz1)) + class Foo2 a where + bar2 :: a -> b -> b + baz2 :: a + quux2 :: Foo2 a => a -> a + quux2 x = (x `bar2` baz2) + type family Case_0123456789876543210 x arg_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 _ = Baz1Sym0 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym2 t t = + Lambda_0123456789876543210 t t + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym1 l l + = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => + Lambda_0123456789876543210Sym1KindInference + type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Lambda_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0KindInference + type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l + type Quux2Sym1 (t :: a0123456789876543210) = Quux2 t + instance SuppressUnusedWarnings Quux2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Quux2Sym0KindInference) GHC.Tuple.()) + data Quux2Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => + Quux2Sym0KindInference + type instance Apply Quux2Sym0 l = Quux2 l + type Quux1Sym1 (t :: a0123456789876543210) = Quux1 t + instance SuppressUnusedWarnings Quux1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Quux1Sym0KindInference) GHC.Tuple.()) + data Quux1Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => + Quux1Sym0KindInference + type instance Apply Quux1Sym0 l = Quux1 l + type family Quux2 (a :: a) :: a where + Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 + type family Quux1 (a :: a) :: a where + Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) + type Bar1Sym2 (t :: a0123456789876543210) (t :: TyFun a0123456789876543210 b0123456789876543210 + -> Type) = + Bar1 t t + instance SuppressUnusedWarnings Bar1Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Bar1Sym1KindInference) GHC.Tuple.()) + data Bar1Sym1 (l :: a0123456789876543210) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> Type) b0123456789876543210) + = forall arg. SameKind (Apply (Bar1Sym1 l) arg) (Bar1Sym2 l arg) => + Bar1Sym1KindInference + type instance Apply (Bar1Sym1 l) l = Bar1 l l + instance SuppressUnusedWarnings Bar1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Bar1Sym0KindInference) GHC.Tuple.()) + data Bar1Sym0 (l :: TyFun a0123456789876543210 (TyFun (TyFun a0123456789876543210 b0123456789876543210 + -> Type) b0123456789876543210 + -> Type)) + = forall arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => + Bar1Sym0KindInference + type instance Apply Bar1Sym0 l = Bar1Sym1 l + type Baz1Sym0 = Baz1 + class PFoo1 (a :: Type) where + type Bar1 (arg :: a) (arg :: TyFun a b -> Type) :: b + type Baz1 :: a + type Bar2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + Bar2 t t + instance SuppressUnusedWarnings Bar2Sym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Bar2Sym1KindInference) GHC.Tuple.()) + data Bar2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210) + = forall arg. SameKind (Apply (Bar2Sym1 l) arg) (Bar2Sym2 l arg) => + Bar2Sym1KindInference + type instance Apply (Bar2Sym1 l) l = Bar2 l l + instance SuppressUnusedWarnings Bar2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) Bar2Sym0KindInference) GHC.Tuple.()) + data Bar2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210 + -> Type)) + = forall arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => + Bar2Sym0KindInference + type instance Apply Bar2Sym0 l = Bar2Sym1 l + type Baz2Sym0 = Baz2 + class PFoo2 (a :: Type) where + type Bar2 (arg :: a) (arg :: b) :: b + type Baz2 :: a + sQuux2 :: + forall (t :: a). SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a) + sQuux1 :: + forall (t :: a). SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a) + sQuux2 (sX :: Sing x) + = (applySing ((applySing ((singFun2 @Bar2Sym0) sBar2)) sX)) sBaz2 + sQuux1 (sX :: Sing x) + = (applySing ((applySing ((singFun2 @Bar1Sym0) sBar1)) sX)) + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + _ :: Sing arg_0123456789876543210 + -> case sArg_0123456789876543210 of { _ -> sBaz1 } :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) })) + class SFoo1 a where + sBar1 :: + forall (t :: a) (t :: TyFun a b -> Type). + Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b) + sBaz1 :: Sing (Baz1Sym0 :: a) + class SFoo2 a where + sBar2 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b) + sBaz2 :: Sing (Baz2Sym0 :: a) diff --git a/tests/compile-and-dump/Singletons/T178.ghc82.template b/tests/compile-and-dump/Singletons/T178.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T178.ghc82.template +++ /dev/null @@ -1,161 +0,0 @@ -Singletons/T178.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| empty :: U - empty = [] - - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] |] - ======> - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] - empty :: U - empty = [] - type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where - Equals_0123456789876543210 Str Str = TrueSym0 - Equals_0123456789876543210 Opt Opt = TrueSym0 - Equals_0123456789876543210 Many Many = TrueSym0 - Equals_0123456789876543210 (a :: Occ) (b :: Occ) = FalseSym0 - instance PEq Occ where - type (:==) (a :: Occ) (b :: Occ) = Equals_0123456789876543210 a b - type StrSym0 = Str - type OptSym0 = Opt - type ManySym0 = Many - type EmptySym0 = Empty - type family Empty :: [(Symbol, Occ)] where - = '[] - type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where - Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Str Opt = LTSym0 - Compare_0123456789876543210 Str Many = LTSym0 - Compare_0123456789876543210 Opt Str = GTSym0 - Compare_0123456789876543210 Opt Many = LTSym0 - Compare_0123456789876543210 Many Str = GTSym0 - Compare_0123456789876543210 Many Opt = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Occ) (t :: Occ) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Occ) (l :: TyFun Occ Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Occ (TyFun Occ Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Occ where - type Compare (a :: Occ) (a :: Occ) = Apply (Apply Compare_0123456789876543210Sym0 a) a - sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)]) - sEmpty = SNil - data instance Sing (z :: Occ) - = z ~ Str => SStr | z ~ Opt => SOpt | z ~ Many => SMany - type SOcc = (Sing :: Occ -> GHC.Types.Type) - instance SingKind Occ where - type Demote Occ = Occ - fromSing SStr = Str - fromSing SOpt = Opt - fromSing SMany = Many - toSing Str = SomeSing SStr - toSing Opt = SomeSing SOpt - toSing Many = SomeSing SMany - instance SEq Occ where - (%:==) SStr SStr = STrue - (%:==) SStr SOpt = SFalse - (%:==) SStr SMany = SFalse - (%:==) SOpt SStr = SFalse - (%:==) SOpt SOpt = STrue - (%:==) SOpt SMany = SFalse - (%:==) SMany SStr = SFalse - (%:==) SMany SOpt = SFalse - (%:==) SMany SMany = STrue - instance SDecide Occ where - (%~) SStr SStr = Proved Refl - (%~) SStr SOpt - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SStr SMany - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SOpt SStr - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SOpt SOpt = Proved Refl - (%~) SOpt SMany - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SMany SStr - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SMany SOpt - = Disproved - (\ x - -> case x of { - _ -> error "Empty case reached -- this should be impossible" }) - (%~) SMany SMany = Proved Refl - instance SOrd Occ where - sCompare :: - forall (t1 :: Occ) (t2 :: Occ). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ (TyFun Occ Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1 :: TyFun Occ Ordering - -> GHC.Types.Type) t2 :: Ordering) - sCompare SStr SStr - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SOpt SOpt - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SMany SMany - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SStr SOpt = SLT - sCompare SStr SMany = SLT - sCompare SOpt SStr = SGT - sCompare SOpt SMany = SLT - sCompare SMany SStr = SGT - sCompare SMany SOpt = SGT - instance SingI Str where - sing = SStr - instance SingI Opt where - sing = SOpt - instance SingI Many where - sing = SMany diff --git a/tests/compile-and-dump/Singletons/T178.ghc84.template b/tests/compile-and-dump/Singletons/T178.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T178.ghc84.template @@ -0,0 +1,217 @@ +Singletons/T178.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| empty :: U + empty = [] + + data Occ + = Str | Opt | Many + deriving (Eq, Ord, Show) + type U = [(Symbol, Occ)] |] + ======> + data Occ + = Str | Opt | Many + deriving (Eq, Ord, Show) + type U = [(Symbol, Occ)] + empty :: U + empty = [] + type StrSym0 = Str + type OptSym0 = Opt + type ManySym0 = Many + type EmptySym0 = Empty + type family Empty :: [(Symbol, Occ)] where + Empty = '[] + type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where + Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Str Opt = LTSym0 + Compare_0123456789876543210 Str Many = LTSym0 + Compare_0123456789876543210 Opt Str = GTSym0 + Compare_0123456789876543210 Opt Many = LTSym0 + Compare_0123456789876543210 Many Str = GTSym0 + Compare_0123456789876543210 Many Opt = GTSym0 + type Compare_0123456789876543210Sym2 (t :: Occ) (t :: Occ) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Occ) (l :: TyFun Occ Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Occ (TyFun Occ Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Occ where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: Nat) (t :: Occ) (t :: Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: Nat) (l :: Occ) (l :: TyFun Symbol Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Occ (TyFun Symbol Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Occ (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow Occ where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where + Equals_0123456789876543210 Str Str = TrueSym0 + Equals_0123456789876543210 Opt Opt = TrueSym0 + Equals_0123456789876543210 Many Many = TrueSym0 + Equals_0123456789876543210 (_ :: Occ) (_ :: Occ) = FalseSym0 + instance PEq Occ where + type (==) a b = Equals_0123456789876543210 a b + sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)]) + sEmpty = Data.Singletons.Prelude.Instances.SNil + data instance Sing (z :: Occ) + where + SStr :: Sing Str + SOpt :: Sing Opt + SMany :: Sing Many + type SOcc = (Sing :: Occ -> GHC.Types.Type) + instance SingKind Occ where + type Demote Occ = Occ + fromSing SStr = Str + fromSing SOpt = Opt + fromSing SMany = Many + toSing Str = SomeSing SStr + toSing Opt = SomeSing SOpt + toSing Many = SomeSing SMany + instance SOrd Occ where + sCompare :: + forall (t1 :: Occ) (t2 :: Occ). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ (TyFun Occ Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare SStr SStr + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SOpt SOpt + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SMany SMany + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SStr SOpt = SLT + sCompare SStr SMany = SLT + sCompare SOpt SStr = SGT + sCompare SOpt SMany = SLT + sCompare SMany SStr = SGT + sCompare SMany SOpt = SGT + instance SShow Occ where + sShowsPrec :: + forall (t1 :: Nat) (t2 :: Occ) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Nat (TyFun Occ (TyFun Symbol Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SStr + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Str"))) + sA_0123456789876543210 + sShowsPrec + _ + SOpt + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Opt"))) + sA_0123456789876543210 + sShowsPrec + _ + SMany + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Many"))) + sA_0123456789876543210 + instance SEq Occ where + (%==) SStr SStr = STrue + (%==) SStr SOpt = SFalse + (%==) SStr SMany = SFalse + (%==) SOpt SStr = SFalse + (%==) SOpt SOpt = STrue + (%==) SOpt SMany = SFalse + (%==) SMany SStr = SFalse + (%==) SMany SOpt = SFalse + (%==) SMany SMany = STrue + instance SDecide Occ where + (%~) SStr SStr = Proved Refl + (%~) SStr SOpt = Disproved (\ x -> case x of) + (%~) SStr SMany = Disproved (\ x -> case x of) + (%~) SOpt SStr = Disproved (\ x -> case x of) + (%~) SOpt SOpt = Proved Refl + (%~) SOpt SMany = Disproved (\ x -> case x of) + (%~) SMany SStr = Disproved (\ x -> case x of) + (%~) SMany SOpt = Disproved (\ x -> case x of) + (%~) SMany SMany = Proved Refl + instance Data.Singletons.ShowSing.ShowSing Occ where + Data.Singletons.ShowSing.showsSingPrec _ SStr = showString "SStr" + Data.Singletons.ShowSing.showsSingPrec _ SOpt = showString "SOpt" + Data.Singletons.ShowSing.showsSingPrec _ SMany = showString "SMany" + instance Show (Sing (z :: Occ)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI Str where + sing = SStr + instance SingI Opt where + sing = SOpt + instance SingI Many where + sing = SMany diff --git a/tests/compile-and-dump/Singletons/T178.hs b/tests/compile-and-dump/Singletons/T178.hs --- a/tests/compile-and-dump/Singletons/T178.hs +++ b/tests/compile-and-dump/Singletons/T178.hs @@ -2,7 +2,6 @@ import GHC.TypeLits import Data.Singletons.TH -import Data.Singletons.Prelude $(singletons [d| diff --git a/tests/compile-and-dump/Singletons/T187.ghc84.template b/tests/compile-and-dump/Singletons/T187.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T187.ghc84.template @@ -0,0 +1,58 @@ +Singletons/T187.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Empty + + deriving instance Ord Empty + deriving instance Eq Empty |] + ======> + data Empty + deriving instance Eq Empty + deriving instance Ord Empty + type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where + Compare_0123456789876543210 _ _ = EQSym0 + type Compare_0123456789876543210Sym2 (t :: Empty) (t :: Empty) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Empty) (l :: TyFun Empty Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun Empty (TyFun Empty Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd Empty where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where + Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 + instance PEq Empty where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: Empty) + type SEmpty = (Sing :: Empty -> GHC.Types.Type) + instance SingKind Empty where + type Demote Empty = Empty + fromSing x = case x of + toSing x = SomeSing (case x of) + instance SOrd Empty where + sCompare :: + forall (t1 :: Empty) (t2 :: Empty). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty (TyFun Empty Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare _ _ = SEQ + instance SEq Empty where + (%==) _ _ = STrue + instance SDecide Empty where + (%~) x _ = Proved (case x of) diff --git a/tests/compile-and-dump/Singletons/T187.hs b/tests/compile-and-dump/Singletons/T187.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T187.hs @@ -0,0 +1,8 @@ +module T187 where + +import Data.Singletons.TH + +$(singletons[d| data Empty + deriving instance Eq Empty + deriving instance Ord Empty + |]) diff --git a/tests/compile-and-dump/Singletons/T190.ghc84.template b/tests/compile-and-dump/Singletons/T190.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T190.ghc84.template @@ -0,0 +1,194 @@ +Singletons/T190.hs:0:0:: Splicing declarations + singletons + [d| data T + = T + deriving (Eq, Ord, Enum, Bounded, Show) |] + ======> + data T + = T + deriving (Eq, Ord, Enum, Bounded, Show) + type TSym0 = T + type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where + Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + type Compare_0123456789876543210Sym2 (t :: T) (t :: T) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: T) (l :: TyFun T Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun T (TyFun T Ordering + -> GHC.Types.Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd T where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n True = TSym0 + Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789876543210 t + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat T) + = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0KindInference + type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l + type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where + FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0 + type FromEnum_0123456789876543210Sym1 (t :: T) = + FromEnum_0123456789876543210 t + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data FromEnum_0123456789876543210Sym0 (l :: TyFun T GHC.Types.Nat) + = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0KindInference + type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l + instance PEnum T where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + type family MinBound_0123456789876543210 :: T where + MinBound_0123456789876543210 = TSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: T where + MaxBound_0123456789876543210 = TSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded T where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: T) (t :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 t t t + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => + ShowsPrec_0123456789876543210Sym2KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => + ShowsPrec_0123456789876543210Sym1KindInference + type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0KindInference + type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l + instance PShow T where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where + Equals_0123456789876543210 T T = TrueSym0 + Equals_0123456789876543210 (_ :: T) (_ :: T) = FalseSym0 + instance PEq T where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: T) where ST :: Sing T + type ST = (Sing :: T -> GHC.Types.Type) + instance SingKind T where + type Demote T = T + fromSing ST = T + toSing T = SomeSing ST + instance SOrd T where + sCompare :: + forall (t1 :: T) (t2 :: T). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun T (TyFun T Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) + sCompare ST ST + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + instance SEnum T where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat T + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: T). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun T GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> ST + SFalse -> sError (sing :: Sing "toEnum: bad argument") :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum ST + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + instance SBounded T where + sMinBound :: Sing (MinBoundSym0 :: T) + sMaxBound :: Sing (MaxBoundSym0 :: T) + sMinBound = ST + sMaxBound = ST + instance SShow T where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: T) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + ST + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "T"))) + sA_0123456789876543210 + instance SEq T where + (%==) ST ST = STrue + instance SDecide T where + (%~) ST ST = Proved Refl + instance Data.Singletons.ShowSing.ShowSing T where + Data.Singletons.ShowSing.showsSingPrec _ ST = showString "ST" + instance Show (Sing (z :: T)) where + showsPrec = Data.Singletons.ShowSing.showsSingPrec + instance SingI T where + sing = ST diff --git a/tests/compile-and-dump/Singletons/T190.hs b/tests/compile-and-dump/Singletons/T190.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T190.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +module T190 where + +import Data.Singletons.TH + +$(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |]) diff --git a/tests/compile-and-dump/Singletons/T197.ghc84.template b/tests/compile-and-dump/Singletons/T197.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197.ghc84.template @@ -0,0 +1,33 @@ +Singletons/T197.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 5 $$: + + ($$:) :: Bool -> Bool -> Bool + _ $$: _ = False |] + ======> + infixl 5 $$: + ($$:) :: Bool -> Bool -> Bool + ($$:) _ _ = False + type ($$:@#@$$$) (t :: Bool) (t :: Bool) = ($$:) t t + instance SuppressUnusedWarnings ($$:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.()) + data ($$:@#@$$) (l :: Bool) (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) => + (:$$:@#@$$###) + type instance Apply (($$:@#@$$) l) l = ($$:) l l + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.()) + data ($$:@#@$) (l :: TyFun Bool (TyFun Bool Bool + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + (:$$:@#@$###) + type instance Apply ($$:@#@$) l = ($$:@#@$$) l + type family ($$:) (a :: Bool) (a :: Bool) :: Bool where + ($$:) _ _ = FalseSym0 + infixl 5 %$$: + (%$$:) :: + forall (t :: Bool) (t :: Bool). + Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: Bool) + (%$$:) _ _ = SFalse diff --git a/tests/compile-and-dump/Singletons/T197.hs b/tests/compile-and-dump/Singletons/T197.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197.hs @@ -0,0 +1,10 @@ +module T197 where + +import Data.Singletons.Prelude +import Data.Singletons.TH + +$(singletons [d| + infixl 5 $$: + ($$:) :: Bool -> Bool -> Bool + _ $$: _ = False + |]) diff --git a/tests/compile-and-dump/Singletons/T197b.ghc84.template b/tests/compile-and-dump/Singletons/T197b.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197b.ghc84.template @@ -0,0 +1,81 @@ +Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixr 9 `Pair`, `MkPair` + + data a :*: b = a :*: b + data Pair a b = MkPair a b |] + ======> + data (:*:) a b = a :*: b + data Pair a b = MkPair a b + infixr 9 `Pair` + infixr 9 `MkPair` + type (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) = + (:*:) t t + instance SuppressUnusedWarnings (:*:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) + data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => + (::*:@#@$$###) + type instance Apply ((:*:@#@$$) l) l = (:*:) l l + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) + data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (::*:@#@$###) + type instance Apply (:*:@#@$) l = (:*:@#@$$) l + type MkPairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = + MkPair t t + instance SuppressUnusedWarnings MkPairSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkPairSym1KindInference) GHC.Tuple.()) + data MkPairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply (MkPairSym1 l) arg) (MkPairSym2 l arg) => + MkPairSym1KindInference + type instance Apply (MkPairSym1 l) l = MkPair l l + instance SuppressUnusedWarnings MkPairSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkPairSym0KindInference) GHC.Tuple.()) + data MkPairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => + MkPairSym0KindInference + type instance Apply MkPairSym0 l = MkPairSym1 l + infixr 9 `SMkPair` + infixr 9 `SPair` + data instance Sing (z :: (:*:) a b) + where + (:%*:) :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) + type %:*: = (Sing :: (:*:) a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind ((:*:) a b) where + type Demote ((:*:) a b) = (:*:) (Demote a) (Demote b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + toSing ((:*:) (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%*:) c) c) } + data instance Sing (z :: Pair a b) + where + SMkPair :: forall (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (MkPair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SMkPair b b) = (MkPair (fromSing b)) (fromSing b) + toSing (MkPair (b :: Demote a) (b :: Demote b)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing ((SMkPair c) c) } + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: b)) where + sing = ((:%*:) sing) sing + instance (SingI n, SingI n) => + SingI (MkPair (n :: a) (n :: b)) where + sing = (SMkPair sing) sing diff --git a/tests/compile-and-dump/Singletons/T197b.hs b/tests/compile-and-dump/Singletons/T197b.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197b.hs @@ -0,0 +1,10 @@ +module T197b where + +import Data.Singletons.TH + +$(singletons + [d| data a :*: b = a :*: b + + data Pair a b = MkPair a b + infixr 9 `Pair`, `MkPair` + |]) diff --git a/tests/compile-and-dump/Singletons/T200.ghc84.template b/tests/compile-and-dump/Singletons/T200.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T200.ghc84.template @@ -0,0 +1,154 @@ +Singletons/T200.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x $$: y = x :$$: y + (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x <>: y = x :<>: y + + data ErrorMessage + = ErrorMessage :$$: ErrorMessage | + ErrorMessage :<>: ErrorMessage | + EM [Bool] |] + ======> + data ErrorMessage + = ErrorMessage :$$: ErrorMessage | + ErrorMessage :<>: ErrorMessage | + EM [Bool] + ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + ($$:) x y = (x :$$: y) + (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + (<>:) x y = (x :<>: y) + type (:$$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = + (:$$:) t t + instance SuppressUnusedWarnings (:$$:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::$$:@#@$$###)) GHC.Tuple.()) + data (:$$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) + = forall arg. SameKind (Apply ((:$$:@#@$$) l) arg) ((:$$:@#@$$$) l arg) => + (::$$:@#@$$###) + type instance Apply ((:$$:@#@$$) l) l = (:$$:) l l + instance SuppressUnusedWarnings (:$$:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::$$:@#@$###)) GHC.Tuple.()) + data (:$$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => + (::$$:@#@$###) + type instance Apply (:$$:@#@$) l = (:$$:@#@$$) l + type (:<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = + (:<>:) t t + instance SuppressUnusedWarnings (:<>:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::<>:@#@$$###)) GHC.Tuple.()) + data (:<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) + = forall arg. SameKind (Apply ((:<>:@#@$$) l) arg) ((:<>:@#@$$$) l arg) => + (::<>:@#@$$###) + type instance Apply ((:<>:@#@$$) l) l = (:<>:) l l + instance SuppressUnusedWarnings (:<>:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (::<>:@#@$###)) GHC.Tuple.()) + data (:<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => + (::<>:@#@$###) + type instance Apply (:<>:@#@$) l = (:<>:@#@$$) l + type EMSym1 (t :: [Bool]) = EM t + instance SuppressUnusedWarnings EMSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) EMSym0KindInference) GHC.Tuple.()) + data EMSym0 (l :: TyFun [Bool] ErrorMessage) + = forall arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) => + EMSym0KindInference + type instance Apply EMSym0 l = EM l + type (<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = + (<>:) t t + instance SuppressUnusedWarnings (<>:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<>:@#@$$###)) GHC.Tuple.()) + data (<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) + = forall arg. SameKind (Apply ((<>:@#@$$) l) arg) ((<>:@#@$$$) l arg) => + (:<>:@#@$$###) + type instance Apply ((<>:@#@$$) l) l = (<>:) l l + instance SuppressUnusedWarnings (<>:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:<>:@#@$###)) GHC.Tuple.()) + data (<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => + (:<>:@#@$###) + type instance Apply (<>:@#@$) l = (<>:@#@$$) l + type ($$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = + ($$:) t t + instance SuppressUnusedWarnings ($$:@#@$$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.()) + data ($$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) + = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) => + (:$$:@#@$$###) + type instance Apply (($$:@#@$$) l) l = ($$:) l l + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.()) + data ($$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage + -> GHC.Types.Type)) + = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + (:$$:@#@$###) + type instance Apply ($$:@#@$) l = ($$:@#@$$) l + type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where + (<>:) x y = Apply (Apply (:<>:@#@$) x) y + type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where + ($$:) x y = Apply (Apply (:$$:@#@$) x) y + (%<>:) :: + forall (t :: ErrorMessage) (t :: ErrorMessage). + Sing t + -> Sing t -> Sing (Apply (Apply (<>:@#@$) t) t :: ErrorMessage) + (%$$:) :: + forall (t :: ErrorMessage) (t :: ErrorMessage). + Sing t + -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage) + (%<>:) (sX :: Sing x) (sY :: Sing y) + = (applySing ((applySing ((singFun2 @(:<>:@#@$)) (:%<>:))) sX)) sY + (%$$:) (sX :: Sing x) (sY :: Sing y) + = (applySing ((applySing ((singFun2 @(:$$:@#@$)) (:%$$:))) sX)) sY + data instance Sing (z :: ErrorMessage) + where + (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). + (Sing (n :: ErrorMessage)) + -> (Sing (n :: ErrorMessage)) -> Sing ((:$$:) n n) + (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). + (Sing (n :: ErrorMessage)) + -> (Sing (n :: ErrorMessage)) -> Sing ((:<>:) n n) + SEM :: forall (n :: [Bool]). (Sing (n :: [Bool])) -> Sing (EM n) + type SErrorMessage = (Sing :: ErrorMessage -> GHC.Types.Type) + instance SingKind ErrorMessage where + type Demote ErrorMessage = ErrorMessage + fromSing ((:%$$:) b b) = ((:$$:) (fromSing b)) (fromSing b) + fromSing ((:%<>:) b b) = ((:<>:) (fromSing b)) (fromSing b) + fromSing (SEM b) = EM (fromSing b) + toSing + ((:$$:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage)) + (toSing b :: SomeSing ErrorMessage) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%$$:) c) c) } + toSing + ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage)) + (toSing b :: SomeSing ErrorMessage) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (((:%<>:) c) c) } + toSing (EM (b :: Demote [Bool])) + = case toSing b :: SomeSing [Bool] of { + SomeSing c -> SomeSing (SEM c) } + instance (SingI n, SingI n) => + SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where + sing = ((:%$$:) sing) sing + instance (SingI n, SingI n) => + SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where + sing = ((:%<>:) sing) sing + instance SingI n => SingI (EM (n :: [Bool])) where + sing = SEM sing diff --git a/tests/compile-and-dump/Singletons/T200.hs b/tests/compile-and-dump/Singletons/T200.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T200.hs @@ -0,0 +1,15 @@ +module T200 where + +import Data.Singletons.TH + +$(singletons [d| + data ErrorMessage = ErrorMessage :$$: ErrorMessage + | ErrorMessage :<>: ErrorMessage + | EM [Bool] + + ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x $$: y = x :$$: y + + (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x <>: y = x :<>: y + |]) diff --git a/tests/compile-and-dump/Singletons/T206.ghc84.template b/tests/compile-and-dump/Singletons/T206.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T206.ghc84.template diff --git a/tests/compile-and-dump/Singletons/T206.hs b/tests/compile-and-dump/Singletons/T206.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T206.hs @@ -0,0 +1,5 @@ +module T206 where + +import Data.Singletons.Prelude + +x = SCons @Bool @True @'[False] diff --git a/tests/compile-and-dump/Singletons/T209.ghc84.template b/tests/compile-and-dump/Singletons/T209.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T209.ghc84.template @@ -0,0 +1,68 @@ +Singletons/T209.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| m :: a -> b -> Bool -> Bool + m _ _ x = x + + class C a b + data Hm + = Hm + deriving anyclass (C Bool) + + deriving anyclass instance C a a => C a (Maybe a) |] + ======> + class C a b + m :: a -> b -> Bool -> Bool + m _ _ x = x + data Hm + = Hm + deriving anyclass (C Bool) + deriving anyclass instance C a a => C a (Maybe a) + type HmSym0 = Hm + type MSym3 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: Bool) = + M t t t + instance SuppressUnusedWarnings MSym2 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MSym2KindInference) GHC.Tuple.()) + data MSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply (MSym2 l l) arg) (MSym3 l l arg) => + MSym2KindInference + type instance Apply (MSym2 l l) l = M l l l + instance SuppressUnusedWarnings MSym1 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MSym1KindInference) GHC.Tuple.()) + data MSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun Bool Bool + -> GHC.Types.Type)) + = forall arg. SameKind (Apply (MSym1 l) arg) (MSym2 l arg) => + MSym1KindInference + type instance Apply (MSym1 l) l = MSym2 l l + instance SuppressUnusedWarnings MSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MSym0KindInference) GHC.Tuple.()) + data MSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun Bool Bool + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. SameKind (Apply MSym0 arg) (MSym1 arg) => + MSym0KindInference + type instance Apply MSym0 l = MSym1 l + type family M (a :: a) (a :: b) (a :: Bool) :: Bool where + M _ _ x = x + class PC (a :: GHC.Types.Type) (b :: GHC.Types.Type) + instance PC Bool Hm + instance PC a (Maybe a) + sM :: + forall (t :: a) (t :: b) (t :: Bool). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool) + sM _ _ (sX :: Sing x) = sX + data instance Sing (z :: Hm) where SHm :: Sing Hm + type SHm = (Sing :: Hm -> GHC.Types.Type) + instance SingKind Hm where + type Demote Hm = Hm + fromSing SHm = Hm + toSing Hm = SomeSing SHm + class SC a b + instance SC Bool Hm + instance SC a a => SC a (Maybe a) + instance SingI Hm where + sing = SHm diff --git a/tests/compile-and-dump/Singletons/T209.hs b/tests/compile-and-dump/Singletons/T209.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T209.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +module T209 where + +import Data.Singletons.TH + +$(singletons + [d| class C a b where + m :: a -> b -> Bool -> Bool + m _ _ x = x + + data Hm = Hm + deriving anyclass (C Bool) + + deriving anyclass instance C a a => C a (Maybe a) + |]) diff --git a/tests/compile-and-dump/Singletons/T226.ghc84.template b/tests/compile-and-dump/Singletons/T226.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T226.ghc84.template @@ -0,0 +1,6 @@ +Singletons/T226.hs:0:0:: Splicing declarations + singletons [d| class a ~> b |] + ======> + class (~>) a b + class (#~>) (a :: GHC.Types.Type) (b :: GHC.Types.Type) + class (%~>) a b diff --git a/tests/compile-and-dump/Singletons/T226.hs b/tests/compile-and-dump/Singletons/T226.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T226.hs @@ -0,0 +1,5 @@ +module T226 where + +import Data.Singletons.TH + +$(singletons [d| class a ~> b |]) diff --git a/tests/compile-and-dump/Singletons/T229.ghc84.template b/tests/compile-and-dump/Singletons/T229.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T229.ghc84.template @@ -0,0 +1,20 @@ +Singletons/T229.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| ___foo :: Bool -> Bool + ___foo _ = True |] + ======> + ___foo :: Bool -> Bool + ___foo _ = True + type US___fooSym1 (t :: Bool) = US___foo t + instance SuppressUnusedWarnings US___fooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) US___fooSym0KindInference) GHC.Tuple.()) + data US___fooSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => + US___fooSym0KindInference + type instance Apply US___fooSym0 l = US___foo l + type family US___foo (a :: Bool) :: Bool where + US___foo _ = TrueSym0 + ___sfoo :: + forall (t :: Bool). Sing t -> Sing (Apply US___fooSym0 t :: Bool) + ___sfoo _ = STrue diff --git a/tests/compile-and-dump/Singletons/T229.hs b/tests/compile-and-dump/Singletons/T229.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T229.hs @@ -0,0 +1,6 @@ +module T229 where + +import Data.Singletons.TH + +$(singletons [d| ___foo :: Bool -> Bool + ___foo _ = True |]) diff --git a/tests/compile-and-dump/Singletons/T249.ghc84.template b/tests/compile-and-dump/Singletons/T249.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T249.ghc84.template @@ -0,0 +1,69 @@ +Singletons/T249.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo1 a = MkFoo1 a + data Foo2 a where MkFoo2 :: x -> Foo2 x + data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |] + ======> + data Foo1 a = MkFoo1 a + data Foo2 a where MkFoo2 :: x -> Foo2 x + data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x + type MkFoo1Sym1 (t :: a0123456789876543210) = MkFoo1 t + instance SuppressUnusedWarnings MkFoo1Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo1Sym0KindInference) GHC.Tuple.()) + data MkFoo1Sym0 (l :: TyFun a0123456789876543210 (Foo1 a0123456789876543210)) + = forall arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => + MkFoo1Sym0KindInference + type instance Apply MkFoo1Sym0 l = MkFoo1 l + type MkFoo2Sym1 (t :: x0123456789876543210) = MkFoo2 t + instance SuppressUnusedWarnings MkFoo2Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo2Sym0KindInference) GHC.Tuple.()) + data MkFoo2Sym0 (l :: TyFun x0123456789876543210 (Foo2 a0123456789876543210)) + = forall arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => + MkFoo2Sym0KindInference + type instance Apply MkFoo2Sym0 l = MkFoo2 l + type MkFoo3Sym1 (t :: x0123456789876543210) = MkFoo3 t + instance SuppressUnusedWarnings MkFoo3Sym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.()) + data MkFoo3Sym0 (l :: TyFun x0123456789876543210 (Foo3 a0123456789876543210)) + = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => + MkFoo3Sym0KindInference + type instance Apply MkFoo3Sym0 l = MkFoo3 l + data instance Sing (z :: Foo1 a) + where + SMkFoo1 :: forall (n :: a). (Sing (n :: a)) -> Sing (MkFoo1 n) + type SFoo1 = (Sing :: Foo1 a -> Type) + instance SingKind a => SingKind (Foo1 a) where + type Demote (Foo1 a) = Foo1 (Demote a) + fromSing (SMkFoo1 b) = MkFoo1 (fromSing b) + toSing (MkFoo1 (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SMkFoo1 c) } + data instance Sing (z :: Foo2 a) + where + SMkFoo2 :: forall (n :: x). (Sing (n :: x)) -> Sing (MkFoo2 n) + type SFoo2 = (Sing :: Foo2 a -> Type) + instance SingKind a => SingKind (Foo2 a) where + type Demote (Foo2 a) = Foo2 (Demote a) + fromSing (SMkFoo2 b) = MkFoo2 (fromSing b) + toSing (MkFoo2 (b :: Demote x)) + = case toSing b :: SomeSing x of { + SomeSing c -> SomeSing (SMkFoo2 c) } + data instance Sing (z :: Foo3 a) + where + SMkFoo3 :: forall (n :: x). (Sing (n :: x)) -> Sing (MkFoo3 n) + type SFoo3 = (Sing :: Foo3 a -> Type) + instance SingKind a => SingKind (Foo3 a) where + type Demote (Foo3 a) = Foo3 (Demote a) + fromSing (SMkFoo3 b) = MkFoo3 (fromSing b) + toSing (MkFoo3 (b :: Demote x)) + = case toSing b :: SomeSing x of { + SomeSing c -> SomeSing (SMkFoo3 c) } + instance SingI n => SingI (MkFoo1 (n :: a)) where + sing = SMkFoo1 sing + instance SingI n => SingI (MkFoo2 (n :: x)) where + sing = SMkFoo2 sing + instance SingI n => SingI (MkFoo3 (n :: x)) where + sing = SMkFoo3 sing diff --git a/tests/compile-and-dump/Singletons/T249.hs b/tests/compile-and-dump/Singletons/T249.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T249.hs @@ -0,0 +1,12 @@ +module T249 where + +import Data.Kind +import Data.Singletons.TH + +$(singletons + [d| data Foo1 a = MkFoo1 a + data Foo2 a where + MkFoo2 :: x -> Foo2 x + data Foo3 a where + MkFoo3 :: forall x. x -> Foo3 x + |]) diff --git a/tests/compile-and-dump/Singletons/T271.ghc84.template b/tests/compile-and-dump/Singletons/T271.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T271.ghc84.template @@ -0,0 +1,179 @@ +Singletons/T271.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| newtype Constant (a :: Type) (b :: Type) + = Constant a + deriving (Eq, Ord) + data Identity :: Type -> Type + where Identity :: a -> Identity a + deriving (Eq, Ord) |] + ======> + newtype Constant (a :: Type) (b :: Type) + = Constant a + deriving (Eq, Ord) + data Identity :: Type -> Type + where Identity :: a -> Identity a + deriving (Eq, Ord) + type ConstantSym1 (t :: a0123456789876543210) = Constant t + instance SuppressUnusedWarnings ConstantSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) ConstantSym0KindInference) GHC.Tuple.()) + data ConstantSym0 (l :: TyFun a0123456789876543210 (Constant a0123456789876543210 b0123456789876543210)) + = forall arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => + ConstantSym0KindInference + type instance Apply ConstantSym0 l = Constant l + type IdentitySym1 (t :: a0123456789876543210) = Identity t + instance SuppressUnusedWarnings IdentitySym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) IdentitySym0KindInference) GHC.Tuple.()) + data IdentitySym0 (l :: TyFun a0123456789876543210 (Identity a0123456789876543210)) + = forall arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => + IdentitySym0KindInference + type instance Apply IdentitySym0 l = Identity l + type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where + Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + type Compare_0123456789876543210Sym2 (t :: Constant a0123456789876543210 b0123456789876543210) (t :: Constant a0123456789876543210 b0123456789876543210) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Constant a0123456789876543210 b0123456789876543210) (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) (TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering + -> Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd (Constant a b) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where + Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + type Compare_0123456789876543210Sym2 (t :: Identity a0123456789876543210) (t :: Identity a0123456789876543210) = + Compare_0123456789876543210 t t + instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym1 (l :: Identity a0123456789876543210) (l :: TyFun (Identity a0123456789876543210) Ordering) + = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => + Compare_0123456789876543210Sym1KindInference + type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Compare_0123456789876543210Sym0 (l :: TyFun (Identity a0123456789876543210) (TyFun (Identity a0123456789876543210) Ordering + -> Type)) + = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0KindInference + type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l + instance POrd (Identity a) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where + Equals_0123456789876543210 (Constant a) (Constant b) = (==) a b + Equals_0123456789876543210 (_ :: Constant a b) (_ :: Constant a b) = FalseSym0 + instance PEq (Constant a b) where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: Identity a) (b :: Identity a) :: Bool where + Equals_0123456789876543210 (Identity a) (Identity b) = (==) a b + Equals_0123456789876543210 (_ :: Identity a) (_ :: Identity a) = FalseSym0 + instance PEq (Identity a) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing (z :: Constant a b) + where + SConstant :: forall (n :: a). (Sing (n :: a)) -> Sing (Constant n) + type SConstant = (Sing :: Constant a b -> Type) + instance (SingKind a, SingKind b) => SingKind (Constant a b) where + type Demote (Constant a b) = Constant (Demote a) (Demote b) + fromSing (SConstant b) = Constant (fromSing b) + toSing (Constant (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SConstant c) } + data instance Sing (z :: Identity a) + where + SIdentity :: forall (n :: a). (Sing (n :: a)) -> Sing (Identity n) + type SIdentity = (Sing :: Identity a -> Type) + instance SingKind a => SingKind (Identity a) where + type Demote (Identity a) = Identity (Demote a) + fromSing (SIdentity b) = Identity (fromSing b) + toSing (Identity (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SIdentity c) } + instance SOrd a => SOrd (Constant a b) where + sCompare :: + forall (t1 :: Constant a b) (t2 :: Constant a b). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Constant a b) (TyFun (Constant a b) Ordering + -> Type) + -> Type) t1) t2) + sCompare + (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + instance SOrd a => SOrd (Identity a) where + sCompare :: + forall (t1 :: Identity a) (t2 :: Identity a). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Identity a) (TyFun (Identity a) Ordering + -> Type) + -> Type) t1) t2) + sCompare + (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + instance SEq a => SEq (Constant a b) where + (%==) (SConstant a) (SConstant b) = ((%==) a) b + instance SDecide a => SDecide (Constant a b) where + (%~) (SConstant a) (SConstant b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq a => SEq (Identity a) where + (%==) (SIdentity a) (SIdentity b) = ((%==) a) b + instance SDecide a => SDecide (Identity a) where + (%~) (SIdentity a) (SIdentity b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI n => SingI (Constant (n :: a)) where + sing = SConstant sing + instance SingI n => SingI (Identity (n :: a)) where + sing = SIdentity sing diff --git a/tests/compile-and-dump/Singletons/T271.hs b/tests/compile-and-dump/Singletons/T271.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T271.hs @@ -0,0 +1,13 @@ +module T271 where + +import Data.Kind +import Data.Singletons.TH + +$(singletons + [d| newtype Constant (a :: Type) (b :: Type) = + Constant a deriving (Eq, Ord) + + data Identity :: Type -> Type where + Identity :: a -> Identity a + deriving (Eq, Ord) + |]) diff --git a/tests/compile-and-dump/Singletons/T29.ghc82.template b/tests/compile-and-dump/Singletons/T29.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T29.ghc82.template +++ /dev/null @@ -1,93 +0,0 @@ -Singletons/T29.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: Bool -> Bool - foo x = not $ x - bar :: Bool -> Bool - bar x = not . not . not $ x - baz :: Bool -> Bool - baz x = not $! x - ban :: Bool -> Bool - ban x = not . not . not $! x |] - ======> - foo :: Bool -> Bool - foo x = (not $ x) - bar :: Bool -> Bool - bar x = ((not . (not . not)) $ x) - baz :: Bool -> Bool - baz x = (not $! x) - ban :: Bool -> Bool - ban x = ((not . (not . not)) $! x) - type BanSym1 (t :: Bool) = Ban t - instance SuppressUnusedWarnings BanSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BanSym0KindInference) GHC.Tuple.()) - data BanSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => - BanSym0KindInference - type instance Apply BanSym0 l = Ban l - type BazSym1 (t :: Bool) = Baz t - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) - data BazSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0KindInference - type instance Apply BazSym0 l = Baz l - type BarSym1 (t :: Bool) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l - type FooSym1 (t :: Bool) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Ban (a :: Bool) :: Bool where - Ban x = Apply (Apply ($!$) (Apply (Apply (:.$) NotSym0) (Apply (Apply (:.$) NotSym0) NotSym0))) x - type family Baz (a :: Bool) :: Bool where - Baz x = Apply (Apply ($!$) NotSym0) x - type family Bar (a :: Bool) :: Bool where - Bar x = Apply (Apply ($$) (Apply (Apply (:.$) NotSym0) (Apply (Apply (:.$) NotSym0) NotSym0))) x - type family Foo (a :: Bool) :: Bool where - Foo x = Apply (Apply ($$) NotSym0) x - sBan :: - forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) - sBaz :: - forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) - sBar :: - forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) - sFoo :: - forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) - sBan (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($!$)) (%$!))) - ((applySing - ((applySing ((singFun3 @(:.$)) (%:.))) ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun3 @(:.$)) (%:.))) ((singFun1 @NotSym0) sNot))) - ((singFun1 @NotSym0) sNot))))) - sX - sBaz (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($!$)) (%$!))) ((singFun1 @NotSym0) sNot))) - sX - sBar (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($$)) (%$))) - ((applySing - ((applySing ((singFun3 @(:.$)) (%:.))) ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun3 @(:.$)) (%:.))) ((singFun1 @NotSym0) sNot))) - ((singFun1 @NotSym0) sNot))))) - sX - sFoo (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($$)) (%$))) ((singFun1 @NotSym0) sNot))) - sX diff --git a/tests/compile-and-dump/Singletons/T29.ghc84.template b/tests/compile-and-dump/Singletons/T29.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T29.ghc84.template @@ -0,0 +1,99 @@ +Singletons/T29.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo x = not $ x + bar :: Bool -> Bool + bar x = not . not . not $ x + baz :: Bool -> Bool + baz x = not $! x + ban :: Bool -> Bool + ban x = not . not . not $! x |] + ======> + foo :: Bool -> Bool + foo x = (not $ x) + bar :: Bool -> Bool + bar x = ((not . (not . not)) $ x) + baz :: Bool -> Bool + baz x = (not $! x) + ban :: Bool -> Bool + ban x = ((not . (not . not)) $! x) + type BanSym1 (t :: Bool) = Ban t + instance SuppressUnusedWarnings BanSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BanSym0KindInference) GHC.Tuple.()) + data BanSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => + BanSym0KindInference + type instance Apply BanSym0 l = Ban l + type BazSym1 (t :: Bool) = Baz t + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) + data BazSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0KindInference + type instance Apply BazSym0 l = Baz l + type BarSym1 (t :: Bool) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = Bar l + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type family Ban (a :: Bool) :: Bool where + Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x + type family Baz (a :: Bool) :: Bool where + Baz x = Apply (Apply ($!@#@$) NotSym0) x + type family Bar (a :: Bool) :: Bool where + Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x + type family Foo (a :: Bool) :: Bool where + Foo x = Apply (Apply ($@#@$) NotSym0) x + sBan :: + forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) + sBaz :: + forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBan (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($!@#@$)) (%$!))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((singFun1 @NotSym0) sNot))))) + sX + sBaz (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($!@#@$)) (%$!))) + ((singFun1 @NotSym0) sNot))) + sX + sBar (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($@#@$)) (%$))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((singFun1 @NotSym0) sNot))))) + sX + sFoo (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($@#@$)) (%$))) + ((singFun1 @NotSym0) sNot))) + sX diff --git a/tests/compile-and-dump/Singletons/T33.ghc82.template b/tests/compile-and-dump/Singletons/T33.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T33.ghc82.template +++ /dev/null @@ -1,32 +0,0 @@ -Singletons/T33.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: (Bool, Bool) -> () - foo ~(_, _) = () |] - ======> - foo :: (Bool, Bool) -> () - foo ~(_, _) = GHC.Tuple.() - type FooSym1 (t :: (Bool, Bool)) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun (Bool, Bool) ()) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Foo (a :: (Bool, Bool)) :: () where - Foo '(_z_0123456789876543210, _z_0123456789876543210) = Tuple0Sym0 - sFoo :: - forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ()) - sFoo (STuple2 _ _) = STuple0 - -Singletons/T33.hs:0:0: warning: - Lazy pattern converted into regular pattern in promotion - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^... - -Singletons/T33.hs:0:0: warning: - Lazy pattern converted into regular pattern during singleton generation. - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T33.ghc84.template b/tests/compile-and-dump/Singletons/T33.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T33.ghc84.template @@ -0,0 +1,32 @@ +Singletons/T33.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: (Bool, Bool) -> () + foo ~(_, _) = () |] + ======> + foo :: (Bool, Bool) -> () + foo ~(_, _) = GHC.Tuple.() + type FooSym1 (t :: (Bool, Bool)) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun (Bool, Bool) ()) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type family Foo (a :: (Bool, Bool)) :: () where + Foo '(_, _) = Tuple0Sym0 + sFoo :: + forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo (STuple2 _ _) = STuple0 + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern in promotion + | +6 | $(singletons [d| + | ^^^^^^^^^^^^^^... + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern during singleton generation. + | +6 | $(singletons [d| + | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T54.ghc82.template b/tests/compile-and-dump/Singletons/T54.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T54.ghc82.template +++ /dev/null @@ -1,47 +0,0 @@ -Singletons/T54.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| g :: Bool -> Bool - g e = (case [not] of { [_] -> not }) e |] - ======> - g :: Bool -> Bool - g e = (case [not] of { [_] -> not }) e - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 t = - Let0123456789876543210Scrutinee_0123456789876543210 t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings _ - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l - type family Let0123456789876543210Scrutinee_0123456789876543210 e where - Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:$) NotSym0) '[] - type family Case_0123456789876543210 e t where - Case_0123456789876543210 e '[_z_0123456789876543210] = NotSym0 - type GSym1 (t :: Bool) = G t - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) - data GSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0KindInference - type instance Apply GSym0 l = G l - type family G (a :: Bool) :: Bool where - G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e - sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) - sG (sE :: Sing e) - = (applySing - (let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) - sScrutinee_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) ((singFun1 @NotSym0) sNot))) - SNil - in case sScrutinee_0123456789876543210 of { - SCons _ SNil -> (singFun1 @NotSym0) sNot } :: - Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)))) - sE diff --git a/tests/compile-and-dump/Singletons/T54.ghc84.template b/tests/compile-and-dump/Singletons/T54.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T54.ghc84.template @@ -0,0 +1,48 @@ +Singletons/T54.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| g :: Bool -> Bool + g e = (case [not] of { [_] -> not }) e |] + ======> + g :: Bool -> Bool + g e = (case [not] of { [_] -> not }) e + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 t = + Let0123456789876543210Scrutinee_0123456789876543210 t + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + ((GHC.Tuple.(,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + GHC.Tuple.()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l + = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l + type family Let0123456789876543210Scrutinee_0123456789876543210 e where + Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[] + type family Case_0123456789876543210 e t where + Case_0123456789876543210 e '[_] = NotSym0 + type GSym1 (t :: Bool) = G t + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) + data GSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0KindInference + type instance Apply GSym0 l = G l + type family G (a :: Bool) :: Bool where + G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sG (sE :: Sing e) + = (applySing + (let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) + sScrutinee_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((singFun1 @NotSym0) sNot))) + SNil + in case sScrutinee_0123456789876543210 of { + SCons _ SNil -> (singFun1 @NotSym0) sNot } :: + Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)))) + sE diff --git a/tests/compile-and-dump/Singletons/T54.hs b/tests/compile-and-dump/Singletons/T54.hs --- a/tests/compile-and-dump/Singletons/T54.hs +++ b/tests/compile-and-dump/Singletons/T54.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.T54 where diff --git a/tests/compile-and-dump/Singletons/T78.ghc82.template b/tests/compile-and-dump/Singletons/T78.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T78.ghc82.template +++ /dev/null @@ -1,28 +0,0 @@ -Singletons/T78.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: MaybeBool -> Bool - foo (Just False) = False - foo (Just True) = True - foo Nothing = False |] - ======> - foo :: MaybeBool -> Bool - foo (Just False) = False - foo (Just True) = True - foo Nothing = False - type FooSym1 (t :: Maybe Bool) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun (Maybe Bool) Bool) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Foo (a :: Maybe Bool) :: Bool where - Foo (Just False) = FalseSym0 - Foo (Just True) = TrueSym0 - Foo Nothing = FalseSym0 - sFoo :: - forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) - sFoo (SJust SFalse) = SFalse - sFoo (SJust STrue) = STrue - sFoo SNothing = SFalse diff --git a/tests/compile-and-dump/Singletons/T78.ghc84.template b/tests/compile-and-dump/Singletons/T78.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T78.ghc84.template @@ -0,0 +1,28 @@ +Singletons/T78.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False |] + ======> + foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False + type FooSym1 (t :: Maybe Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun (Maybe Bool) Bool) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type family Foo (a :: Maybe Bool) :: Bool where + Foo (Just False) = FalseSym0 + Foo (Just True) = TrueSym0 + Foo Nothing = FalseSym0 + sFoo :: + forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sFoo (SJust SFalse) = SFalse + sFoo (SJust STrue) = STrue + sFoo SNothing = SFalse diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc82.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc82.template +++ /dev/null @@ -1,304 +0,0 @@ -Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Bool = False | True - data Foo = Bar Bool Bool |] - ======> - data Bool = False | True - data Foo = Bar Bool Bool - type FalseSym0 = False - type TrueSym0 = True - type BarSym2 (t :: Bool) (t :: Bool) = Bar t t - instance SuppressUnusedWarnings BarSym1 where - suppressUnusedWarnings _ - = Data.Tuple.snd - ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) - data BarSym1 (l :: Bool) (l :: TyFun Bool Foo) - = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => - BarSym1KindInference - type instance Apply (BarSym1 l) l = Bar l l - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd - ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bool (TyFun Bool Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = BarSym1 l - data instance Sing (z :: Bool) - = z ~ False => SFalse | z ~ True => STrue - type SBool = (Sing :: Bool -> GHC.Types.Type) - instance SingKind Bool where - type Demote Bool = Bool - fromSing SFalse = False - fromSing STrue = True - toSing False = SomeSing SFalse - toSing True = SomeSing STrue - data instance Sing (z :: Foo) - = 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 Demote 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 :: a -> a - id x = x - not :: Bool -> Bool - not True = False - not False = True - false_ = False - f :: Bool -> Bool - g :: Bool -> Bool - [f, g] = [not, id] - h :: Bool -> Bool - i :: Bool -> Bool - (h, i) = (f, g) - j :: Bool - k :: Bool - Bar j k = (Bar True) (h False) - l :: Bool - m :: Bool - [l, m] = [not True, id False] - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, - _z_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[_z_0123456789876543210, - y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, - _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(_z_0123456789876543210, - y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Bar y_0123456789876543210 _z_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Bar _z_0123456789876543210 y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[y_0123456789876543210, - _z_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_z_0123456789876543210, - y_0123456789876543210] = y_0123456789876543210 - type False_Sym0 = False_ - type NotSym1 (t :: Bool) = Not t - instance SuppressUnusedWarnings NotSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd - ((GHC.Tuple.(,) NotSym0KindInference) GHC.Tuple.()) - data NotSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => - NotSym0KindInference - type instance Apply NotSym0 l = Not l - type IdSym1 (t :: a0123456789876543210) = Id t - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.()) - data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0KindInference - type instance Apply IdSym0 l = Id l - type FSym1 (t :: Bool) = F t - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) - data FSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0KindInference - type instance Apply FSym0 l = F l - type GSym1 (t :: Bool) = G t - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) - data GSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0KindInference - type instance Apply GSym0 l = G l - type HSym1 (t :: Bool) = H t - instance SuppressUnusedWarnings HSym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd ((GHC.Tuple.(,) HSym0KindInference) GHC.Tuple.()) - data HSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply HSym0 arg) (HSym1 arg) => - HSym0KindInference - type instance Apply HSym0 l = H l - type ISym1 (t :: Bool) = I t - instance SuppressUnusedWarnings ISym0 where - suppressUnusedWarnings _ - = Data.Tuple.snd ((GHC.Tuple.(,) ISym0KindInference) GHC.Tuple.()) - data ISym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply ISym0 arg) (ISym1 arg) => - ISym0KindInference - type instance Apply ISym0 l = I l - type JSym0 = J - type KSym0 = K - type LSym0 = L - type MSym0 = M - type OtherwiseSym0 = Otherwise - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type family False_ where - = FalseSym0 - type family Not (a :: Bool) :: Bool where - Not True = FalseSym0 - Not False = TrueSym0 - type family Id (a :: a) :: a where - Id x = x - type family F (a :: Bool) :: Bool where - F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family G (a :: Bool) :: Bool where - G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family H (a :: Bool) :: Bool where - H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family I (a :: Bool) :: Bool where - I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family J :: Bool where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family K :: Bool where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family L :: Bool where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family M :: Bool where - = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Otherwise :: Bool where - = TrueSym0 - type family X_0123456789876543210 where - = Apply (Apply (:$) NotSym0) (Apply (Apply (:$) IdSym0) '[]) - type family X_0123456789876543210 where - = Apply (Apply Tuple2Sym0 FSym0) GSym0 - type family X_0123456789876543210 where - = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) - type family X_0123456789876543210 where - = Apply (Apply (:$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:$) (Apply IdSym0 FalseSym0)) '[]) - sFalse_ :: Sing False_Sym0 - sNot :: - forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) - sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) - sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) - sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) - sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) - sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) - sJ :: Sing (JSym0 :: Bool) - sK :: Sing (KSym0 :: Bool) - sL :: Sing (LSym0 :: Bool) - sM :: Sing (MSym0 :: Bool) - sOtherwise :: Sing (OtherwiseSym0 :: Bool) - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sFalse_ = SFalse - sNot STrue = SFalse - sNot SFalse = STrue - sId (sX :: Sing x) = sX - sF (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sG (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sH (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sI (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sJ - = case sX_0123456789876543210 of { - SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sK - = case sX_0123456789876543210 of { - SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sL - = case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sM - = case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sOtherwise = STrue - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) ((singFun1 @IdSym0) sId))) - SNil) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - ((singFun1 @FSym0) sF))) - ((singFun1 @GSym0) sG) - sX_0123456789876543210 - = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) - ((applySing ((singFun1 @HSym0) sH)) SFalse) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @NotSym0) sNot)) STrue))) - ((applySing - ((applySing ((singFun2 @(:$)) SCons)) - ((applySing ((singFun1 @IdSym0) sId)) SFalse))) - SNil) diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template @@ -0,0 +1,308 @@ +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Bool = False | True + data Foo = Bar Bool Bool |] + ======> + data Bool = False | True + data Foo = Bar Bool Bool + type FalseSym0 = False + type TrueSym0 = True + type BarSym2 (t :: Bool) (t :: Bool) = Bar t t + instance SuppressUnusedWarnings BarSym1 where + suppressUnusedWarnings + = Data.Tuple.snd + ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) + data BarSym1 (l :: Bool) (l :: TyFun Bool Foo) + = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => + BarSym1KindInference + type instance Apply (BarSym1 l) l = Bar l l + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = Data.Tuple.snd + ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool (TyFun Bool Foo -> GHC.Types.Type)) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l + data instance Sing (z :: Bool) + where + SFalse :: Sing False + STrue :: Sing True + type SBool = (Sing :: Bool -> GHC.Types.Type) + instance SingKind Bool where + type Demote Bool = Bool + fromSing SFalse = False + fromSing STrue = True + toSing False = SomeSing SFalse + toSing True = SomeSing STrue + data instance Sing (z :: Foo) + where + SBar :: forall (n :: Bool) (n :: Bool). + (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Bar n n) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing (SBar b b) = (Bar (fromSing b)) (fromSing b) + toSing (Bar (b :: Demote Bool) (b :: Demote Bool)) + = case + (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) + (toSing b :: SomeSing Bool) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SBar c) c) } + instance SingI False where + sing = SFalse + instance SingI True where + sing = STrue + instance (SingI n, SingI n) => + SingI (Bar (n :: Bool) (n :: Bool)) where + sing = (SBar sing) sing +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| otherwise :: Bool + otherwise = True + id :: a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f, g :: Bool -> Bool + [f, g] = [not, id] + h, i :: Bool -> Bool + (h, i) = (f, g) + j, k :: Bool + (Bar j k) = Bar True (h False) + l, m :: Bool + [l, m] = [not True, id False] |] + ======> + otherwise :: Bool + otherwise = True + id :: a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f :: Bool -> Bool + g :: Bool -> Bool + [f, g] = [not, id] + h :: Bool -> Bool + i :: Bool -> Bool + (h, i) = (f, g) + j :: Bool + k :: Bool + Bar j k = (Bar True) (h False) + l :: Bool + m :: Bool + [l, m] = [not True, id False] + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, + _] = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(_, + y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Bar y_0123456789876543210 _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 (Bar _ y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[y_0123456789876543210, + _] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 + type False_Sym0 = False_ + type NotSym1 (t :: Bool) = Not t + instance SuppressUnusedWarnings NotSym0 where + suppressUnusedWarnings + = Data.Tuple.snd + ((GHC.Tuple.(,) NotSym0KindInference) GHC.Tuple.()) + data NotSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => + NotSym0KindInference + type instance Apply NotSym0 l = Not l + type IdSym1 (t :: a0123456789876543210) = Id t + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings + = Data.Tuple.snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.()) + data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) + = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => + IdSym0KindInference + type instance Apply IdSym0 l = Id l + type FSym1 (t :: Bool) = F t + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings + = Data.Tuple.snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) + data FSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0KindInference + type instance Apply FSym0 l = F l + type GSym1 (t :: Bool) = G t + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings + = Data.Tuple.snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) + data GSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0KindInference + type instance Apply GSym0 l = G l + type HSym1 (t :: Bool) = H t + instance SuppressUnusedWarnings HSym0 where + suppressUnusedWarnings + = Data.Tuple.snd ((GHC.Tuple.(,) HSym0KindInference) GHC.Tuple.()) + data HSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply HSym0 arg) (HSym1 arg) => + HSym0KindInference + type instance Apply HSym0 l = H l + type ISym1 (t :: Bool) = I t + instance SuppressUnusedWarnings ISym0 where + suppressUnusedWarnings + = Data.Tuple.snd ((GHC.Tuple.(,) ISym0KindInference) GHC.Tuple.()) + data ISym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply ISym0 arg) (ISym1 arg) => + ISym0KindInference + type instance Apply ISym0 l = I l + type JSym0 = J + type KSym0 = K + type LSym0 = L + type MSym0 = M + type OtherwiseSym0 = Otherwise + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type family False_ where + False_ = FalseSym0 + type family Not (a :: Bool) :: Bool where + Not True = FalseSym0 + Not False = TrueSym0 + type family Id (a :: a) :: a where + Id x = x + type family F (a :: Bool) :: Bool where + F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family G (a :: Bool) :: Bool where + G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family H (a :: Bool) :: Bool where + H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family I (a :: Bool) :: Bool where + I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family J :: Bool where + J = Case_0123456789876543210 X_0123456789876543210Sym0 + type family K :: Bool where + K = Case_0123456789876543210 X_0123456789876543210Sym0 + type family L :: Bool where + L = Case_0123456789876543210 X_0123456789876543210Sym0 + type family M :: Bool where + M = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Otherwise :: Bool where + Otherwise = TrueSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) + sFalse_ :: Sing False_Sym0 + sNot :: + forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) + sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) + sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) + sJ :: Sing (JSym0 :: Bool) + sK :: Sing (KSym0 :: Bool) + sL :: Sing (LSym0 :: Bool) + sM :: Sing (MSym0 :: Bool) + sOtherwise :: Sing (OtherwiseSym0 :: Bool) + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sFalse_ = SFalse + sNot STrue = SFalse + sNot SFalse = STrue + sId (sX :: Sing x) = sX + sF (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + (case sX_0123456789876543210 of { + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sG (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + (case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sH (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + (case sX_0123456789876543210 of { + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sI (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + (case sX_0123456789876543210 of { + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sJ + = case sX_0123456789876543210 of { + SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sK + = case sX_0123456789876543210 of { + SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sL + = case sX_0123456789876543210 of { + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sM + = case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + -> sY_0123456789876543210 } :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sOtherwise = STrue + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId))) + SNil) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + ((singFun1 @FSym0) sF))) + ((singFun1 @GSym0) sG) + sX_0123456789876543210 + = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) + ((applySing ((singFun1 @HSym0) sH)) SFalse) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @NotSym0) sNot)) STrue))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @IdSym0) sId)) SFalse))) + SNil) diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.hs b/tests/compile-and-dump/Singletons/TopLevelPatterns.hs --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.hs +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.hs @@ -1,5 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.TopLevelPatterns where diff --git a/tests/compile-and-dump/Singletons/Undef.ghc82.template b/tests/compile-and-dump/Singletons/Undef.ghc82.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Undef.ghc82.template +++ /dev/null @@ -1,39 +0,0 @@ -Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: Bool -> Bool - foo = undefined - bar :: Bool -> Bool - bar = error "urk" |] - ======> - foo :: Bool -> Bool - foo = undefined - bar :: Bool -> Bool - bar = error "urk" - type BarSym1 (t :: Bool) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l - type FooSym1 (t :: Bool) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings _ - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Bar (a :: Bool) :: Bool where - Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 - type family Foo (a :: Bool) :: Bool where - Foo a_0123456789876543210 = Apply Any a_0123456789876543210 - sBar :: - forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) - sFoo :: - forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) - sBar (sA_0123456789876543210 :: Sing a_0123456789876543210) - = sError (sing :: Sing "urk") - sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210) - = undefined diff --git a/tests/compile-and-dump/Singletons/Undef.ghc84.template b/tests/compile-and-dump/Singletons/Undef.ghc84.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Undef.ghc84.template @@ -0,0 +1,39 @@ +Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" |] + ======> + foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" + type BarSym1 (t :: Bool) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = Bar l + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings + = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool Bool) + = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = Foo l + type family Bar (a :: Bool) :: Bool where + Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 + type family Foo (a :: Bool) :: Bool where + Foo a_0123456789876543210 = Apply UndefinedSym0 a_0123456789876543210 + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBar (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (sError (sing :: Sing "urk")) sA_0123456789876543210 + sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210) + = sUndefined sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/Undef.hs b/tests/compile-and-dump/Singletons/Undef.hs --- a/tests/compile-and-dump/Singletons/Undef.hs +++ b/tests/compile-and-dump/Singletons/Undef.hs @@ -1,7 +1,7 @@ +{-# OPTIONS_GHC -Wall #-} module Singletons.Undef where import Data.Singletons.TH -import Data.Singletons.Prelude $(singletons [d| foo :: Bool -> Bool