diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,126 @@ Changelog for singletons project ================================ +2.5 +--- +* The `Data.Promotion.Prelude.*` namespace has been removed. Use the + corresponding modules in the `Data.Singletons.Prelude.*` namespace instead. + +* Fix a regression in which certain infix type families, such as `(++)`, `($)`, + `(+)`, and others, did not have the correct fixities. + +* The default implementation of the `(==)` type in `PEq` was changed from + `(Data.Type.Equality.==)` to a custom type family, `DefaultEq`. The reason + for this change is that `(Data.Type.Equality.==)` is unable to conclude that + `a == a` reduces to `True` for any `a`. (As a result, the previous version of + `singletons` regressed in terms of type inference for the `PEq` instances + for `Nat` and `Symbol`, which used that default.) On the other hand, + `DefaultEq a a` _does_ reduce to `True` for all `a`. + +* Add `Enum Nat`, `Show Nat`, and `Show Symbol` instances to + `Data.Singletons.TypeLits`. + +* Template Haskell-generated code may require `DataKinds` and `PolyKinds` in + scenarios which did not previously require it: + * `singletons` now explicitly quantifies all kind variables used in explicit + `forall`s. + * `singletons` now generates `a ~> b` instead of `TyFun a b -> Type` whenever + possible. + +* Since `th-desugar` now desugars all data types to GADT syntax, Template + Haskell-generated code may require `GADTs` in situations that didn't require + it before. + +* Overhaul the way derived `Show` instances for singleton types works. Before, + there was an awkward `ShowSing` class (which was essentially a cargo-culted + version of `Show` specialized for `Sing`) that one had to create instances + for separately. Now that GHC has `QuantifiedConstraints`, we can scrap this + whole class and turn `ShowSing` into a simple type synonym: + + ```haskell + type ShowSing k = forall z. Show (Sing (z :: k)) + ``` + + Now, instead of generating a hand-written `ShowSing` and `Show` instance for + each singleton type, we only generate a single (derived!) `Show` instance. + As a result of this change, you will likely need to enable + `QuantifiedConstraints` and `StandaloneDeriving` if you single any derived + `Show` instances in your code. + +* The kind of the type parameter to `SingI` is no longer specified. This only + affects you if you were using the `sing` method with `TypeApplications`. For + instance, if you were using `sing @Bool @True` before, then you will now need + to now use `sing @Bool` instead. + +* `singletons` now generates `SingI` instances for defunctionalization symbols + through Template Haskell. As a result, you may need to enable + `FlexibleInstances` in more places. + +* `genDefunSymbols` is now more robust with respect to types that use + dependent quantification, such as: + + ```haskell + type family MyProxy k (a :: k) :: Type where + MyProxy k (a :: k) = Proxy a + ``` + + See the documentation for `genDefunSymbols` for limitations to this. + +* Rename `Data.Singletons.TypeRepStar` to `Data.Singletons.TypeRepTYPE`, and + generalize the `Sing :: Type -> Type` instance to `Sing :: TYPE rep -> Type`, + allowing it to work over more open kinds. Also rename `SomeTypeRepStar` to + `SomeTypeRepTYPE`, and change its definition accordingly. + +* Promoting or singling a type synonym or type family declaration now produces + defunctionalization symbols for it. (Previously, promoting or singling a type + synonym did nothing whatsoever, and promoting or singling a type family + produced an error.) + +* `singletons` now produces fixity declarations for defunctionalization + symbols when appropriate. + +* Add `(%<=?)`, a singled version of `(<=?)` from `GHC.TypeNats`, as well as + defunctionalization symbols for `(<=?)`, to `Data.Singletons.TypeLits`. + +* Add `Data.Singletons.Prelude.{Semigroup,Monoid}`, which define + promoted and singled versions of the `Semigroup` and `Monoid` type classes, + as well as various newtype modifiers. + + `Symbol` is now has promoted `Semigroup` and `Monoid` instances as well. + As a consequence, `Data.Singletons.TypeLits` no longer exports `(<>)` or + `(%<>)`, as they are superseded by the corresponding methods from + `PSemigroup` and `SSemigroup`. + +* Add promoted and singled versions of the `Functor`, `Foldable`, + `Traversable`, `Applicative`, `Alternative`, `Monad`, `MonadPlus`, and + `MonadZip` classes. Among other things, this grants the ability to promote + or single `do`-notation and list comprehensions. + * `Data.Singletons.Prelude.List` now reexports more general + `Foldable`/`Traversable` functions wherever possible, just as `Data.List` + does. + +* Add `Data.Singletons.Prelude.{Const,Identity}`, which define + promoted and singled version of the `Const` and `Identity` data types, + respectively. + +* Promote and single the `Down` newtype in `Data.Singletons.Prelude.Ord`. + +* To match the `base` library, the promoted/singled versions of `comparing` + and `thenCmp` are no longer exported from `Data.Singletons.Prelude`. (They + continue to live in `Data.Singletons.Prelude.Ord`.) + +* Permit singling of expression and pattern signatures. + +* Permit promotion and singling of `InstanceSigs`. + +* `sError` and `sUndefined` now have `HasCallStack` constraints, like their + counterparts `error` and `undefined`. The promoted and singled counterparts + to `errorWithoutStackTrace` have also been added in case you do not want + this behavior. + +* Add `Data.Singletons.TypeError`, which provides a drop-in replacement for + `GHC.TypeLits.TypeError` which can be used at both the value- and type-level. + 2.4.1 ----- * Restore the `TyCon1`, `TyCon2`, etc. types. It turns out that the new diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -singletons 2.4 +singletons 2.5 ============== [![Hackage](https://img.shields.io/hackage/v/singletons.svg)](http://hackage.haskell.org/package/singletons) @@ -36,11 +36,12 @@ Compatibility ------------- -The singletons library requires GHC 8.4.1 or greater. Any code that uses the +The singletons library requires GHC 8.6.1 or greater. Any code that uses the singleton generation primitives needs to enable a long list of GHC extensions. This list includes, but is not necessarily limited to, the following: +* `DataKinds` * `DefaultSignatures` * `EmptyCase` * `ExistentialQuantification` @@ -49,14 +50,21 @@ * `GADTs` * `InstanceSigs` * `KindSignatures` +* `NoStarIsType` +* `PolyKinds` +* `QuantifiedConstraints` * `RankNTypes` * `ScopedTypeVariables` +* `StandaloneDeriving` * `TemplateHaskell` * `TypeFamilies` -* `TypeInType` * `TypeOperators` * `UndecidableInstances` +In particular, `NoStarIsType` is needed to use the `*` type family from the +`PNum` class because with `StarIsType` enabled, GHC thinks `*` is a synonym +for `Type`. + You may also want * `-Wno-redundant-constraints` @@ -220,22 +228,26 @@ 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. +addition, there is a `ShowSing` constraint synonym provided in the +`Data.Singletons.ShowSing` module: -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 +```haskell +type ShowSing k = (forall z. Show (Sing (z :: k)) +``` + +This facilitates the ability to write `Show` instances for `Sing` instances. + +What distinguishes all of these `Show`s? Let's use the `False` constructor as +an example. If you used the `PShow Bool` instance, then the output of calling `Show_` on `False` is `"False"`, much like the value-level `Show Bool` instance -(similarly for the `SShow Bool` instance). However, the `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). +(similarly for the `SShow Bool` instance). However, the `Show (Sing (z :: Bool))` +instance (i.e., `ShowSing Bool`) is intended for printing the value of the +_singleton_ constructor `SFalse`, so calling `show SFalse` yields `"SFalse"`. -Instance of `PShow`, `SShow`, `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`. +Instance of `PShow`, `SShow`, and `Show` (for the singleton type) are generated +when `singletons` is called on a datatype that has `deriving Show`. You can also +generate these instances directly through functions exported from +`Data.Singletons.TH`. A promoted and singled `Show` instance is provided for `Symbol`, but it is only a crude approximation of the value-level `Show` instance for `String`. On the @@ -244,7 +256,28 @@ something which is currently impossible at the type level. As a consequence, the type-level `Show` instance for `Symbol`s does not do any character escaping. +Errors +------ +The `singletons` library provides two different ways to handle errors: + +* The `Error` type family, from `Data.Singletons.TypeLits`: + + ```haskell + type family Error (str :: a) :: k where {} + ``` + + This is simply an empty, closed type family, which means that it will fail + to reduce regardless of its input. The typical use case is giving it a + `Symbol` as an argument, so that something akin to + `Error "This is an error message"` appears in error messages. +* The `TypeError` type family, from `Data.Singletons.TypeError`. This is a + drop-in replacement for `TypeError` from `GHC.TypeLits` which can be used + at both the type level and the value level (via the `typeError` function). + + Unlike `Error`, `TypeError` will result in an actual compile-time error + message, which may be more desirable depending on the use case. + Pre-defined singletons ---------------------- @@ -540,11 +573,13 @@ * infix expressions and types * `_` patterns * aliased patterns -* lists +* lists (including list comprehensions) +* `do`-notation * sections * undefined * error -* deriving `Eq`, `Ord`, `Show`, `Bounded`, and `Enum` +* deriving `Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`, `Foldable`, and + `Traversable`, as well as the `stock` and `anyclass` deriving strategies * class constraints (though these sometimes fail with `let`, `lambda`, and `case`) * literals (for `Nat` and `Symbol`), including overloaded number literals * unboxed tuples (which are treated as normal tuples) @@ -555,8 +590,13 @@ * lambda expressions * `!` and `~` patterns (silently but successfully ignored during promotion) * class and instance declarations +* scoped type variables +* signatures (e.g., `(x :: Maybe a)`) in expressions and patterns +* `InstanceSigs` * higher-kinded type variables (see below) +* finite arithmetic sequences (see below) * functional dependencies (with limitations -- see below) +* type families (with limitations -- see below) Higher-kinded type variables in `class`/`data` declarations must be annotated explicitly. This is due to GHC's handling of *complete @@ -568,49 +608,80 @@ 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. +The stock classes listed above (`Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`, +`Foldable`, and `Traversable`) are the only ones that `singletons` will derive +without an explicit deriving strategy. To do anything more exotic, one must +explicitly indicate one's intentions by using the `DerivingStrategies` extension. `singletons` fully supports the `anyclass` strategy as well as the `stock` strategy (at least, for the classes listed above). `singletons` does not support the `newtype` strategy, as there is not an equivalent of `coerce` at the type level. +`singletons` has partial support for arithmetic sequences (which desugar to +methods from the `Enum` class under the hood). _Finite_ sequences (e.g., +[0..42]) are fully supported. However, _infinite_ sequences (e.g., [0..]), +which desugar to calls to `enumFromTo` or `enumFromThenTo`, are not supported, +as these would require using infinite lists at the type level. + The following constructs are supported for promotion but not singleton generation: -* scoped type variables +* datatypes with constructors which have contexts. For example, the following + datatype does not singletonize: + + ```haskell + data T a where + MkT :: Show a => a -> T a + ``` + + Constructors like these do not interact well with the current design of the + `SingKind` class. But see + [this bug report](https://github.com/goldfirere/singletons/issues/150), which + proposes a redesign for `SingKind` (in a future version of GHC with certain + bugfixes) which could permit constructors with equality constraints. + * overlapping patterns. Note that overlapping patterns are sometimes not obvious. For example, the `filter` function does not singletonize due to overlapping patterns: -```haskell -filter :: (a -> Bool) -> [a] -> [a] -filter _pred [] = [] -filter pred (x:xs) - | pred x = x : filter pred xs - | otherwise = filter pred xs -``` -Overlap is caused by `otherwise` catch-all guard, which is always true and thus + + ```haskell + filter :: (a -> Bool) -> [a] -> [a] + filter _pred [] = [] + filter pred (x:xs) + | pred x = x : filter pred xs + | otherwise = filter pred xs + ``` + Overlap is caused by `otherwise` catch-all guard, which is always true and thus overlaps with `pred x` guard. + Another non-obvious source of overlapping patterns comes from partial pattern + matches in `do`-notation. For example: + + ```haskell + f :: [()] + f = do + Just () <- [Nothing] + return () + ``` + + This has overlap because the partial pattern match desugars to the following: + + ```haskell + f :: [()] + f = case [Nothing] of + Just () -> return () + _ -> fail "Partial pattern match in do notation" + ``` + + Here, it is more evident that the catch-all pattern `_` overlaps with the + one above it. + The following constructs are not supported: -* list comprehensions -* do -* arithmetic sequences * datatypes that store arrows, `Nat`, or `Symbol` * literals (limited support) -Why are these out of reach? The first two depend on monads, which mention a -higher-kinded type variable. GHC did not support higher-sorted kind variables, -which are be necessary to promote/singletonize monads, and `singletons` has -not be rewritten to accommodate this new ability. [This bug -report](https://github.com/goldfirere/singletons/issues/184) is a feature request -looking for support for these constructs. - -Arithmetic sequences are defined using `Enum` typeclass, which uses infinite -lists. +Why are these out of reach? As described in the promotion paper, promotion of datatypes that store arrows is currently impossible. So if you have a declaration such as @@ -641,18 +712,19 @@ updated for this to really work out. In the meantime, users who wish to experiment with this feature have two options: -1) The module `Data.Singletons.TypeRepStar` has all the definitions possible for +1) The module `Data.Singletons.TypeRepTYPE` has all the definitions possible for making `*` the promoted version of `TypeRep`, as `TypeRep` is currently implemented. The singleton associated with `TypeRep` has one constructor: ```haskell - newtype instance Sing :: Type -> Type where - STypeRep :: TypeRep a -> Sing a + newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where + STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a ``` - Thus, a `TypeRep` is stored in the singleton constructor. However, -any datatypes that store `TypeRep`s will not generally work as expected; the -built-in promotion mechanism will not promote `TypeRep` to `*`. + (Recall that `type * = TYPE LiftedRep`.) Thus, a `TypeRep` is stored in the +singleton constructor. However, any datatypes that store `TypeRep`s will not +generally work as expected; the built-in promotion mechanism will not promote +`TypeRep` to `*`. 2) The module `Data.Singletons.CustomStar` allows the programmer to define a subset of types with which to work. See the Haddock documentation for the function @@ -666,3 +738,27 @@ problem is that a use of an associated type family tied to a class with fundeps doesn't provoke the fundep to kick in. This is GHC's problem, in the end. +* Singled code that contains uses type families is likely to fail due to GHC + Trac #12564. Note that singling type family declarations themselves is fine + (and often desired, since that produces defunctionalization symbols for them). +* Singling instances of poly-kinded type classes is likely to fail due to + [#358](https://github.com/goldfirere/singletons/issues/358). + However, one can often work around the issue by using `InstanceSigs`. For + instance, the following code will not single: + + ```haskell + class C (f :: k -> Type) where + method :: f a + + instance C [] where + method = [] + ``` + + Adding a type signature for `method` in the `C []` is sufficient + to work around the issue, though: + + ```haskell + instance C [] where + method :: [a] + method = [] + ``` diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,138 @@ +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +import Control.Monad + +import Data.List +import Data.String + +import Distribution.PackageDescription import Distribution.Simple -main = defaultMain +import Distribution.Simple.BuildPaths +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.PackageIndex +import Distribution.Simple.Program +import Distribution.Simple.Setup +import Distribution.Simple.Utils +import Distribution.Text + +import System.Directory +import System.FilePath + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule flags pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + , confHook = \(gpd, hbi) flags -> + confHook simpleUserHooks (amendGPD gpd, hbi) flags + , haddockHook = \pkg lbi hooks flags -> do + generateBuildModule (haddockToBuildFlags flags) pkg lbi + haddockHook simpleUserHooks pkg lbi hooks flags + } + +-- | Convert only flags used by 'generateBuildModule'. +haddockToBuildFlags :: HaddockFlags -> BuildFlags +haddockToBuildFlags f = emptyBuildFlags + { buildVerbosity = haddockVerbosity f + , buildDistPref = haddockDistPref f + } + +generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule flags pkg lbi = do + rootDir <- getCurrentDirectory + let verbosity = fromFlag (buildVerbosity flags) + distPref = fromFlag (buildDistPref flags) + distPref' | isRelative distPref = rootDir distPref + | otherwise = distPref + -- Package DBs + dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref' "package.conf.inplace" ] + dbFlags = "-hide-all-packages" : packageDbArgsDb dbStack + + ghc = case lookupProgram ghcProgram (withPrograms lbi) of + Just fp -> locationPath $ programLocation fp + Nothing -> error "Can't find GHC path" + withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do + let testAutogenDir = autogenComponentModulesDir lbi suitecfg + createDirectoryIfMissingVerbose verbosity True testAutogenDir + let buildSingletonsFile = testAutogenDir buildSingletonsModule <.> "hs" + withLibLBI pkg lbi $ \_ libCLBI -> do + let libDeps = map fst $ componentPackageDeps libCLBI + pidx = case dependencyClosure (installedPkgs lbi) libDeps of + Left p -> p + Right _ -> error "Broken dependency closure" + libTransDeps = map installedUnitId $ allPackages pidx + singletonsUnitId = componentUnitId libCLBI + deps = formatDeps (singletonsUnitId:libTransDeps) + allFlags = dbFlags ++ deps + writeFile buildSingletonsFile $ unlines + [ "module Build_singletons where" + , "" + , "ghcPath :: FilePath" + , "ghcPath = " ++ show ghc + , "" + , "ghcFlags :: [String]" + , "ghcFlags = " ++ show allFlags + , "" + , "rootDir :: FilePath" + , "rootDir = " ++ show rootDir + ] + where + formatDeps = map formatOne + formatOne installedPkgId = "-package-id=" ++ display installedPkgId + + -- GHC >= 7.6 uses the '-package-db' flag. See + -- https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> "-no-user-package-db" + : concatMap single dbs + dbs -> "-clear-package-db" + : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False + +buildSingletonsModule :: FilePath +buildSingletonsModule = "Build_singletons" + +testSuiteName :: String +testSuiteName = "singletons-test-suite" + +amendGPD :: GenericPackageDescription -> GenericPackageDescription +amendGPD gpd = gpd + { condTestSuites = map f (condTestSuites gpd) + } + where + f (name, condTree) + | name == fromString testSuiteName = (name, condTree') + | otherwise = (name, condTree) + where + -- I miss 'lens' + testSuite = condTreeData condTree + bi = testBuildInfo testSuite + om = otherModules bi + am = autogenModules bi + + -- Cons the module to both other-modules and autogen-modules. + -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have + -- "all autogen-modules are other-modules if they aren't exposed-modules" + -- rule. Hopefully cabal-spec-3.0 will have. + -- + -- Note: we `nub`, because it's unclear if that's ok to have duplicate + -- modules in the lists. + om' = nub $ mn : om + am' = nub $ mn : am + + mn = fromString buildSingletonsModule + + bi' = bi { otherModules = om', autogenModules = am' } + testSuite' = testSuite { testBuildInfo = bi' } + condTree' = condTree { condTreeData = testSuite' } diff --git a/singletons.cabal b/singletons.cabal --- a/singletons.cabal +++ b/singletons.cabal @@ -1,28 +1,28 @@ name: singletons -version: 2.4.1 +version: 2.5 -- Remember to bump version in the Makefile as well cabal-version: >= 1.10 synopsis: A framework for generating singleton types homepage: http://www.github.com/goldfirere/singletons category: Dependent Types author: Richard Eisenberg , Jan Stolarek -maintainer: Richard Eisenberg , Jan Stolarek +maintainer: Ryan Scott bug-reports: https://github.com/goldfirere/singletons/issues stability: experimental -tested-with: GHC == 8.4.1 +tested-with: GHC == 8.6.1 extra-source-files: README.md, CHANGES.md, tests/compile-and-dump/buildGoldenFiles.awk, tests/compile-and-dump/GradingClient/*.hs, tests/compile-and-dump/InsertionSort/*.hs, tests/compile-and-dump/Promote/*.hs, tests/compile-and-dump/Singletons/*.hs - tests/compile-and-dump/GradingClient/*.ghc84.template, - tests/compile-and-dump/InsertionSort/*.ghc84.template, - tests/compile-and-dump/Promote/*.ghc84.template, - tests/compile-and-dump/Singletons/*.ghc84.template + tests/compile-and-dump/GradingClient/*.ghc86.template, + tests/compile-and-dump/InsertionSort/*.ghc86.template, + tests/compile-and-dump/Promote/*.ghc86.template, + tests/compile-and-dump/Singletons/*.ghc86.template license: BSD3 license-file: LICENSE -build-type: Simple +build-type: Custom description: This library generates singleton types, promoted functions, and singleton functions using Template Haskell. It is useful for programmers who wish @@ -38,16 +38,29 @@ source-repository this type: git location: https://github.com/goldfirere/singletons.git - tag: v2.4.1 + tag: v2.5 +source-repository head + type: git + location: https://github.com/goldfirere/singletons.git + branch: master + +custom-setup + setup-depends: + base >= 4.12 && < 4.13, + Cabal >= 2.3 && < 2.5, + directory >= 1, + filepath >= 1.3 + library hs-source-dirs: src - build-depends: base >= 4.11 && < 4.12, + build-depends: base >= 4.12 && < 4.13, mtl >= 2.2.1, ghc-boot-th, template-haskell, containers >= 0.5, - th-desugar >= 1.8 && < 1.9, + th-desugar >= 1.9 && < 1.10, + pretty, syb >= 0.4, text >= 1.2, transformers >= 0.5.2 @@ -58,41 +71,35 @@ exposed-modules: Data.Singletons Data.Singletons.CustomStar - Data.Singletons.TypeRepStar + Data.Singletons.TypeRepTYPE Data.Singletons.TH Data.Singletons.Prelude + Data.Singletons.Prelude.Applicative Data.Singletons.Prelude.Base Data.Singletons.Prelude.Bool + Data.Singletons.Prelude.Const Data.Singletons.Prelude.Either Data.Singletons.Prelude.Enum Data.Singletons.Prelude.Eq + Data.Singletons.Prelude.Foldable Data.Singletons.Prelude.Function + Data.Singletons.Prelude.Functor Data.Singletons.Prelude.IsString + Data.Singletons.Prelude.Identity Data.Singletons.Prelude.Ord Data.Singletons.Prelude.List Data.Singletons.Prelude.List.NonEmpty Data.Singletons.Prelude.Maybe + Data.Singletons.Prelude.Monad + Data.Singletons.Prelude.Monad.Zip + Data.Singletons.Prelude.Monoid Data.Singletons.Prelude.Num + Data.Singletons.Prelude.Semigroup Data.Singletons.Prelude.Show + Data.Singletons.Prelude.Traversable Data.Singletons.Prelude.Tuple Data.Singletons.Prelude.Void - Data.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.TypeError Data.Singletons.TypeLits Data.Singletons.Decide Data.Singletons.ShowSing @@ -102,10 +109,17 @@ other-modules: Data.Singletons.Deriving.Infer Data.Singletons.Deriving.Bounded Data.Singletons.Deriving.Enum + Data.Singletons.Deriving.Foldable + Data.Singletons.Deriving.Functor Data.Singletons.Deriving.Ord Data.Singletons.Deriving.Show + Data.Singletons.Deriving.Traversable + Data.Singletons.Deriving.Util Data.Singletons.Internal - Data.Singletons.Prelude.List.NonEmpty.Internal + Data.Singletons.Prelude.List.Internal + Data.Singletons.Prelude.List.Internal.Disambiguation + Data.Singletons.Prelude.Monad.Internal + Data.Singletons.Prelude.Semigroup.Internal Data.Singletons.Promote Data.Singletons.Promote.Monad Data.Singletons.Promote.Eq @@ -119,6 +133,7 @@ Data.Singletons.Single.Type Data.Singletons.Single.Eq Data.Singletons.Single.Data + Data.Singletons.Single.Defun Data.Singletons.Single.Fixity Data.Singletons.Single Data.Singletons.TypeLits.Internal @@ -128,16 +143,17 @@ test-suite singletons-test-suite type: exitcode-stdio-1.0 - hs-source-dirs: src, tests + hs-source-dirs: tests ghc-options: -Wall default-language: Haskell2010 main-is: SingletonsTestSuite.hs - other-modules: SingletonsTestSuiteUtils + other-modules: ByHand + ByHand2 + SingletonsTestSuiteUtils - build-depends: base >= 4.11 && < 4.12, + build-depends: base >= 4.12 && < 4.13, filepath >= 1.3, process >= 1.1, singletons, tasty >= 0.6, - tasty-golden >= 2.2, - directory >= 1 + tasty-golden >= 2.2 diff --git a/src/Data/Promotion/Prelude.hs b/src/Data/Promotion/Prelude.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude.hs +++ /dev/null @@ -1,186 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Mimics the Haskell Prelude, but with promoted types. --- ----------------------------------------------------------------------------- - -{-# LANGUAGE ExplicitNamespaces #-} -module Data.Promotion.Prelude ( - -- * Standard types, classes and related functions - -- ** Basic data types - If, Not, type (&&), type (||), Otherwise, - - maybe_, Maybe_, either_, Either_, - - Symbol, - - Fst, Snd, Curry, Uncurry, - - -- * Error reporting - Error, Undefined, - - -- * Promoted equality - module Data.Promotion.Prelude.Eq, - - -- * Promoted comparisons - module Data.Promotion.Prelude.Ord, - - -- * Promoted enumerations - -- | As a matter of convenience, the promoted Prelude does /not/ export - -- promoted @succ@ and @pred@, due to likely conflicts with - -- unary numbers. Please import 'Data.Promotion.Prelude.Enum' directly if - -- you want these. - module Data.Promotion.Prelude.Enum, - - -- * Promoted numbers - module Data.Promotion.Prelude.Num, - type (^), - - -- * Promoted 'Show' - PShow(..), ShowS, SChar, show_, type (<>), Shows, ShowChar, ShowString, ShowParen, - - -- ** Miscellaneous functions - Id, Const, (:.), type ($), type ($!), Flip, AsTypeOf, Until, Seq, - - -- * List operations - Map, type (++), Filter, - Head, Last, Tail, Init, Null, Length, type (!!), - Reverse, - -- ** Reducing lists (folds) - Foldl, Foldl1, Foldr, Foldr1, - -- *** Special folds - And, Or, Any, All, - Sum, Product, - Concat, ConcatMap, - Maximum, Minimum, - -- ** Building lists - -- *** Scans - Scanl, Scanl1, Scanr, Scanr1, - -- *** Infinite lists - Replicate, - -- ** Sublists - Take, Drop, SplitAt, - TakeWhile, DropWhile, Span, Break, - - -- ** Searching lists - Elem, NotElem, Lookup, - -- ** Zipping and unzipping lists - Zip, Zip3, ZipWith, ZipWith3, Unzip, Unzip3, - -- ** Functions on 'Symbol's - Unlines, Unwords, - - -- * Defunctionalization symbols - FalseSym0, TrueSym0, - NotSym0, NotSym1, - type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), - type (||@#@$), type (||@#@$$), type (||@#@$$$), - OtherwiseSym0, - - NothingSym0, JustSym0, JustSym1, - Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3, - - LeftSym0, LeftSym1, RightSym0, RightSym1, - Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3, - - Tuple0Sym0, - Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, - Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, - Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, - Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, - Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, - Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, - FstSym0, FstSym1, SndSym0, SndSym1, - CurrySym0, CurrySym1, CurrySym2, CurrySym3, - UncurrySym0, UncurrySym1, UncurrySym2, - - ErrorSym0, ErrorSym1, UndefinedSym0, - - type (^@#@$), type (^@#@$$), type (^@#@$$$), - - ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, - Show_Sym0, Show_Sym1, - ShowListSym0, ShowListSym1, ShowListSym2, - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), - ShowsSym0, ShowsSym1, ShowsSym2, - ShowCharSym0, ShowCharSym1, ShowCharSym2, - ShowStringSym0, ShowStringSym1, ShowStringSym2, - ShowParenSym0, ShowParenSym1, ShowParenSym2, - - IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - type (.@#@$), type (.@#@$$), type (.@#@$$$), - type ($@#@$), type ($@#@$$), type ($@#@$$$), - type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), - FlipSym0, FlipSym1, FlipSym2, - AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2, - - (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, - MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, - type (++@#@$$), type (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1, - TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, - - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, - - ConcatSym0, ConcatSym1, - ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, - MaximumBySym0, MaximumBySym1, MaximumBySym2, - MinimumBySym0, MinimumBySym1, MinimumBySym2, - AndSym0, AndSym1, OrSym0, OrSym1, - AnySym0, AnySym1, AnySym2, - AllSym0, AllSym1, AllSym2, - - ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, - Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, - ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, - Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, - - ElemSym0, ElemSym1, ElemSym2, - NotElemSym0, NotElemSym1, NotElemSym2, - - ZipSym0, ZipSym1, ZipSym2, - Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, - ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, - ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, - UnzipSym0, UnzipSym1, - - UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1, - - UntilSym0, UntilSym1, UntilSym2, UntilSym3, - LengthSym0, LengthSym1, - SumSym0, SumSym1, - ProductSym0, ProductSym1, - ReplicateSym0, ReplicateSym1, ReplicateSym2, - TakeSym0, TakeSym1, TakeSym2, - DropSym0, DropSym1, DropSym2, - SplitAtSym0, SplitAtSym1, SplitAtSym2, - TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, - DropWhileSym0, DropWhileSym1, DropWhileSym2, - SpanSym0, SpanSym1, SpanSym2, - BreakSym0, BreakSym1, BreakSym2, - LookupSym0, LookupSym1, LookupSym2, - FilterSym0, FilterSym1, FilterSym2, - type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), - ) where - -import Data.Promotion.Prelude.Base -import Data.Promotion.Prelude.Bool -import Data.Promotion.Prelude.Either -import Data.Promotion.Prelude.List -import Data.Promotion.Prelude.Maybe -import Data.Promotion.Prelude.Tuple -import Data.Promotion.Prelude.Eq -import Data.Promotion.Prelude.Ord -import Data.Promotion.Prelude.Enum - hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1) -import Data.Promotion.Prelude.Num -import Data.Promotion.Prelude.Show -import Data.Singletons.TypeLits diff --git a/src/Data/Promotion/Prelude/Base.hs b/src/Data/Promotion/Prelude/Base.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Base.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE TemplateHaskell, KindSignatures, PolyKinds, TypeOperators, - DataKinds, ScopedTypeVariables, TypeFamilies, GADTs, - UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Base --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Implements promoted functions from GHC.Base module. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Prelude@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.Base ( - -- * Promoted functions from @GHC.Base@ - Foldr, Map, type (++), Otherwise, Id, Const, (:.), type ($), type ($!), - Flip, Until, AsTypeOf, Seq, - - -- * Defunctionalization symbols - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - MapSym0, MapSym1, MapSym2, - type (++@#@$), type (++@#@$$), type (++@#@$$$), - OtherwiseSym0, - IdSym0, IdSym1, - ConstSym0, ConstSym1, ConstSym2, - type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), - type ($@#@$), type ($@#@$$), type ($@#@$$$), - type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), - FlipSym0, FlipSym1, FlipSym2, FlipSym3, - UntilSym0, UntilSym1, UntilSym2, UntilSym3, - AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, - SeqSym0, SeqSym1, SeqSym2 - ) where - -import Data.Singletons.TH -import Data.Singletons.Prelude.Base - -$(promoteOnly [d| - -- Does not singletoznize. See #30 - until :: (a -> Bool) -> (a -> a) -> a -> a - until p f = go - where - go x | p x = x - | otherwise = go (f x) - |]) diff --git a/src/Data/Promotion/Prelude/Bool.hs b/src/Data/Promotion/Prelude/Bool.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Bool.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Bool --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to 'Bool', --- including a promoted version of all the definitions in @Data.Bool@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Bool@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.Bool ( - If, - - -- * Promoted functions from @Data.Bool@ - Bool_, bool_, - -- | The preceding two definitions are derived from the function 'bool' in - -- @Data.Bool@. The extra underscore is to avoid name clashes with the type - -- 'Bool'. - - Not, type (&&), type (||), Otherwise, - - -- * Defunctionalization symbols - TrueSym0, FalseSym0, - - NotSym0, NotSym1, - type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), - type (||@#@$), type (||@#@$$), type (||@#@$$$), - Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3, - OtherwiseSym0 - ) where - -import Data.Singletons.Prelude.Bool diff --git a/src/Data/Promotion/Prelude/Either.hs b/src/Data/Promotion/Prelude/Either.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Either.hs +++ /dev/null @@ -1,38 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Either --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : jan.stolarek@p.lodz.pl --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to 'Either', --- including a promoted version of all the definitions in @Data.Either@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Either@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.Either ( - -- * Promoted functions from @Data.Either@ - either_, Either_, - -- | The preceding two definitions are derived from the function 'either' in - -- @Data.Either@. The extra underscore is to avoid name clashes with the type - -- 'Either'. - - Lefts, Rights, PartitionEithers, IsLeft, IsRight, - - -- * Defunctionalization symbols - LeftSym0, LeftSym1, RightSym0, RightSym1, - - Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3, - LeftsSym0, LeftsSym1, RightsSym0, RightsSym1, - IsLeftSym0, IsLeftSym1, IsRightSym0, IsRightSym1 - ) where - -import Data.Singletons.Prelude.Either diff --git a/src/Data/Promotion/Prelude/Enum.hs b/src/Data/Promotion/Prelude/Enum.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Enum.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies, - UndecidableInstances, GADTs #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Enum --- Copyright : (C) 2014 Jan Stolarek, Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Exports promoted versions of 'Enum' and 'Bounded' --- ------------------------------------------------------------------------------ - -module Data.Promotion.Prelude.Enum ( - PBounded(..), PEnum(..), - - -- ** Defunctionalization symbols - MinBoundSym0, - MaxBoundSym0, - SuccSym0, SuccSym1, - PredSym0, PredSym1, - ToEnumSym0, ToEnumSym1, - FromEnumSym0, FromEnumSym1, - EnumFromToSym0, EnumFromToSym1, EnumFromToSym2, - EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2, - EnumFromThenToSym3 - ) where - -import Data.Singletons.Prelude.Enum diff --git a/src/Data/Promotion/Prelude/Eq.hs b/src/Data/Promotion/Prelude/Eq.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Eq.hs +++ /dev/null @@ -1,21 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Eq --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Provided promoted definitions related to type-level equality. --- ------------------------------------------------------------------------------ - -{-# LANGUAGE ExplicitNamespaces #-} -module Data.Promotion.Prelude.Eq ( - PEq(..), - type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (/=@#@$), type (/=@#@$$), type (/=@#@$$$) - ) where - -import Data.Singletons.Prelude.Eq diff --git a/src/Data/Promotion/Prelude/Function.hs b/src/Data/Promotion/Prelude/Function.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Function.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Function --- Copyright : (C) 2016 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions from @Data.Function@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Function@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -{-# LANGUAGE ExplicitNamespaces #-} - -module Data.Promotion.Prelude.Function ( - -- * "Prelude" re-exports - Id, Const, (:.), Flip, type ($) - -- * Other combinators - , type (&), On - - -- * Defunctionalization symbols - , IdSym0, IdSym1 - , ConstSym0, ConstSym1, ConstSym2 - , type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$) - , FlipSym0, FlipSym1, FlipSym2, FlipSym3 - , type ($@#@$), type ($@#@$$), type ($@#@$$$) - , type (&@#@$), type (&@#@$$), type (&@#@$$$) - , OnSym0, OnSym1, OnSym2, OnSym3, OnSym4 - ) where - -import Data.Singletons.Prelude.Function diff --git a/src/Data/Promotion/Prelude/IsString.hs b/src/Data/Promotion/Prelude/IsString.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/IsString.hs +++ /dev/null @@ -1,22 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.IsString --- Copyright : (C) 2017 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Defines and exports a promoted version of the 'IsString' --- type class from "Data.String". ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.IsString ( - PIsString(..), - - -- ** Defunctionalization symbols - FromStringSym0, FromStringSym1 - ) where - -import Data.Singletons.Prelude.IsString -import Data.Singletons.TypeLits () -- for the IsString instance! diff --git a/src/Data/Promotion/Prelude/List.hs b/src/Data/Promotion/Prelude/List.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/List.hs +++ /dev/null @@ -1,309 +0,0 @@ -{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, - TemplateHaskell, GADTs, UndecidableInstances, RankNTypes, - ScopedTypeVariables, MultiWayIf #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.List --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to 'List', --- including a promoted version of all the definitions in @Data.List@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.List@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.List ( - -- * Basic functions - type (++), Head, Last, Tail, Init, Null, Length, - - -- * List transformations - Map, Reverse, Intersperse, Intercalate, Transpose, Subsequences, Permutations, - - -- * Reducing lists (folds) - Foldl, Foldl', Foldl1, Foldl1', Foldr, Foldr1, - - -- ** Special folds - Concat, ConcatMap, And, Or, Any, All, Sum, Product, Maximum, Minimum, - - -- * Building lists - - -- ** Scans - Scanl, Scanl1, Scanr, Scanr1, - - -- ** Accumulating maps - MapAccumL, MapAccumR, - - -- ** Infinite lists - Replicate, - - -- ** Unfolding - Unfoldr, - - -- * Sublists - - -- ** Extracting sublists - Take, Drop, SplitAt, - TakeWhile, DropWhile, DropWhileEnd, Span, Break, - StripPrefix, - Group, - Inits, Tails, - - -- ** Predicates - IsPrefixOf, IsSuffixOf, IsInfixOf, - - -- * Searching lists - - -- ** Searching by equality - Elem, NotElem, Lookup, - - -- ** Searching with a predicate - Find, Filter, Partition, - - -- * Indexing lists - type (!!), ElemIndex, ElemIndices, FindIndex, FindIndices, - - -- * Zipping and unzipping lists - Zip, Zip3, Zip4, Zip5, Zip6, Zip7, - ZipWith, ZipWith3, ZipWith4, ZipWith5, ZipWith6, ZipWith7, - Unzip, Unzip3, Unzip4, Unzip5, Unzip6, Unzip7, - - -- * Special lists - - -- ** Functions on 'Symbol's - Unlines, Unwords, - - -- ** \"Set\" operations - Nub, Delete, type (\\), Union, Intersect, - - -- ** Ordered lists - Sort, Insert, - - -- * Generalized functions - - -- ** The \"@By@\" operations - -- *** User-supplied equality (replacing an @Eq@ context) - NubBy, DeleteBy, DeleteFirstsBy, UnionBy, GroupBy, IntersectBy, - - -- *** User-supplied comparison (replacing an @Ord@ context) - SortBy, InsertBy, - MaximumBy, MinimumBy, - - -- ** The \"@generic@\" operations - GenericLength, GenericTake, GenericDrop, - GenericSplitAt, GenericIndex, GenericReplicate, - - -- * Defunctionalization symbols - NilSym0, - (:@#@$), (:@#@$$), (:@#@$$$), - - type (++@#@$$$), type (++@#@$$), type (++@#@$), - HeadSym0, HeadSym1, LastSym0, LastSym1, - TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, - - MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, - IntersperseSym0, IntersperseSym1, IntersperseSym2, - IntercalateSym0, IntercalateSym1, IntercalateSym2, - SubsequencesSym0, SubsequencesSym1, - PermutationsSym0, PermutationsSym1, - - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, - Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, - Foldl1'Sym0, Foldl1'Sym1, Foldl1'Sym2, - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, - - ConcatSym0, ConcatSym1, - ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, - AndSym0, AndSym1, OrSym0, OrSym1, - AnySym0, AnySym1, AnySym2, - AllSym0, AllSym1, AllSym2, - - ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, - Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, - ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, - Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, - - MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, - MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, - - UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, - - InitsSym0, InitsSym1, TailsSym0, TailsSym1, - - IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, - IsSuffixOfSym0, IsSuffixOfSym1, IsSuffixOfSym2, - IsInfixOfSym0, IsInfixOfSym1, IsInfixOfSym2, - - ElemSym0, ElemSym1, ElemSym2, - NotElemSym0, NotElemSym1, NotElemSym2, - - ZipSym0, ZipSym1, ZipSym2, - Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, - ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, - ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4, - UnzipSym0, UnzipSym1, - Unzip3Sym0, Unzip3Sym1, - Unzip4Sym0, Unzip4Sym1, - Unzip5Sym0, Unzip5Sym1, - Unzip6Sym0, Unzip6Sym1, - Unzip7Sym0, Unzip7Sym1, - - DeleteSym0, DeleteSym1, DeleteSym2, - type (\\@#@$), type (\\@#@$$), type (\\@#@$$$), - IntersectSym0, IntersectSym1, IntersectSym2, - - InsertSym0, InsertSym1, InsertSym2, - SortSym0, SortSym1, - - DeleteBySym0, DeleteBySym1, DeleteBySym2, DeleteBySym3, - DeleteFirstsBySym0, DeleteFirstsBySym1, DeleteFirstsBySym2, DeleteFirstsBySym3, - IntersectBySym0, IntersectBySym1, IntersectBySym2, - - SortBySym0, SortBySym1, SortBySym2, - InsertBySym0, InsertBySym1, InsertBySym2, InsertBySym3, - MaximumBySym0, MaximumBySym1, MaximumBySym2, - MinimumBySym0, MinimumBySym1, MinimumBySym2, - LengthSym0, LengthSym1, - SumSym0, SumSym1, ProductSym0, ProductSym1, - ReplicateSym0, ReplicateSym1, ReplicateSym2, - TransposeSym0, TransposeSym1, - TakeSym0, TakeSym1, TakeSym2, - DropSym0, DropSym1, DropSym2, - SplitAtSym0, SplitAtSym1, SplitAtSym2, - TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, - DropWhileSym0, DropWhileSym1, DropWhileSym2, - DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, - SpanSym0, SpanSym1, SpanSym2, - BreakSym0, BreakSym1, BreakSym2, - StripPrefixSym0, StripPrefixSym1, StripPrefixSym2, - MaximumSym0, MaximumSym1, - MinimumSym0, MinimumSym1, - GroupSym0, GroupSym1, - GroupBySym0, GroupBySym1, GroupBySym2, - LookupSym0, LookupSym1, LookupSym2, - FindSym0, FindSym1, FindSym2, - FilterSym0, FilterSym1, FilterSym2, - PartitionSym0, PartitionSym1, PartitionSym2, - - type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), - - ElemIndexSym0, ElemIndexSym1, ElemIndexSym2, - ElemIndicesSym0, ElemIndicesSym1, ElemIndicesSym2, - FindIndexSym0, FindIndexSym1, FindIndexSym2, - FindIndicesSym0, FindIndicesSym1, FindIndicesSym2, - - Zip4Sym0, Zip4Sym1, Zip4Sym2, Zip4Sym3, Zip4Sym4, - Zip5Sym0, Zip5Sym1, Zip5Sym2, Zip5Sym3, Zip5Sym4, Zip5Sym5, - Zip6Sym0, Zip6Sym1, Zip6Sym2, Zip6Sym3, Zip6Sym4, Zip6Sym5, Zip6Sym6, - Zip7Sym0, Zip7Sym1, Zip7Sym2, Zip7Sym3, Zip7Sym4, Zip7Sym5, Zip7Sym6, Zip7Sym7, - - ZipWith4Sym0, ZipWith4Sym1, ZipWith4Sym2, ZipWith4Sym3, ZipWith4Sym4, ZipWith4Sym5, - ZipWith5Sym0, ZipWith5Sym1, ZipWith5Sym2, ZipWith5Sym3, ZipWith5Sym4, ZipWith5Sym5, ZipWith5Sym6, - ZipWith6Sym0, ZipWith6Sym1, ZipWith6Sym2, ZipWith6Sym3, ZipWith6Sym4, ZipWith6Sym5, ZipWith6Sym6, ZipWith6Sym7, - ZipWith7Sym0, ZipWith7Sym1, ZipWith7Sym2, ZipWith7Sym3, ZipWith7Sym4, ZipWith7Sym5, ZipWith7Sym6, ZipWith7Sym7, ZipWith7Sym8, - - UnlinesSym0, UnlinesSym1, - UnwordsSym0, UnwordsSym1, - - NubSym0, NubSym1, - NubBySym0, NubBySym1, NubBySym2, - UnionSym0, UnionSym1, UnionSym2, - UnionBySym0, UnionBySym1, UnionBySym2, UnionBySym3, - - GenericLengthSym0, GenericLengthSym1, - GenericTakeSym0, GenericTakeSym1, GenericTakeSym2, - GenericDropSym0, GenericDropSym1, GenericDropSym2, - GenericSplitAtSym0, GenericSplitAtSym1, GenericSplitAtSym2, - GenericIndexSym0, GenericIndexSym1, GenericIndexSym2, - GenericReplicateSym0, GenericReplicateSym1, GenericReplicateSym2, - - ) where - -import Data.Singletons.Prelude.Base -import Data.Singletons.Prelude.Eq -import Data.Singletons.Prelude.List -import Data.Singletons.Prelude.Maybe -import Data.Singletons.TH - -$(promoteOnly [d| - - -- Overlapping patterns don't singletonize - stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] - stripPrefix [] ys = Just ys - stripPrefix (x:xs) (y:ys) - | x == y = stripPrefix xs ys - stripPrefix _ _ = Nothing - - -- To singletonize these we would need to rewrite all patterns - -- as non-overlapping. This means 2^7 equations for zipWith7. - - zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] - zip4 = zipWith4 (,,,) - - zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] - zip5 = zipWith5 (,,,,) - - zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> - [(a,b,c,d,e,f)] - zip6 = zipWith6 (,,,,,) - - zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> - [g] -> [(a,b,c,d,e,f,g)] - zip7 = zipWith7 (,,,,,,) - - zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] - zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) - = z a b c d : zipWith4 z as bs cs ds - zipWith4 _ _ _ _ _ = [] - - zipWith5 :: (a->b->c->d->e->f) -> - [a]->[b]->[c]->[d]->[e]->[f] - zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) - = z a b c d e : zipWith5 z as bs cs ds es - zipWith5 _ _ _ _ _ _ = [] - - zipWith6 :: (a->b->c->d->e->f->g) -> - [a]->[b]->[c]->[d]->[e]->[f]->[g] - zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) - = z a b c d e f : zipWith6 z as bs cs ds es fs - zipWith6 _ _ _ _ _ _ _ = [] - - zipWith7 :: (a->b->c->d->e->f->g->h) -> - [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] - zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) - = z a b c d e f g : zipWith7 z as bs cs ds es fs gs - zipWith7 _ _ _ _ _ _ _ _ = [] - --- These functions use Integral or Num typeclass instead of Int. --- --- genericLength, genericTake, genericDrop, genericSplitAt, genericIndex --- genericReplicate --- --- We provide aliases below to improve compatibility - - genericTake :: (Integral i) => i -> [a] -> [a] - genericTake = take - - genericDrop :: (Integral i) => i -> [a] -> [a] - genericDrop = drop - - genericSplitAt :: (Integral i) => i -> [a] -> ([a], [a]) - genericSplitAt = splitAt - - genericIndex :: (Integral i) => [a] -> i -> a - genericIndex = (!!) - - genericReplicate :: (Integral i) => i -> a -> [a] - genericReplicate = replicate - |]) diff --git a/src/Data/Promotion/Prelude/List/NonEmpty.hs b/src/Data/Promotion/Prelude/List/NonEmpty.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/List/NonEmpty.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.List.NonEmpty --- Copyright : (C) 2016 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Defines functions and datatypes relating to promoting 'NonEmpty', --- including promoted versions of many of the definitions in @Data.List.NonEmpty@. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.List.NonEmpty ( - - -- * Non-empty stream transformations - Map, - Intersperse, - Scanl, - Scanr, - Scanl1, - Scanr1, - Transpose, - SortBy, - SortWith, - Length, - Head, - Tail, - Last, - Init, - type (<|), - Cons, - Uncons, - Unfoldr, - Sort, - Reverse, - Inits, - Tails, - Unfold, - Insert, - Take, - Drop, - SplitAt, - TakeWhile, - DropWhile, - Span, - Break, - Filter, - Partition, - Group, - GroupBy, - GroupWith, - GroupAllWith, - Group1, - GroupBy1, - GroupWith1, - GroupAllWith1, - IsPrefixOf, - Nub, - NubBy, - type (!!), - Zip, - ZipWith, - Unzip, - FromList, - ToList, - NonEmpty_, - Xor, - - -- * Defunctionalization symbols - (:|@#@$), (:|@#@$$), (:|@#@$$$), - MapSym0, MapSym1, MapSym2, - IntersperseSym0, IntersperseSym1, IntersperseSym2, - ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, - ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, - Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, - Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, - TransposeSym0, TransposeSym1, - SortBySym0, SortBySym1, SortBySym2, - SortWithSym0, SortWithSym1, SortWithSym2, - LengthSym0, LengthSym1, - HeadSym0, HeadSym1, - TailSym0, TailSym1, - LastSym0, LastSym1, - InitSym0, InitSym1, - type (<|@#@$), type (<|@#@$$), type (<|@#@$$$), - ConsSym0, ConsSym1, ConsSym2, - UnconsSym0, UnconsSym1, - UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, - SortSym0, SortSym1, - ReverseSym0, ReverseSym1, - InitsSym0, InitsSym1, - TailsSym0, TailsSym1, - UnfoldSym0, UnfoldSym1, - InsertSym0, InsertSym1, InsertSym2, - TakeSym0, TakeSym1, TakeSym2, - DropSym0, DropSym1, DropSym2, - SplitAtSym0, SplitAtSym1, SplitAtSym2, - TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, - DropWhileSym0, DropWhileSym1, DropWhileSym2, - SpanSym0, SpanSym1, SpanSym2, - BreakSym0, BreakSym1, BreakSym2, - FilterSym0, FilterSym1, FilterSym2, - PartitionSym0, PartitionSym1, PartitionSym2, - GroupSym0, GroupSym1, - GroupBySym0, GroupBySym1, GroupBySym2, - GroupWithSym0, GroupWithSym1, GroupWithSym2, - GroupAllWithSym0, GroupAllWithSym1, GroupAllWithSym2, - Group1Sym0, Group1Sym1, - GroupBy1Sym0, GroupBy1Sym1, GroupBy1Sym2, - GroupWith1Sym0, GroupWith1Sym1, GroupWith1Sym2, - GroupAllWith1Sym0, GroupAllWith1Sym1, GroupAllWith1Sym2, - IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, - NubSym0, NubSym1, - NubBySym0, NubBySym1, NubBySym2, - type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), - ZipSym0, ZipSym1, ZipSym2, - ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, - UnzipSym0, UnzipSym1, - FromListSym0, FromListSym1, - ToListSym0, ToListSym1, - NonEmpty_Sym0, NonEmpty_Sym1, - XorSym0, XorSym1 - ) where - -import Data.Singletons.Prelude.List.NonEmpty diff --git a/src/Data/Promotion/Prelude/Maybe.hs b/src/Data/Promotion/Prelude/Maybe.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Maybe.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Maybe --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to 'Maybe', --- including a promoted version of all the definitions in @Data.Maybe@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Maybe@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - - -module Data.Promotion.Prelude.Maybe ( - -- * Promoted functions from @Data.Maybe@ - maybe_, Maybe_, - -- | The preceding two definitions is derived from the function 'maybe' in - -- @Data.Maybe@. The extra underscore is to avoid name clashes with the type - -- 'Maybe'. - - IsJust, IsNothing, FromJust, FromMaybe, MaybeToList, - ListToMaybe, CatMaybes, MapMaybe, - - -- * Defunctionalization symbols - NothingSym0, JustSym0, JustSym1, - - Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3, - IsJustSym0, IsJustSym1, IsNothingSym0, IsNothingSym1, - FromJustSym0, FromJustSym1, FromMaybeSym0, FromMaybeSym1, FromMaybeSym2, - MaybeToListSym0, MaybeToListSym1, ListToMaybeSym0, ListToMaybeSym1, - CatMaybesSym0, CatMaybesSym1, MapMaybeSym0, MapMaybeSym1, MapMaybeSym2 - ) where - -import Data.Singletons.Prelude.Maybe diff --git a/src/Data/Promotion/Prelude/Num.hs b/src/Data/Promotion/Prelude/Num.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Num.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Num --- Copyright : (C) 2014 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Defines and exports promoted and singleton versions of definitions from --- GHC.Num. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.Num ( - PNum(..), Subtract, - - -- ** Defunctionalization symbols - type (+@#@$), type (+@#@$$), type (+@#@$$$), - type (-@#@$), type (-@#@$$), type (-@#@$$$), - type (*@#@$), type (*@#@$$), type (*@#@$$$), - NegateSym0, NegateSym1, - AbsSym0, AbsSym1, - SignumSym0, SignumSym1, - FromIntegerSym0, FromIntegerSym1, - SubtractSym0, SubtractSym1, SubtractSym2 - ) where - -import Data.Singletons.Prelude.Num -import Data.Singletons.TypeLits () -- for the Num instance! diff --git a/src/Data/Promotion/Prelude/Ord.hs b/src/Data/Promotion/Prelude/Ord.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Ord.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Ord --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Provides promoted definitions related to type-level comparisons. --- ------------------------------------------------------------------------------ - -module Data.Promotion.Prelude.Ord ( - POrd(..), - - Comparing, - ThenCmp, - - -- ** Defunctionalization symbols - ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, - LTSym0, EQSym0, GTSym0, - CompareSym0, CompareSym1, CompareSym2, - type (<@#@$), type (<@#@$$), type (<@#@$$$), - type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), - type (>@#@$), type (>@#@$$), type (>@#@$$$), - type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), - MaxSym0, MaxSym1, MaxSym2, - MinSym0, MinSym1, MinSym2, - ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3 - ) where - -import Data.Singletons.Prelude.Ord diff --git a/src/Data/Promotion/Prelude/Show.hs b/src/Data/Promotion/Prelude/Show.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Show.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Show --- Copyright : (C) 2014 Jan Stolarek, Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Exports a promoted version of 'Show' --- ------------------------------------------------------------------------------ - -module Data.Promotion.Prelude.Show ( - PShow(..), SymbolS, SChar, show_, type (<>), - Shows, ShowListWith, ShowChar, ShowString, ShowParen, - ShowSpace, ShowCommaSpace, AppPrec, AppPrec1, - - -- * Defunctionalization symbols - ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, - Show_Sym0, Show_Sym1, - ShowListSym0, ShowListSym1, ShowListSym2, - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), - ShowsSym0, ShowsSym1, ShowsSym2, - ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3, - ShowCharSym0, ShowCharSym1, ShowCharSym2, - ShowStringSym0, ShowStringSym1, ShowStringSym2, - ShowParenSym0, ShowParenSym1, ShowParenSym2, - ShowSpaceSym0, ShowSpaceSym1, - ShowCommaSpaceSym0, ShowCommaSpaceSym1, - AppPrecSym0, AppPrec1Sym0 - ) where - -import Data.Singletons.Prelude.Show diff --git a/src/Data/Promotion/Prelude/Tuple.hs b/src/Data/Promotion/Prelude/Tuple.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Tuple.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | --- Module : Data.Promotion.Prelude.Tuple --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to tuples, --- including a promoted version of all the definitions in @Data.Tuple@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Tuple@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- - -module Data.Promotion.Prelude.Tuple ( - -- * Promoted functions from @Data.Tuple@ - Fst, Snd, Curry, Uncurry, Swap, - - -- * Defunctionalization symbols - Tuple0Sym0, - Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, - Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, - Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, - Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, - Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, - Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, - - FstSym0, FstSym1, SndSym0, SndSym1, - CurrySym0, CurrySym1, CurrySym2, CurrySym3, - UncurrySym0, UncurrySym1, UncurrySym2, - SwapSym0, SwapSym1 - ) where - -import Data.Singletons.Prelude.Tuple diff --git a/src/Data/Promotion/Prelude/Void.hs b/src/Data/Promotion/Prelude/Void.hs deleted file mode 100644 --- a/src/Data/Promotion/Prelude/Void.hs +++ /dev/null @@ -1,28 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.Prelude.Void --- Copyright : (C) 2014 Jan Stolarek --- License : BSD-style (see LICENSE) --- Maintainer : jan.stolarek@p.lodz.pl --- Stability : experimental --- Portability : non-portable --- --- Defines promoted functions and datatypes relating to 'Void', --- including a promoted version of all the definitions in @Data.Void@. --- --- Because many of these definitions are produced by Template Haskell, --- it is not possible to create proper Haddock documentation. Please look --- up the corresponding operation in @Data.Void@. Also, please excuse --- the apparent repeated variable names. This is due to an interaction --- between Template Haskell and Haddock. --- ----------------------------------------------------------------------------- -module Data.Promotion.Prelude.Void ( - -- * Promoted functions from from @Data.Void@ - Absurd, - - -- * Defunctionalization symbols - AbsurdSym0, AbsurdSym1 - ) where - -import Data.Singletons.Prelude.Void diff --git a/src/Data/Promotion/TH.hs b/src/Data/Promotion/TH.hs deleted file mode 100644 --- a/src/Data/Promotion/TH.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Promotion.TH --- Copyright : (C) 2013 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- This module contains everything you need to promote your own functions via --- Template Haskell. --- ----------------------------------------------------------------------------- - -module Data.Promotion.TH ( - -- * Primary Template Haskell generation functions - promote, promoteOnly, genDefunSymbols, genPromotions, - - -- ** Functions to generate @Eq@ instances - promoteEqInstances, promoteEqInstance, - - -- ** Functions to generate @Ord@ instances - promoteOrdInstances, promoteOrdInstance, - - -- ** Functions to generate @Bounded@ instances - promoteBoundedInstances, promoteBoundedInstance, - - -- ** Functions to generate @Enum@ instances - promoteEnumInstances, promoteEnumInstance, - - -- ** Functions to generate @Show@ instances - promoteShowInstances, promoteShowInstance, - - -- ** defunctionalization - TyFun, Apply, type (@@), - - -- * Auxiliary definitions - -- | These definitions might be mentioned in code generated by Template Haskell, - -- so they must be in scope. - - PEq(..), If, type (&&), - POrd(..), ThenCmp, Foldl, - PBounded(..), - PEnum(FromEnum, ToEnum), - PShow(..), - ShowString, ShowParen, ShowSpace, ShowChar, ShowCommaSpace, - (:.), - Proxy(..), - - Error, ErrorSym0, ErrorSym1, - Undefined, UndefinedSym0, - TrueSym0, FalseSym0, - type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (>@#@$), type (>@#@$$), type (>@#@$$$), - LTSym0, EQSym0, GTSym0, - Tuple0Sym0, - Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, - Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, - Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, - Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, - Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, - Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, - CompareSym0, CompareSym1, CompareSym2, - ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - MinBoundSym0, MaxBoundSym0, - ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, - ShowStringSym0, ShowStringSym1, ShowStringSym2, - ShowParenSym0, ShowParenSym1, ShowParenSym2, - ShowSpaceSym0, ShowSpaceSym1, - ShowCharSym0, ShowCharSym1, ShowCharSym2, - ShowCommaSpaceSym0, ShowCommaSpaceSym1, - type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), - (:@#@$), (:@#@$$), (:@#@$$$), - - SuppressUnusedWarnings(..) - - ) where - -import Data.Singletons.Internal -import Data.Singletons.Promote -import Data.Singletons.Prelude.Base -import Data.Singletons.Prelude.Instances -import Data.Singletons.Prelude.Bool -import Data.Singletons.Prelude.Enum -import Data.Singletons.Prelude.Eq -import Data.Singletons.Prelude.Ord -import Data.Singletons.Prelude.Show -import Data.Singletons.TypeLits -import Data.Singletons.SuppressUnusedWarnings diff --git a/src/Data/Singletons.hs b/src/Data/Singletons.hs --- a/src/Data/Singletons.hs +++ b/src/Data/Singletons.hs @@ -1,12 +1,16 @@ {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- @@ -14,7 +18,7 @@ -- Module : Data.Singletons -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -79,12 +83,14 @@ type (@@@#@$), type (@@@#@$$), type (@@@#@$$$) ) where -import Data.Singletons.Promote import Data.Singletons.Internal import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq -import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Semigroup +import Data.Singletons.Promote import Data.Singletons.ShowSing ---------------------------------------------------------------------- @@ -125,9 +131,13 @@ signum (SomeSing a) = SomeSing (sSignum a) fromInteger n = withSomeSing (fromIntegral n) (SomeSing . sFromInteger) -instance ShowSing k => Show (SomeSing k) where - showsPrec p (SomeSing s) = - showParen (p > 10) $ showString "SomeSing " . showsSingPrec 11 s +deriving instance ShowSing k => Show (SomeSing k) + +instance SSemigroup k => Semigroup (SomeSing k) where + SomeSing a <> SomeSing b = SomeSing (a %<> b) + +instance SMonoid k => Monoid (SomeSing k) where + mempty = SomeSing sMempty ---------------------------------------------------------------------- ---- Defunctionalization symbols ------------------------------------- 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 @@ -5,7 +5,7 @@ -- Module : Data.Singletons.CustomStar -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -75,42 +75,47 @@ singletonStar names = do kinds <- mapM getKind names ctors <- zipWithM (mkCtor True) names kinds - let repDecl = DDataD Data [] repName [] ctors + let repDecl = DDataD Data [] repName [] (Just (DConT typeKindName)) ctors [DDerivClause Nothing (map DConPr [''Eq, ''Ord, ''Read, ''Show])] fakeCtors <- zipWithM (mkCtor False) names kinds - let dataDecl = DataDecl Data repName [] fakeCtors - [DConPr ''Show, DConPr ''Read] - -- We opt to infer the constraints for the Eq instance here so that when it's - -- promoted, Rep will be promoted to Type. - dataDeclEqCxt <- inferConstraints (DConPr ''Eq) (DConT repName) fakeCtors - let dataDeclEqInst = DerivedDecl (Just dataDeclEqCxt) (DConT repName) fakeCtors - ordInst <- mkOrdInstance Nothing (DConT repName) fakeCtors - showInst <- mkShowInstance ForPromotion Nothing (DConT repName) fakeCtors - (pInsts, promDecls) <- promoteM [] $ do promoteDataDec dataDecl - promoteDerivedEqDec dataDeclEqInst - traverse (promoteInstanceDec mempty) - [ordInst, showInst] - singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl - decs2 <- singDerivedEqDecs dataDeclEqInst - decs3 <- traverse singInstD pInsts - return (decs1 ++ decs2 ++ decs3) - return $ decsToTH $ repDecl : - promDecls ++ - singletonDecls + let dataDecl = DataDecl repName [] fakeCtors + -- Why do we need withLocalDeclarations here? It's because we end up + -- expanding type synonyms when deriving instances for Rep, which requires + -- reifying Rep itself. Since Rep hasn't been spliced in yet, we must put it + -- into the local declarations. + withLocalDeclarations (decToTH repDecl) $ do + -- We opt to infer the constraints for the Eq instance here so that when it's + -- promoted, Rep will be promoted to Type. + dataDeclEqCxt <- inferConstraints (DConPr ''Eq) (DConT repName) fakeCtors + let dataDeclEqInst = DerivedDecl (Just dataDeclEqCxt) (DConT repName) dataDecl + ordInst <- mkOrdInstance Nothing (DConT repName) dataDecl + showInst <- mkShowInstance Nothing (DConT repName) dataDecl + (pInsts, promDecls) <- promoteM [] $ do promoteDataDec dataDecl + promoteDerivedEqDec dataDeclEqInst + traverse (promoteInstanceDec mempty) + [ordInst, showInst] + singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl + decs2 <- singDerivedEqDecs dataDeclEqInst + decs3 <- traverse singInstD pInsts + return (decs1 ++ decs2 ++ decs3) + return $ decsToTH $ repDecl : + promDecls ++ + singletonDecls where -- get the kinds of the arguments to the tycon with the given name getKind :: DsMonad q => Name -> q [DKind] getKind name = do - info <- reifyWithWarning name + info <- reifyWithLocals name dinfo <- dsInfo info case dinfo of - DTyConI (DDataD _ (_:_) _ _ _ _) _ -> - fail "Cannot make a representation of a constrainted data type" - DTyConI (DDataD _ [] _ tvbs _ _) _ -> - return $ map (fromMaybe DStarT . extractTvbKind) tvbs + DTyConI (DDataD _ (_:_) _ _ _ _ _) _ -> + fail "Cannot make a representation of a constrained data type" + DTyConI (DDataD _ [] _ tvbs mk _ _) _ -> do + all_tvbs <- buildDataDTvbs tvbs mk + return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) all_tvbs DTyConI (DTySynD _ tvbs _) _ -> - return $ map (fromMaybe DStarT . extractTvbKind) tvbs + return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) tvbs DPrimTyConI _ n _ -> - return $ replicate n DStarT + return $ replicate n $ DConT typeKindName _ -> fail $ "Invalid thing for representation: " ++ (show name) -- first parameter is whether this is a real ctor (with a fresh name) @@ -121,7 +126,7 @@ dataName <- if real then mkDataName (nameBase name) else return name return $ DCon (map DPlainTV vars) [] dataName (DNormalC False (map (\ty -> (noBang, ty)) types)) - Nothing + (DConT repName) where noBang = Bang NoSourceUnpackedness NoSourceStrictness @@ -138,8 +143,9 @@ kindToType args (DVarT n) = do addElement n return $ DVarT n `foldType` args - kindToType args (DConT n) = return $ DConT n `foldType` args + kindToType args (DConT n) = return $ DConT name `foldType` args + where name | isTypeKindName n = repName + | otherwise = n kindToType args DArrowT = return $ DArrowT `foldType` args kindToType args k@(DLitT {}) = return $ k `foldType` args kindToType args DWildCardT = return $ DWildCardT `foldType` args - kindToType args DStarT = return $ DConT repName `foldType` args 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,4 +1,4 @@ -{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators, TypeInType, +{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances, GADTs #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -7,7 +7,7 @@ -- Module : Data.Singletons.Decide -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -23,7 +23,7 @@ (:~:)(..), Void, Refuted, Decision(..) ) where -import Data.Kind +import Data.Kind (Type) import Data.Singletons.Internal import Data.Type.Coercion import Data.Type.Equality 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Deriving.Bounded -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -19,12 +19,13 @@ import Data.Singletons.Util import Data.Singletons.Syntax import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util import Control.Monad -- monadic only for failure and parallelism with other functions -- that make instances -mkBoundedInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl -mkBoundedInstance mb_ctxt ty cons = do +mkBoundedInstance :: DsMonad q => DerivDesc q +mkBoundedInstance mb_ctxt ty (DataDecl _ _ cons) = do -- We can derive instance of Bounded if datatype is an enumeration (all -- constructors must be nullary) or has only one constructor. See Section 11 -- of Haskell 2010 Language Report. @@ -53,5 +54,6 @@ return $ InstDecl { id_cxt = constraints , id_name = boundedName , id_arg_tys = [ty] + , id_sigs = mempty , id_meths = [ (minBoundName, mk_rhs minRHS) , (maxBoundName, mk_rhs maxRHS) ] } 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Deriving.Enum -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -16,6 +16,7 @@ import Language.Haskell.TH.Syntax import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar +import Data.Singletons.Deriving.Util import Data.Singletons.Syntax import Data.Singletons.Util import Data.Singletons.Names @@ -23,13 +24,13 @@ import Data.Maybe -- monadic for failure only -mkEnumInstance :: Quasi q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl -mkEnumInstance mb_ctxt ty cons = do +mkEnumInstance :: DsMonad q => DerivDesc q +mkEnumInstance mb_ctxt ty (DataDecl data_name tvbs cons) = do + let data_ty = foldTypeTvbs (DConT data_name) tvbs + non_vanilla <- isNonVanillaDataType data_ty cons when (null cons || - any (\(DCon tvbs cxt _ f rty) -> or [ not $ null $ tysOfConFields f - , not $ null tvbs - , not $ null cxt - , isJust rty ]) cons) $ + any (\(DCon _ _ _ f _) -> + non_vanilla || not (null $ tysOfConFields f)) cons) $ fail ("Can't derive Enum instance for " ++ pprint (typeToTH ty) ++ ".") n <- qNewName "n" let to_enum = UFunction [DClause [DVarPa n] (to_enum_rhs cons [0..])] @@ -49,5 +50,6 @@ -- to use Nat instead of Int , id_arg_tys = [ty] + , id_sigs = mempty , id_meths = [ (singletonsToEnumName, to_enum) , (singletonsFromEnumName, from_enum) ] }) diff --git a/src/Data/Singletons/Deriving/Foldable.hs b/src/Data/Singletons/Deriving/Foldable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Deriving/Foldable.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Deriving.Foldable +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Implements deriving of Foldable instances +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Deriving.Foldable where + +import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util +import Data.Singletons.Names +import Data.Singletons.Syntax +import Language.Haskell.TH.Desugar + +mkFoldableInstance :: forall q. DsMonad q => DerivDesc q +mkFoldableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do + functorLikeValidityChecks False dd + f <- newUniqueName "_f" + z <- newUniqueName "_z" + let ft_foldMap :: FFoldType (q DExp) + ft_foldMap = FT { ft_triv = mkSimpleLam $ \_ -> pure $ DVarE memptyName + -- foldMap f = \x -> mempty + , ft_var = pure $ DVarE f + -- foldMap f = f + , ft_ty_app = \_ g -> DAppE (DVarE foldMapName) <$> g + -- foldMap f = foldMap g + , ft_forall = \_ g -> g + , ft_bad_app = error "in other argument in ft_foldMap" + } + + ft_foldr :: FFoldType (q DExp) + ft_foldr = FT { ft_triv = mkSimpleLam2 $ \_ z' -> pure z' + -- foldr f = \x z -> z + , ft_var = pure $ DVarE f + -- foldr f = f + , ft_ty_app = \_ g -> do + gg <- g + mkSimpleLam2 $ \x z' -> pure $ + DVarE foldrName `DAppE` gg `DAppE` z' `DAppE` x + -- foldr f = (\x z -> foldr g z x) + , ft_forall = \_ g -> g + , ft_bad_app = error "in other argument in ft_foldr" + } + + clause_for_foldMap :: [DPat] -> DCon -> [DExp] -> q DClause + clause_for_foldMap = mkSimpleConClause $ \_ -> mkFoldMap + where + -- mappend v1 (mappend v2 ..) + mkFoldMap :: [DExp] -> DExp + mkFoldMap [] = DVarE memptyName + mkFoldMap xs = foldr1 (\x y -> DVarE mappendName `DAppE` x `DAppE` y) xs + + clause_for_foldr :: [DPat] -> DCon -> [DExp] -> q DClause + clause_for_foldr = mkSimpleConClause $ \_ -> mkFoldr + where + -- g1 v1 (g2 v2 (.. z)) + mkFoldr :: [DExp] -> DExp + mkFoldr = foldr DAppE (DVarE z) + + mk_foldMap_clause :: DCon -> q DClause + mk_foldMap_clause con = do + parts <- foldDataConArgs ft_foldMap con + clause_for_foldMap [DVarPa f] con =<< sequence parts + + mk_foldr_clause :: DCon -> q DClause + mk_foldr_clause con = do + parts <- foldDataConArgs ft_foldr con + clause_for_foldr [DVarPa f, DVarPa z] con =<< sequence parts + + mk_foldMap :: q [DClause] + mk_foldMap = + case cons of + [] -> pure [DClause [DWildPa, DWildPa] (DVarE memptyName)] + _ -> traverse mk_foldMap_clause cons + + mk_foldr :: q [DClause] + mk_foldr = traverse mk_foldr_clause cons + + foldMap_clauses <- mk_foldMap + foldr_clauses <- mk_foldr + let meths = (foldMapName, UFunction foldMap_clauses) + : case cons of + [] -> [] + _ -> [(foldrName, UFunction foldr_clauses)] + constraints <- inferConstraintsDef mb_ctxt (DConPr foldableName) ty cons + return $ InstDecl { id_cxt = constraints + , id_name = foldableName + , id_arg_tys = [ty] + , id_sigs = mempty + , id_meths = meths } diff --git a/src/Data/Singletons/Deriving/Functor.hs b/src/Data/Singletons/Deriving/Functor.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Deriving/Functor.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Deriving.Functor +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Implements deriving of Functor instances +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Deriving.Functor where + +import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util +import Data.Singletons.Names +import Data.Singletons.Syntax +import Data.Singletons.Util +import Language.Haskell.TH.Desugar + +mkFunctorInstance :: forall q. DsMonad q => DerivDesc q +mkFunctorInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do + functorLikeValidityChecks False dd + f <- newUniqueName "_f" + z <- newUniqueName "_z" + let ft_fmap :: FFoldType (q DExp) + ft_fmap = FT { ft_triv = mkSimpleLam pure + -- fmap f = \x -> x + , ft_var = pure $ DVarE f + -- fmap f = f + , ft_ty_app = \_ g -> DAppE (DVarE fmapName) <$> g + -- fmap f = fmap g + , ft_forall = \_ g -> g + , ft_bad_app = error "in other argument in ft_fmap" + } + + ft_replace :: FFoldType (q Replacer) + ft_replace = FT { ft_triv = fmap Nested $ mkSimpleLam pure + -- (p <$) = \x -> x + , ft_var = fmap Immediate $ mkSimpleLam $ \_ -> pure $ DVarE z + -- (p <$) = const p + , ft_ty_app = \_ gm -> do + g <- gm + case g of + Nested g' -> pure . Nested $ DVarE fmapName `DAppE` g' + Immediate _ -> pure . Nested $ DVarE replaceName `DAppE` DVarE z + -- (p <$) = fmap (p <$) + , ft_forall = \_ g -> g + , ft_bad_app = error "in other argument in ft_replace" + } + + -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ... + clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause + clause_for_con = mkSimpleConClause $ \con_name -> + foldExp (DConE con_name) -- Con x1 x2 ... + + mk_fmap_clause :: DCon -> q DClause + mk_fmap_clause con = do + parts <- foldDataConArgs ft_fmap con + clause_for_con [DVarPa f] con =<< sequence parts + + mk_replace_clause :: DCon -> q DClause + mk_replace_clause con = do + parts <- foldDataConArgs ft_replace con + clause_for_con [DVarPa z] con =<< traverse (fmap replace) parts + + mk_fmap :: q [DClause] + mk_fmap = case cons of + [] -> do v <- newUniqueName "v" + pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] + _ -> traverse mk_fmap_clause cons + + mk_replace :: q [DClause] + mk_replace = case cons of + [] -> do v <- newUniqueName "v" + pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] + _ -> traverse mk_replace_clause cons + + fmap_clauses <- mk_fmap + replace_clauses <- mk_replace + constraints <- inferConstraintsDef mb_ctxt (DConPr functorName) ty cons + return $ InstDecl { id_cxt = constraints + , id_name = functorName + , id_arg_tys = [ty] + , id_sigs = mempty + , id_meths = [ (fmapName, UFunction fmap_clauses) + , (replaceName, UFunction replace_clauses) + ] } + +data Replacer = Immediate { replace :: DExp } + | Nested { replace :: DExp } 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 @@ -5,7 +5,7 @@ -- Module : Data.Singletons.Deriving.Infer -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -16,8 +16,11 @@ module Data.Singletons.Deriving.Infer ( inferConstraints, inferConstraintsDef ) where import Language.Haskell.TH.Desugar +import Language.Haskell.TH.Syntax +import Data.Singletons.Deriving.Util import Data.Singletons.Util import Data.List +import Data.List.NonEmpty (NonEmpty(..)) import Data.Generics.Twins -- @inferConstraints cls inst_ty cons@ infers the instance context for a @@ -91,21 +94,66 @@ -- 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 + infer_ct (DCon _ _ _ fields 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' + -- We need to match the constructor's result type with the type given + -- in the generated instance. But if we have: + -- + -- data Foo a where + -- MkFoo :: a -> Foo a + -- deriving Functor + -- + -- Then the generated instance will be: + -- + -- instance Functor Foo where ... + -- + -- Which means that if we're not careful, we might try to match the + -- types (Foo a) and (Foo), which will fail. + -- + -- To avoid this, we employ a grimy hack where we pad the instance + -- type with an extra (dummy) type variable. It doesn't matter what + -- we name it, since none of the inferred constraints will mention + -- it anyway. + eta_expanded_inst_ty + | is_functor_like = inst_ty `DAppT` DVarT (mkName "dummy") + | otherwise = inst_ty + res_ty' <- expandType res_ty + inst_ty' <- expandType eta_expanded_inst_ty + field_tys' <- case matchTy YesIgnore res_ty' inst_ty' of + Nothing -> fail $ showString "Unable to match type " + . showsPrec 11 res_ty' + . showString " with " + . showsPrec 11 inst_ty' + $ "" + Just subst -> traverse (substTy subst) field_tys + if is_functor_like + then mk_functor_like_constraints field_tys' res_ty' + else pure $ map (pr `DAppPr`) field_tys' + + -- If we derive a Functor-like class, e.g., + -- + -- data Foo f g h a = MkFoo (f a) (g (h a)) deriving Functor + -- + -- Then we infer constraints by sticking Functor on the subtypes of kind + -- (Type -> Type). In the example above, that would give us + -- (Functor f, Functor g, Functor h). + mk_functor_like_constraints :: [DType] -> DType -> q DCxt + mk_functor_like_constraints fields res_ty = do + -- This function is partial. But that's OK, because + -- functorLikeValidityChecks ensures that this is total by the time + -- we invoke this. + let _ :| res_ty_args = unfoldType res_ty + (_, last_res_ty_arg) = snocView res_ty_args + Just last_tv = getDVarTName_maybe last_res_ty_arg + deep_subtypes <- concatMapM (deepSubtypesContaining last_tv) fields + pure $ map (pr `DAppPr`) deep_subtypes + + is_functor_like :: Bool + is_functor_like + | DConT pr_class_name :| _ <- unfoldType (predToType pr) + = isFunctorLikeClassName pr_class_name + | otherwise + = False -- For @inferConstraintsDef mb_cxt@, if @mb_cxt@ is 'Just' a context, then it will -- simply return that context. Otherwise, if @mb_cxt@ is 'Nothing', then 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Deriving.Ord -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -18,11 +18,12 @@ import Data.Singletons.Util import Language.Haskell.TH.Syntax import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util import Data.Singletons.Syntax -- | Make a *non-singleton* Ord instance -mkOrdInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl -mkOrdInstance mb_ctxt ty cons = do +mkOrdInstance :: DsMonad q => DerivDesc q +mkOrdInstance mb_ctxt ty (DataDecl _ _ cons) = do constraints <- inferConstraintsDef mb_ctxt (DConPr ordName) ty cons compare_eq_clauses <- mapM mk_equal_clause cons let compare_noneq_clauses = map (uncurry mk_nonequal_clause) @@ -36,6 +37,7 @@ return (InstDecl { id_cxt = constraints , id_name = ordName , id_arg_tys = [ty] + , id_sigs = mempty , id_meths = [(compareName, UFunction clauses)] }) mk_equal_clause :: Quasi q => DCon -> q DClause diff --git a/src/Data/Singletons/Deriving/Show.hs b/src/Data/Singletons/Deriving/Show.hs --- a/src/Data/Singletons/Deriving/Show.hs +++ b/src/Data/Singletons/Deriving/Show.hs @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Deriving.Show -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -13,8 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Data.Singletons.Deriving.Show ( mkShowInstance - , ShowMode(..) - , mkShowContext + , mkShowSingContext ) where import Language.Haskell.TH.Syntax hiding (showName) @@ -23,82 +22,66 @@ import Data.Singletons.Util import Data.Singletons.Syntax import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util import Data.Maybe (fromMaybe) import GHC.Lexeme (startsConSym, startsVarSym) import GHC.Show (appPrec, appPrec1) -mkShowInstance :: DsMonad q - => 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 +mkShowInstance :: DsMonad q => DerivDesc q +mkShowInstance mb_ctxt ty (DataDecl _ _ cons) = do + clauses <- mk_showsPrec cons + constraints <- inferConstraintsDef mb_ctxt (DConPr showName) ty cons return $ InstDecl { id_cxt = constraints - , id_name = mk_Show_name mode + , id_name = showName , id_arg_tys = [ty] - , id_meths = [ (mk_showsPrec_name mode, UFunction clauses) ] } + , id_sigs = mempty + , id_meths = [ (showsPrecName, UFunction clauses) ] } -mk_showsPrec :: DsMonad q => ShowMode -> [DCon] -> q [DClause] -mk_showsPrec mode cons = do +mk_showsPrec :: DsMonad q => [DCon] -> q [DClause] +mk_showsPrec cons = do p <- newUniqueName "p" -- The precedence argument (not always used) if null cons then do v <- newUniqueName "v" pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] - else mapM (mk_showsPrec_clause mode p) cons + else mapM (mk_showsPrec_clause p) cons mk_showsPrec_clause :: forall q. DsMonad q - => ShowMode -> Name -> DCon + => Name -> DCon -> q DClause -mk_showsPrec_clause mode p (DCon _ _ con_name con_fields _) = go con_fields +mk_showsPrec_clause 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' "") + 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 True [_, _]) = do + argL <- newUniqueName "argL" + argR <- newUniqueName "argR" + fi <- fromMaybe defaultFixity <$> reifyFixityWithLocals con_name + let con_prec = case fi of Fixity prec _ -> prec + op_name = nameBase con_name + infixOpE = DAppE (DVarE showStringName) . dStringE $ + if isInfixDataCon op_name + then " " ++ op_name ++ " " + -- Make sure to handle infix data constructors + -- like (Int `Foo` Int) + else " `" ++ op_name ++ "` " + return $ DClause [DVarPa p, DConPa con_name [DVarPa argL, DVarPa argR]] $ + (DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p + `DAppE` dIntegerE con_prec)) + `DAppE` (DVarE composeName + `DAppE` showsPrecE (con_prec + 1) argL + `DAppE` (DVarE composeName + `DAppE` infixOpE + `DAppE` showsPrecE (con_prec + 1) argR)) go (DNormalC _ tys) = do args <- mapM (const $ newUniqueName "arg") tys - let show_args = map (showsPrecE mode appPrec1) args + let show_args = map (showsPrecE appPrec1) args composed_args = foldr1 (\v q -> DVarE composeName `DAppE` v `DAppE` (DVarE composeName @@ -106,9 +89,9 @@ `DAppE` q)) show_args named_args = DVarE composeName `DAppE` (DVarE showStringName - `DAppE` dStringE (parenInfixConName con_name' " ")) + `DAppE` dStringE (parenInfixConName con_name " ")) `DAppE` composed_args - return $ DClause [DVarPa p, DConPa con_name' $ map DVarPa 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 @@ -121,27 +104,24 @@ 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' + let 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 + , showsPrecE 0 arg , DVarE showCommaSpaceName ]) (zip tys args) - brace_comma_args = (DVarE showCharName `DAppE` dCharE mode '{') + brace_comma_args = (DVarE showCharName `DAppE` dCharE '{') : take (length show_args - 1) show_args composed_args = foldr (\x y -> DVarE composeName `DAppE` x `DAppE` y) - (DVarE showCharName `DAppE` dCharE mode '}') + (DVarE showCharName `DAppE` dCharE '}') brace_comma_args named_args = DVarE composeName `DAppE` (DVarE showStringName - `DAppE` dStringE (parenInfixConName con_name' " ")) + `DAppE` dStringE (parenInfixConName con_name " ")) `DAppE` composed_args - return $ DClause [DVarPa p, DConPa con_name' $ map DVarPa 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 @@ -153,17 +133,12 @@ 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 +showsPrecE :: Int -> Name -> DExp +showsPrecE prec n = DVarE showsPrecName `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 +dCharE :: Char -> DExp +dCharE c = DLitE $ StringL [c] -- There aren't type-level characters yet, + -- so fake it with a string dStringE :: String -> DExp dStringE = DLitE . StringL @@ -175,31 +150,13 @@ 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 +-- This is necessary for standalone-derived 'Show' instances for singleton types. +mkShowSingContext :: DCxt -> DCxt +mkShowSingContext = map show_to_SingShow where show_to_SingShow :: DPred -> DPred show_to_SingShow = modifyConNameDPred $ \n -> if n == showName then showSingName else n - -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/Deriving/Traversable.hs b/src/Data/Singletons/Deriving/Traversable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Deriving/Traversable.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Deriving.Traversable +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Implements deriving of Traversable instances +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Deriving.Traversable where + +import Data.Singletons.Deriving.Infer +import Data.Singletons.Deriving.Util +import Data.Singletons.Names +import Data.Singletons.Syntax +import Language.Haskell.TH.Desugar + +mkTraversableInstance :: forall q. DsMonad q => DerivDesc q +mkTraversableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do + functorLikeValidityChecks False dd + f <- newUniqueName "_f" + let ft_trav :: FFoldType (q DExp) + ft_trav = FT { ft_triv = pure $ DVarE pureName + -- traverse f = pure x + , ft_var = pure $ DVarE f + -- traverse f = f x + , ft_ty_app = \_ g -> DAppE (DVarE traverseName) <$> g + -- traverse f = traverse g + , ft_forall = \_ g -> g + , ft_bad_app = error "in other argument in ft_trav" + } + + -- Con a1 a2 ... -> Con <$> g1 a1 <*> g2 a2 <*> ... + clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause + clause_for_con = mkSimpleConClause $ \con_name -> mkApCon (DConE con_name) + where + -- ((Con <$> x1) <*> x2) <*> ... + mkApCon :: DExp -> [DExp] -> DExp + mkApCon con [] = DVarE pureName `DAppE` con + mkApCon con [x] = DVarE fmapName `DAppE` con `DAppE` x + mkApCon con (x1:x2:xs) = + foldl appAp (DVarE liftA2Name `DAppE` con `DAppE` x1 `DAppE` x2) xs + where appAp x y = DVarE apName `DAppE` x `DAppE` y + + mk_trav_clause :: DCon -> q DClause + mk_trav_clause con = do + parts <- foldDataConArgs ft_trav con + clause_for_con [DVarPa f] con =<< sequence parts + + mk_trav :: q [DClause] + mk_trav = case cons of + [] -> do v <- newUniqueName "v" + pure [DClause [DWildPa, DVarPa v] + (DVarE pureName `DAppE` DCaseE (DVarE v) [])] + _ -> traverse mk_trav_clause cons + + trav_clauses <- mk_trav + constraints <- inferConstraintsDef mb_ctxt (DConPr traversableName) ty cons + return $ InstDecl { id_cxt = constraints + , id_name = traversableName + , id_arg_tys = [ty] + , id_sigs = mempty + , id_meths = [ (traverseName, UFunction trav_clauses) ] } diff --git a/src/Data/Singletons/Deriving/Util.hs b/src/Data/Singletons/Deriving/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Deriving/Util.hs @@ -0,0 +1,313 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Deriving.Util +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Utilities used by the `deriving` machinery in singletons. +-- +---------------------------------------------------------------------------- +module Data.Singletons.Deriving.Util where + +import Control.Monad +import Data.List +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Set as Set +import Data.Singletons.Names +import Data.Singletons.Syntax +import Data.Singletons.Util +import Language.Haskell.TH.Desugar +import Language.Haskell.TH.Syntax + +-- A generic type signature for describing how to produce a derived instance. +type DerivDesc q + = Maybe DCxt -- (Just ctx) if ctx was provided via StandaloneDeriving. + -- Nothing if using a deriving clause. + -> DType -- The data type argument to the class. + -> DataDecl -- The original data type information. + -> q UInstDecl -- The derived instance. + +-- | Is this data type a non-vanilla data type? Here, \"non-vanilla\" refers to +-- any data type that cannot be expressed using Haskell98 syntax. For instance, +-- this GADT: +-- +-- @ +-- data Foo :: Type -> Type where +-- MkFoo :: forall a. a -> Foo a +-- @ +-- +-- Is equivalent to this Haskell98 data type: +-- +-- @ +-- data Foo a = MkFoo a +-- @ +-- +-- However, the following GADT is non-vanilla: +-- +-- @ +-- data Bar :: Type -> Type where +-- MkBar :: Int -> Bar Int +-- @ +-- +-- Since there is no equivalent Haskell98 data type. The closest you could get +-- is this: +-- +-- @ +-- data Bar a = (a ~ Int) => MkBar Int +-- @ +-- +-- Which requires language extensions to write. +-- +-- A data type is a non-vanilla if one of the following conditions are met: +-- +-- 1. A constructor has any existentially quantified type variables. +-- +-- 2. A constructor has a context. +-- +-- We care about this because some derivable stock classes, such as 'Enum', +-- forbid derived instances for non-vanilla data types. +isNonVanillaDataType :: forall q. DsMonad q => DType -> [DCon] -> q Bool +isNonVanillaDataType data_ty = anyM $ \con@(DCon _ ctxt _ _ _) -> do + ex_tvbs <- conExistentialTvbs data_ty con + return $ not $ null ex_tvbs && null ctxt + where + anyM :: (a -> q Bool) -> [a] -> q Bool + anyM _ [] = return False + anyM p (x:xs) = do + b <- p x + if b then return True else anyM p xs + +----- +-- Utilities for deriving Functor-like classes. +-- Much of this was cargo-culted from the GHC source code. +----- + +data FFoldType a -- Describes how to fold over a DType in a functor like way + = FT { ft_triv :: a + -- ^ Does not contain variable + , ft_var :: a + -- ^ The variable itself + , ft_ty_app :: DType -> a -> a + -- ^ Type app, variable only in last argument + , ft_bad_app :: a + -- ^ Type app, variable other than in last argument + , ft_forall :: [DTyVarBndr] -> a -> a + -- ^ Forall type + } + +-- Note that in GHC, this function is pure. It must be monadic here since we: +-- +-- (1) Expand type synonyms +-- (2) Detect type family applications +-- +-- Which require reification in Template Haskell, but are pure in Core. +functorLikeTraverse :: forall q a. + DsMonad q + => Name -- ^ Variable to look for + -> FFoldType a -- ^ How to fold + -> DType -- ^ Type to process + -> q a +functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar + , ft_ty_app = caseTyApp, ft_bad_app = caseWrongArg + , ft_forall = caseForAll }) + ty + = do ty' <- expandType ty + (res, _) <- go ty' + pure res + where + go :: DType + -> q (a, Bool) -- (result of type a, does type contain var) + go (DAppT f x) = do + (_, fc) <- go f + if fc + then pure (caseWrongArg, True) + else do (xr, xc) <- go x + if xc + then let tyApp :: q (a, Bool) + tyApp = pure (caseTyApp f xr, True) + + inspect :: DType -> q (a, Bool) + inspect (DConT n) = do + itf <- isTyFamilyName n + if itf -- We can't decompose type families, so + -- error if we encounter one here. + then pure (caseWrongArg, True) + else tyApp + inspect (DForallT _ _ t) = inspect t + inspect (DSigT t _) = inspect t + inspect (DAppT t _) = inspect t + inspect (DVarT {}) = tyApp + inspect DArrowT = tyApp + inspect (DLitT {}) = tyApp + inspect DWildCardT = tyApp + + in case unfoldType f of + f_head :| _ -> inspect f_head + else trivial + go (DSigT t k) = do + (_, kc) <- go k + if kc + then pure (caseWrongArg, True) + else go t + go (DVarT v) + | v == var = pure (caseVar, True) + | otherwise = trivial + go (DForallT tvbs _ t) = do + (tr, tc) <- go t + if var `notElem` map extractTvbName tvbs && tc + then pure (caseForAll tvbs tr, True) + else trivial + go (DConT {}) = trivial + go DArrowT = trivial + go (DLitT {}) = trivial + go DWildCardT = trivial + + trivial :: q (a, Bool) + trivial = pure (caseTrivial, False) + +isTyFamilyName :: DsMonad q => Name -> q Bool +isTyFamilyName n = do + info <- dsReify n + pure $ case info of + Just (DTyConI dec _) + | DOpenTypeFamilyD{} <- dec -> True + | DClosedTypeFamilyD{} <- dec -> True + _ -> False + +-- A crude approximation of cond_functorOK from GHC. This checks that: +-- +-- (1) There's at least one type variable in the data type. +-- (2) It doesn't use the last type variable in the wrong place, e.g. data T a = MkT (X a a) +-- (3) It doesn't constrain the last type variable, e.g., data T a = Eq a => MkT a +functorLikeValidityChecks :: forall q. DsMonad q => Bool -> DataDecl -> q () +functorLikeValidityChecks allowConstrainedLastTyVar (DataDecl n data_tvbs cons) + | null data_tvbs -- (1) + = fail $ "Data type " ++ nameBase n ++ " must have some type parameters" + | otherwise + = mapM_ check_con cons + where + check_con :: DCon -> q () + check_con con = do + check_universal con + checks <- foldDataConArgs (ft_check (extractName con)) con + sequence_ checks + + -- (2) + check_universal :: DCon -> q () + check_universal con@(DCon con_tvbs con_theta con_name _ res_ty) + | allowConstrainedLastTyVar + = pure () + | _ :| res_ty_args <- unfoldType res_ty + , (_, last_res_ty_arg) <- snocView res_ty_args + , Just last_tv <- getDVarTName_maybe last_res_ty_arg + = do ex_tvbs <- conExistentialTvbs (foldTypeTvbs (DConT n) data_tvbs) con + let univ_tvb_names = map extractTvbName con_tvbs \\ map extractTvbName ex_tvbs + if last_tv `elem` univ_tvb_names + && last_tv `Set.notMember` foldMap (fvDType . predToType) con_theta + then pure () + else fail $ badCon con_name existential + | otherwise + = fail $ badCon con_name existential + + -- (3) + ft_check :: Name -> FFoldType (q ()) + ft_check con_name = + FT { ft_triv = pure () + , ft_var = pure () + , ft_ty_app = \_ x -> x + , ft_bad_app = fail $ badCon con_name wrong_arg + , ft_forall = \_ x -> x + } + + badCon :: Name -> String -> String + badCon con_name msg = "Constructor " ++ nameBase con_name ++ " " ++ msg + + existential, wrong_arg :: String + existential = "must be truly polymorphic in the last argument of the data type" + wrong_arg = "must use the type variable only as the last argument of a data type" + +-- Return all syntactic subterms of a type that contain the given variable somewhere. +-- These are the things that should appear in Functor-like instance constraints. +deepSubtypesContaining :: DsMonad q => Name -> DType -> q [DType] +deepSubtypesContaining tv + = functorLikeTraverse tv + (FT { ft_triv = [] + , ft_var = [] + , ft_ty_app = (:) + , ft_bad_app = error "in other argument in deepSubtypesContaining" + , ft_forall = \tvbs xs -> filter (\x -> all (not_in_ty x) tvbs) xs }) + where + not_in_ty :: DType -> DTyVarBndr -> Bool + not_in_ty ty tvb = extractTvbName tvb `Set.notMember` fvDType ty + +-- Fold over the arguments of a data constructor in a Functor-like way. +foldDataConArgs :: forall q a. DsMonad q => FFoldType a -> DCon -> q [a] +foldDataConArgs ft (DCon _ _ _ fields res_ty) = do + field_tys <- traverse expandType $ tysOfConFields fields + traverse foldArg field_tys + where + foldArg :: DType -> q a + foldArg + | _ :| res_ty_args <- unfoldType res_ty + , (_, last_res_ty_arg) <- snocView res_ty_args + , Just last_tv <- getDVarTName_maybe last_res_ty_arg + = functorLikeTraverse last_tv ft + | otherwise + = const (return (ft_triv ft)) + +-- If a type is a type variable (or a variable with a kind signature), return +-- 'Just' that. Otherwise, return 'Nothing'. +getDVarTName_maybe :: DType -> Maybe Name +getDVarTName_maybe (DSigT t _) = getDVarTName_maybe t +getDVarTName_maybe (DVarT n) = Just n +getDVarTName_maybe _ = Nothing + +-- Make a 'DLamE' using a fresh variable. +mkSimpleLam :: Quasi q => (DExp -> q DExp) -> q DExp +mkSimpleLam lam = do + n <- newUniqueName "n" + body <- lam (DVarE n) + return $ DLamE [n] body + +-- Make a 'DLamE' using two fresh variables. +mkSimpleLam2 :: Quasi q => (DExp -> DExp -> q DExp) -> q DExp +mkSimpleLam2 lam = do + n1 <- newUniqueName "n1" + n2 <- newUniqueName "n2" + body <- lam (DVarE n1) (DVarE n2) + return $ DLamE [n1, n2] body + +-- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" +-- +-- @mkSimpleConClause fold extra_pats con insides@ produces a match clause in +-- which the LHS pattern-matches on @extra_pats@, followed by a match on the +-- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@ +-- and its arguments, applying an expression (from @insides@) to each of the +-- respective arguments of @con@. +mkSimpleConClause :: Quasi q + => (Name -> [DExp] -> DExp) + -> [DPat] + -> DCon + -> [DExp] + -> q DClause +mkSimpleConClause fold extra_pats (DCon _ _ con_name _ _) insides = do + vars_needed <- replicateM (length insides) $ newUniqueName "a" + let pat = DConPa con_name (map DVarPa vars_needed) + rhs = fold con_name (zipWith (\i v -> i `DAppE` DVarE v) insides vars_needed) + pure $ DClause (extra_pats ++ [pat]) rhs + +-- 'True' if the derived class's last argument is of kind (Type -> Type), +-- and thus needs a different constraint inference approach. +-- +-- Really, we should be determining this information by inspecting the kind +-- of the class being used. But that comes dangerously close to kind +-- inference territory, so for now we simply hardcode which stock derivable +-- classes are Functor-like. +isFunctorLikeClassName :: Name -> Bool +isFunctorLikeClassName class_name + = class_name `elem` [functorName, foldableName, traversableName] diff --git a/src/Data/Singletons/Internal.hs b/src/Data/Singletons/Internal.hs --- a/src/Data/Singletons/Internal.hs +++ b/src/Data/Singletons/Internal.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds, FlexibleContexts, FlexibleInstances, TypeFamilies, TypeOperators, TypeFamilyDependencies, - UndecidableInstances, TypeInType, ConstraintKinds, + UndecidableInstances, ConstraintKinds, ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes, PatternSynonyms, ViewPatterns #-} @@ -10,7 +10,7 @@ -- Module : Data.Singletons.Internal -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -26,7 +26,7 @@ , Proxy(..) ) where -import Data.Kind +import Data.Kind (Type) import Unsafe.Coerce import Data.Proxy ( Proxy(..) ) import GHC.Exts ( Proxy#, Constraint ) @@ -46,12 +46,12 @@ ---------------------------------------------------------------------- -- | The singleton kind-indexed data family. -data family Sing (a :: k) +data family Sing :: k -> Type -- | A 'SingI' constraint is essentially an implicitly-passed singleton. -- If you need to satisfy this constraint with an explicit singleton, please -- see 'withSingI' or the 'Sing' pattern synonym. -class SingI (a :: k) where +class SingI a where -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ -- extension to use this method the way you want. sing :: Sing a @@ -63,7 +63,8 @@ -- -- 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 +{-# COMPLETE Sing #-} +pattern Sing :: forall k (a :: k). () => SingI a => Sing a pattern Sing <- (singInstance -> SingInstance) where Sing = sing @@ -88,7 +89,7 @@ -- | 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 + type Demote k = (r :: Type) | r -> k -- | Convert a singleton to its unrefined version. fromSing :: Sing (a :: k) -> Demote k @@ -137,6 +138,7 @@ -- 'withSomeSing' bool2 $ \singBool2 -> -- 'SomeSing' (singBool1 %&& singBool2) -- @ +{-# COMPLETE FromSing #-} pattern FromSing :: SingKind k => forall (a :: k). Sing a -> Demote k pattern FromSing sng <- ((\demotedVal -> withSomeSing demotedVal SomeSing) -> SomeSing sng) where FromSing sng = fromSing sng @@ -153,7 +155,7 @@ 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 :: forall k (a :: k). Sing a -> SingInstance a singInstance s = with_sing_i SingInstance where with_sing_i :: (SingI a => SingInstance a) -> SingInstance a @@ -167,11 +169,11 @@ -- 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 :: * -> * -> * +data TyFun :: Type -> Type -> Type -- | Something of kind `a ~> b` is a defunctionalized type function that is -- not necessarily generative or injective. -type a ~> b = TyFun a b -> * +type a ~> b = TyFun a b -> Type infixr 0 ~> -- | Type level function application @@ -239,7 +241,7 @@ 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) +(@@) :: forall k1 k2 (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t) (@@) = applySing -- | Note that this instance's 'toSing' implementation crucially relies on the fact @@ -401,7 +403,7 @@ -- 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) +singThat :: forall k (a :: k). (SingKind k, SingI a) => (Demote k -> Bool) -> Maybe (Sing a) singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing @@ -425,4 +427,4 @@ -- >>> demote @(Nothing :: Maybe Ordering) -- Nothing demote :: forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a) -demote = fromSing (sing @(KindOf a) @a) +demote = fromSing (sing @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 @@ -20,11 +20,12 @@ import GHC.Show ( showCommaSpace, showSpace ) import Data.Typeable ( TypeRep ) import Data.Singletons.Util +import Control.Applicative import Control.Monad boolName, andName, tyEqName, compareName, minBoundName, maxBoundName, repName, - nilName, consName, listName, tyFunName, + nilName, consName, listName, tyFunArrowName, applyName, natName, symbolName, typeRepName, stringName, eqName, ordName, boundedName, orderingName, singFamilyName, singIName, singMethName, demoteName, @@ -40,8 +41,11 @@ singletonsToEnumName, singletonsFromEnumName, enumName, singletonsEnumName, equalsName, constraintName, showName, showCharName, showCommaSpaceName, showParenName, showsPrecName, - showSpaceName, showStringName, showSingName, showsSingPrecName, - composeName, gtName, tyFromStringName, sFromStringName :: Name + showSpaceName, showStringName, showSingName, + composeName, gtName, tyFromStringName, sFromStringName, + foldableName, foldMapName, memptyName, mappendName, foldrName, + functorName, fmapName, replaceName, + traversableName, traverseName, pureName, apName, liftA2Name :: Name boolName = ''Bool andName = '(&&) compareName = 'compare @@ -52,7 +56,7 @@ nilName = '[] consName = '(:) listName = ''[] -tyFunName = ''TyFun +tyFunArrowName = ''(~>) applyName = ''Apply symbolName = ''Symbol natName = ''Nat @@ -111,12 +115,24 @@ 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" +foldableName = ''Foldable +foldMapName = 'foldMap +memptyName = 'mempty +mappendName = 'mappend +foldrName = 'foldr +functorName = ''Functor +fmapName = 'fmap +replaceName = '(<$) +traversableName = ''Traversable +traverseName = 'traverse +pureName = 'pure +apName = '(<*>) +liftA2Name = 'liftA2 singPkg :: String singPkg = $( (LitE . StringL . loc_package) `liftM` location ) @@ -186,6 +202,12 @@ -- (.) and (!) are problematic for the parser. -- See Note [Special cases for (.) and (!)] + -- We can't promote promote idenitifers beginning with underscores to + -- type names, so we work around the issue by prepending "US" at the + -- front of the name (#229). + | Just (us, rest) <- splitUnderscores (nameBase name) + = default_case (mkName $ "US" ++ us ++ rest) + | name == nilName = mkName $ "NilSym" ++ (show sat) @@ -215,6 +237,9 @@ symbolic = not (isHsLetter (head nameStr)) qNewName (if symbolic then "ty" else nameStr) +mkTyConName :: Int -> Name +mkTyConName i = mk_name_tc "Data.Singletons.Internal" $ "TyCon" ++ show i + falseTySym :: DType falseTySym = promoteValRhs falseName @@ -279,7 +304,7 @@ -- make and equality predicate mkEqPred :: DType -> DType -> DPred -mkEqPred ty1 ty2 = foldl DAppPr (DConPr equalityName) [ty1, ty2] +mkEqPred ty1 ty2 = foldPred (DConPr equalityName) [ty1, ty2] -- | If a 'String' begins with one or more underscores, return -- @'Just' (us, rest)@, where @us@ contain all of the underscores at the @@ -294,11 +319,12 @@ 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 + go (DForallPr tvbs cxt p) = DForallPr tvbs (map go cxt) (go p) + go (DAppPr p t) = DAppPr (go p) t + go (DSigPr p k) = DSigPr (go p) k + go p@(DVarPr _) = p + go (DConPr n) = DConPr (mod_con_name n) + go p@DWildCardPr = p {- Note [Defunctionalization symbol suffixes] 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Partition -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -11,6 +11,7 @@ -- ---------------------------------------------------------------------------- +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Data.Singletons.Partition where @@ -20,7 +21,11 @@ import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum +import Data.Singletons.Deriving.Foldable +import Data.Singletons.Deriving.Functor import Data.Singletons.Deriving.Show +import Data.Singletons.Deriving.Traversable +import Data.Singletons.Deriving.Util import Data.Singletons.Names import Language.Haskell.TH.Syntax hiding (showName) import Language.Haskell.TH.Ppr @@ -28,7 +33,10 @@ import Data.Singletons.Util import Control.Monad +import Data.Bifunctor (bimap) import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Map as Map +import Data.Map (Map) import Data.Maybe import Data.Semigroup (Semigroup(..)) @@ -37,16 +45,20 @@ , pd_class_decs :: [UClassDecl] , pd_instance_decs :: [UInstDecl] , pd_data_decs :: [DataDecl] + , pd_ty_syn_decs :: [TySynDecl] + , pd_open_type_family_decs :: [OpenTypeFamilyDecl] + , pd_closed_type_family_decs :: [ClosedTypeFamilyDecl] , pd_derived_eq_decs :: [DerivedEqDecl] , pd_derived_show_decs :: [DerivedShowDecl] } instance Semigroup PartitionedDecs where - PDecs a1 b1 c1 d1 e1 f1 <> PDecs a2 b2 c2 d2 e2 f2 = + PDecs a1 b1 c1 d1 e1 f1 g1 h1 i1 <> PDecs a2 b2 c2 d2 e2 f2 g2 h2 i2 = PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) (e1 <> e2) (f1 <> f2) + (g1 <> g2) (h1 <> h2) (i1 <> i2) instance Monoid PartitionedDecs where - mempty = PDecs [] [] [] [] [] [] + mempty = PDecs [] [] [] [] [] [] [] [] [] mappend = (<>) -- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances @@ -58,42 +70,64 @@ partitionDec (DLetDec (DPragmaD {})) = return mempty partitionDec (DLetDec letdec) = return $ mempty { pd_let_decs = [letdec] } -partitionDec (DDataD nd _cxt name tvbs cons derivings) = do +partitionDec (DDataD _nd _cxt name tvbs mk cons derivings) = do + all_tvbs <- buildDataDTvbs tvbs mk + let data_decl = DataDecl name all_tvbs cons + derived_dec = mempty { pd_data_decs = [data_decl] } derived_decs - <- mapM (\(strat, deriv_pred) -> partitionDeriving strat deriv_pred Nothing ty cons) + <- mapM (\(strat, deriv_pred) -> + let etad_tvbs + | DConT pred_name :| _ <- unfoldType deriv_pred + , isFunctorLikeClassName pred_name + -- If deriving Functor, Foldable, or Traversable, + -- we need to use one less type variable than we normally do. + = take (length all_tvbs - 1) all_tvbs + | otherwise + = all_tvbs + ty = foldTypeTvbs (DConT name) etad_tvbs + in partitionDeriving strat deriv_pred Nothing ty data_decl) $ concatMap flatten_clause derivings - return $ mconcat $ data_dec : derived_decs + return $ mconcat $ derived_dec : derived_decs where - data_dec = mempty { pd_data_decs = [DataDecl nd name tvbs cons []] } - ty = foldType (DConT name) (map tvbToType tvbs) - - flatten_clause :: DDerivClause -> [(Maybe DerivStrategy, DType)] + flatten_clause :: DDerivClause -> [(Maybe DDerivStrategy, DType)] flatten_clause (DDerivClause strat preds) = map (\p -> (strat, predToType p)) preds partitionDec (DClassD cxt name tvbs fds decs) = do - env <- concatMapM partitionClassDec decs - return $ mempty { pd_class_decs = [ClassDecl { cd_cxt = cxt - , cd_name = name - , cd_tvbs = tvbs - , cd_fds = fds - , cd_lde = env }] } + (lde, otfs) <- concatMapM partitionClassDec decs + return $ mempty { pd_class_decs = [ClassDecl { cd_cxt = cxt + , cd_name = name + , cd_tvbs = tvbs + , cd_fds = fds + , cd_lde = lde }] + , pd_open_type_family_decs = otfs } partitionDec (DInstanceD _ cxt ty decs) = do - defns <- liftM catMaybes $ mapM partitionInstanceDec decs + (defns, sigs) <- liftM (bimap catMaybes mconcat) $ + mapAndUnzipM partitionInstanceDec decs (name, tys) <- split_app_tys [] ty - return $ mempty { pd_instance_decs = [InstDecl { id_cxt = cxt - , id_name = name - , id_arg_tys = tys - , id_meths = defns }] } + return $ mempty { pd_instance_decs = [InstDecl { id_cxt = cxt + , id_name = name + , id_arg_tys = tys + , id_sigs = sigs + , id_meths = defns }] } where split_app_tys acc (DAppT t1 t2) = split_app_tys (t2:acc) t1 split_app_tys acc (DConT name) = return (name, acc) split_app_tys acc (DSigT t _) = split_app_tys acc t split_app_tys _ _ = fail $ "Illegal instance head: " ++ show ty partitionDec (DRoleAnnotD {}) = return mempty -- ignore these -partitionDec (DTySynD {}) = return mempty -- ignore type synonyms; - -- promotion is a no-op, and - -- singling expands all syns +partitionDec (DTySynD name tvbs _type) = + -- See Note [Partitioning, type synonyms, and type families] + pure $ mempty { pd_ty_syn_decs = [TySynDecl name tvbs] } +partitionDec (DClosedTypeFamilyD tf_head _) = + -- See Note [Partitioning, type synonyms, and type families] + pure $ mempty { pd_closed_type_family_decs = [TypeFamilyDecl tf_head] } +partitionDec (DOpenTypeFamilyD tf_head) = + -- See Note [Partitioning, type synonyms, and type families] + pure $ mempty { pd_open_type_family_decs = [TypeFamilyDecl tf_head] } +partitionDec (DTySynInstD {}) = pure mempty + -- There's no need to track type family instances, since + -- we already record the type family itself separately. partitionDec (DStandaloneDerivD mb_strat ctxt ty) = case unfoldType ty of cls_pred_ty :| cls_tys @@ -106,8 +140,10 @@ -> 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 (DTyConI (DDataD _ _ dn dtvbs dk dcons _) _) -> do + all_tvbs <- buildDataDTvbs dtvbs dk + let data_decl = DataDecl dn all_tvbs dcons + partitionDeriving mb_strat cls_pred (Just ctxt) data_ty data_decl Just _ -> fail $ "Standalone derived instance for something other than a datatype: " ++ show data_ty @@ -116,36 +152,64 @@ partitionDec dec = fail $ "Declaration cannot be promoted: " ++ pprint (decToTH dec) -partitionClassDec :: Monad m => DDec -> m ULetDecEnv -partitionClassDec (DLetDec (DSigD name ty)) = return $ typeBinding name ty +partitionClassDec :: Monad m => DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl]) +partitionClassDec (DLetDec (DSigD name ty)) = + pure (typeBinding name ty, mempty) partitionClassDec (DLetDec (DValD (DVarPa name) exp)) = - return $ valueBinding name (UValue exp) + pure (valueBinding name (UValue exp), mempty) partitionClassDec (DLetDec (DFunD name clauses)) = - return $ valueBinding name (UFunction clauses) + pure (valueBinding name (UFunction clauses), mempty) partitionClassDec (DLetDec (DInfixD fixity name)) = - return $ infixDecl fixity name -partitionClassDec (DLetDec (DPragmaD {})) = return mempty + pure (infixDecl fixity name, mempty) +partitionClassDec (DLetDec (DPragmaD {})) = + pure (mempty, mempty) +partitionClassDec (DOpenTypeFamilyD tf_head) = + -- See Note [Partitioning, type synonyms, and type families] + pure (mempty, [TypeFamilyDecl tf_head]) +partitionClassDec (DTySynInstD {}) = + -- There's no need to track associated type family default equations, since + -- we already record the type family itself separately. + pure (mempty, mempty) partitionClassDec _ = fail "Only method declarations can be promoted within a class." -partitionInstanceDec :: Monad m => DDec -> m (Maybe (Name, ULetDecRHS)) +partitionInstanceDec :: Monad m => DDec + -> m ( Maybe (Name, ULetDecRHS) -- right-hand sides of methods + , Map Name DType -- method type signatures + ) partitionInstanceDec (DLetDec (DValD (DVarPa name) exp)) = - return $ Just (name, UValue exp) + pure (Just (name, UValue exp), mempty) partitionInstanceDec (DLetDec (DFunD name clauses)) = - return $ Just (name, UFunction clauses) -partitionInstanceDec (DLetDec (DPragmaD {})) = return Nothing + pure (Just (name, UFunction clauses), mempty) +partitionInstanceDec (DLetDec (DSigD name ty)) = + pure (Nothing, Map.singleton name ty) +partitionInstanceDec (DLetDec (DPragmaD {})) = + pure (Nothing, mempty) +partitionInstanceDec (DTySynInstD {}) = + pure (Nothing, mempty) + -- There's no need to track associated type family instances, since + -- we already record the type family itself separately. partitionInstanceDec _ = fail "Only method bodies can be promoted within an instance." -partitionDeriving :: DsMonad m => Maybe DerivStrategy -> DType -> Maybe DCxt -> DType -> [DCon] - -> m PartitionedDecs -partitionDeriving mb_strat deriv_pred mb_ctxt ty cons = +partitionDeriving + :: forall m. DsMonad m + => Maybe DDerivStrategy + -- ^ The deriving strategy, if present. + -> DType -- ^ The class being derived (e.g., 'Eq'), possibly applied to + -- some number of arguments (e.g., @C Int Bool@). + -> Maybe DCxt -- ^ @'Just' ctx@ if @ctx@ was provided via @StandaloneDeriving@. + -- 'Nothing' if using a @deriving@ clause. + -> DType -- ^ The data type argument to the class. + -> DataDecl -- ^ The original data type information (e.g., its constructors). + -> m PartitionedDecs +partitionDeriving mb_strat deriv_pred mb_ctxt ty data_decl = case unfoldType deriv_pred of DConT deriv_name :| arg_tys -- Here, we are more conservative than GHC: DeriveAnyClass only kicks -- in if the user explicitly chooses to do so with the anyclass -- deriving strategy - | Just AnyclassStrategy <- mb_strat + | Just DAnyclassStrategy <- mb_strat -> return $ mk_derived_inst InstDecl { id_cxt = fromMaybe [] mb_ctxt -- For now at least, there's no point in attempting to @@ -158,64 +222,85 @@ -- (Of course, if a user specifies a context with -- StandaloneDeriving, use that.) - , id_name = deriv_name - , id_arg_tys = arg_tys ++ [ty] - , id_meths = [] } + , id_name = deriv_name + , id_arg_tys = arg_tys ++ [ty] + , id_sigs = mempty + , id_meths = [] } - | Just NewtypeStrategy <- mb_strat + | Just DNewtypeStrategy <- mb_strat -> do qReportWarning "GeneralizedNewtypeDeriving is ignored by `singletons`." return mempty + | Just (DViaStrategy {}) <- mb_strat + -> do qReportWarning "DerivingVia is ignored by `singletons`." + return mempty + -- Stock classes. These are derived only if `singletons` supports them -- (and, optionally, if an explicit stock deriving strategy is used) DConT deriv_name :| [] -- For now, all stock derivable class supported in -- singletons take just one argument (the data -- type itself) | stock_or_default - , 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] } + , Just decs <- Map.lookup deriv_name stock_map + -> decs -- If we can't find a stock class, but the user bothered to use an -- explicit stock keyword, we can at least warn them about it. - | Just StockStrategy <- mb_strat + | Just DStockStrategy <- mb_strat -> do qReportWarning $ "`singletons` doesn't recognize the stock class " ++ nameBase deriv_name return mempty _ -> return mempty -- singletons doesn't support deriving this instance where + mk_instance :: DerivDesc m -> m UInstDecl + mk_instance maker = maker mb_ctxt ty data_decl + mk_derived_inst dec = mempty { pd_instance_decs = [dec] } mk_derived_eq_inst dec = mempty { pd_derived_eq_decs = [dec] } - mk_derived_decl mb_ctxt' ty' cons' = DerivedDecl { ded_mb_cxt = mb_ctxt' - , ded_type = ty' - , ded_cons = cons' } + derived_decl = DerivedDecl { ded_mb_cxt = mb_ctxt + , ded_type = ty + , ded_decl = data_decl } stock_or_default = isStockOrDefault mb_strat + -- A mapping from all stock derivable classes (that singletons supports) + -- to to derived code that they produce. + stock_map :: Map Name (m PartitionedDecs) + stock_map = Map.fromList + [ ( ordName, mk_derived_inst <$> mk_instance mkOrdInstance ) + , ( boundedName, mk_derived_inst <$> mk_instance mkBoundedInstance ) + , ( enumName, mk_derived_inst <$> mk_instance mkEnumInstance ) + , ( functorName, mk_derived_inst <$> mk_instance mkFunctorInstance ) + , ( foldableName, mk_derived_inst <$> mk_instance mkFoldableInstance ) + , ( traversableName, mk_derived_inst <$> mk_instance mkTraversableInstance ) + -- See Note [DerivedDecl] in Data.Singletons.Syntax + , ( eqName, return $ mk_derived_eq_inst derived_decl ) + -- See Note [DerivedDecl] in Data.Singletons.Syntax + , ( showName, do -- These will become PShow/SShow instances... + inst_for_promotion <- mk_instance mkShowInstance + -- ...and this will become a Show instance. + let inst_for_show = derived_decl + pure $ mempty { pd_instance_decs = [inst_for_promotion] + , pd_derived_show_decs = [inst_for_show] } ) + ] + -- Is this being used with an explicit stock strategy, or no strategy at all? -isStockOrDefault :: Maybe DerivStrategy -> Bool -isStockOrDefault Nothing = True -isStockOrDefault (Just StockStrategy) = True -isStockOrDefault (Just _) = False +isStockOrDefault :: Maybe DDerivStrategy -> Bool +isStockOrDefault Nothing = True +isStockOrDefault (Just DStockStrategy) = True +isStockOrDefault (Just _) = False + +{- +Note [Partitioning, type synonyms, and type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The process of singling does not produce any new declarations corresponding to +type synonyms or type families, so they are "ignored" in a sense. Nevertheless, +we explicitly track them during partitioning, since we want to create +defunctionalization symbols for them. + +Also note that: + +1. Other uses of type synonyms in singled code will be expanded away. +2. Other uses of type families in singled code are unlikely to work at present + due to Trac #12564. +-} 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Prelude -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -37,13 +37,14 @@ -- * Error reporting Error, sError, + ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, -- * Singleton equality module Data.Singletons.Prelude.Eq, -- * Singleton comparisons - module Data.Singletons.Prelude.Ord, + POrd(..), SOrd(..), -- * Singleton Enum and Bounded -- | As a matter of convenience, the singletons Prelude does /not/ export @@ -57,19 +58,40 @@ type (^), (%^), -- * Singleton 'Show' - PShow(..), SShow(..), ShowS, SChar, type (<>), (%<>), + PShow(..), SShow(..), ShowS, SChar, Shows, sShows, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen, + -- * Singleton 'Semigroup' and 'Monoid' + PSemigroup(type (<>)), SSemigroup((%<>)), + PMonoid(..), SMonoid(..), + + -- * Singleton 'Functor', 'Applicative', and 'Monad' + PFunctor(Fmap, type (<$)), SFunctor(sFmap, (%<$)), type (<$>), (%<$>), + PApplicative(Pure, type (<*>), type (*>), type (<*)), + SApplicative(sPure, (%<*>), (%*>), (%<*)), + PMonad(type (>>=), type (>>), Return, Fail), + SMonad((%>>=), (%>>), sReturn, sFail), + MapM_, sMapM_, + Sequence_, sSequence_, + type (=<<), (%=<<), + + -- * Singleton 'Foldable' and 'Traversable' + PFoldable(Elem, FoldMap, Foldr, Foldl, Foldr1, Foldl1, + Maximum, Minimum, Product, Sum), + SFoldable(sElem, sFoldMap, sFoldr, sFoldl, sFoldr1, sFoldl1, + sMaximum, sMinimum, sProduct, sSum), + PTraversable(Traverse, SequenceA, MapM, Sequence), + STraversable(sTraverse, sSequenceA, sMapM, sSequence), + -- ** Miscellaneous functions Id, sId, Const, sConst, (:.), (%.), type ($), (%$), type ($!), (%$!), Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * List operations - Map, sMap, type (++), (%++), Head, sHead, Last, sLast, Tail, sTail, + Map, sMap, type (++), (%++), Filter, sFilter, + Head, sHead, Last, sLast, Tail, sTail, Init, sInit, Null, sNull, Reverse, sReverse, - -- ** Reducing lists (folds) - Foldl, sFoldl, Foldl1, sFoldl1, Foldr, sFoldr, Foldr1, sFoldr1, -- *** Special folds And, sAnd, Or, sOr, Any, sAny, All, sAll, Concat, sConcat, ConcatMap, sConcatMap, @@ -81,7 +103,7 @@ Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, Span, sSpan, Break, sBreak, -- ** Searching lists - Elem, sElem, NotElem, sNotElem, Lookup, sLookup, + NotElem, sNotElem, Lookup, sLookup, -- ** Zipping and unzipping lists Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3, Unzip, sUnzip, Unzip3, sUnzip3, @@ -124,19 +146,64 @@ CurrySym0, CurrySym1, CurrySym2, CurrySym3, UncurrySym0, UncurrySym1, UncurrySym2, - ErrorSym0, ErrorSym1, UndefinedSym0, + ErrorSym0, ErrorSym1, + ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, + UndefinedSym0, + LTSym0, EQSym0, GTSym0, + CompareSym0, CompareSym1, CompareSym2, + type (<@#@$), type (<@#@$$), type (<@#@$$$), + type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), + type (>@#@$), type (>@#@$$), type (>@#@$$$), + type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), + MaxSym0, MaxSym1, MaxSym2, + MinSym0, MinSym1, MinSym2, + type (^@#@$), type (^@#@$$), type (^@#@$$$), ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, Show_Sym0, Show_Sym1, ShowListSym0, ShowListSym1, ShowListSym2, - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), ShowsSym0, ShowsSym1, ShowsSym2, ShowCharSym0, ShowCharSym1, ShowCharSym2, ShowStringSym0, ShowStringSym1, ShowStringSym2, ShowParenSym0, ShowParenSym1, ShowParenSym2, + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + MemptySym0, + MappendSym0, MappendSym1, MappendSym2, + MconcatSym0, MconcatSym1, + + FmapSym0, FmapSym1, FmapSym2, + type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), + type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), + PureSym0, PureSym1, + type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), + type (*>@#@$), type (*>@#@$$), type (*>@#@$$$), + type (<*@#@$), type (<*@#@$$), type (<*@#@$$$), + type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$), + type (>>@#@$), type (>>@#@$$), type (>>@#@$$$), + ReturnSym0, ReturnSym1, FailSym0, FailSym1, + MapM_Sym0, MapM_Sym1, MapM_Sym2, + Sequence_Sym0, Sequence_Sym1, + type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$), + + ElemSym0, ElemSym1, ElemSym2, + FoldMapSym0, FoldMapSym1, FoldMapSym2, + FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, + FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, + Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, + Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, + MaximumSym0, MaximumSym1, + MinimumSym0, MinimumSym1, + SumSym0, SumSym1, + ProductSym0, ProductSym1, + + TraverseSym0, TraverseSym1, TraverseSym2, + SequenceASym0, SequenceASym1, + MapMSym0, MapMSym1, MapMSym2, + SequenceSym0, SequenceSym1, + IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, type (.@#@$), type (.@#@$$), type (.@#@$$$), type ($@#@$), type ($@#@$$), type ($@#@$$$), @@ -146,14 +213,10 @@ (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, - type (++@#@$$), type (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1, + type (++@#@$$), type (++@#@$), FilterSym0, FilterSym1, FilterSym2, + HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, - ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, @@ -176,7 +239,6 @@ SpanSym0, SpanSym1, SpanSym2, BreakSym0, BreakSym1, BreakSym2, - ElemSym0, ElemSym1, ElemSym2, NotElemSym0, NotElemSym1, NotElemSym2, ZipSym0, ZipSym1, ZipSym2, @@ -189,17 +251,29 @@ ) where import Data.Singletons +import Data.Singletons.Prelude.Applicative + hiding (Const, ConstSym0, ConstSym1) import Data.Singletons.Prelude.Base + hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Either +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.List import Data.Singletons.Prelude.Maybe +import Data.Singletons.Prelude.Monad import Data.Singletons.Prelude.Tuple import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord -import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Enum hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred) +import Data.Singletons.Prelude.Monoid + ( PMonoid(..), SMonoid(..), MemptySym0, MappendSym0 + , MappendSym1, MappendSym2, MconcatSym0, MconcatSym1 ) import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Semigroup + ( PSemigroup(..), SSemigroup(..) + , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) ) import Data.Singletons.Prelude.Show +import Data.Singletons.Prelude.Traversable import Data.Singletons.TypeLits diff --git a/src/Data/Singletons/Prelude/Applicative.hs b/src/Data/Singletons/Prelude/Applicative.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Applicative.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Applicative +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'Applicative' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Applicative ( + PApplicative(..), SApplicative(..), + PAlternative(..), SAlternative(..), + Sing (SConst, sGetConst), SConst, Const, GetConst, + type (<$>), (%<$>), type (<$), (%<$), type (<**>), (%<**>), + LiftA, sLiftA, LiftA3, sLiftA3, Optional, sOptional, + + -- * Defunctionalization symbols + PureSym0, PureSym1, + type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), + type (*>@#@$), type (*>@#@$$), type (*>@#@$$$), + type (<*@#@$), type (<*@#@$$), type (<*@#@$$$), + EmptySym0, type (<|>@#@$), type (<|>@#@$$), type (<|>@#@$$$), + ConstSym0, ConstSym1, GetConstSym0, GetConstSym1, + type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), + type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), + type (<**>@#@$), type (<**>@#@$$), type (<**>@#@$$$), + LiftASym0, LiftASym1, LiftASym2, + LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, + LiftA3Sym0, LiftA3Sym1, LiftA3Sym2, LiftA3Sym3, + OptionalSym0, OptionalSym1 + ) where + +import Control.Applicative +import Data.Ord (Down(..)) +import Data.Singletons.Prelude.Const +import Data.Singletons.Prelude.Functor +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid +import Data.Singletons.Prelude.Ord +import Data.Singletons.Single + +$(singletonsOnly [d| + -- -| One or none. + optional :: Alternative f => f a -> f (Maybe a) + optional v = Just <$> v <|> pure Nothing + + instance Monoid a => Applicative ((,) a) where + pure x = (mempty, x) + (u, f) <*> (v, x) = (u `mappend` v, f x) + liftA2 f (u, x) (v, y) = (u `mappend` v, f x y) + + instance Applicative Down where + pure = Down + Down f <*> Down x = Down (f x) + |]) 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 @@ -1,5 +1,5 @@ -{-# LANGUAGE TemplateHaskell, KindSignatures, PolyKinds, TypeOperators, - DataKinds, ScopedTypeVariables, TypeFamilies, GADTs, +{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds, PolyKinds, + ScopedTypeVariables, TypeFamilies, GADTs, UndecidableInstances, BangPatterns #-} ----------------------------------------------------------------------------- @@ -25,7 +25,7 @@ -- * Basic functions Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise, Id, sId, Const, sConst, (:.), (%.), type ($), type ($!), (%$), (%$!), - Flip, sFlip, AsTypeOf, sAsTypeOf, + Until, sUntil, Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * Defunctionalization symbols @@ -38,6 +38,7 @@ type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), type ($@#@$), type ($@#@$$), type ($@#@$$$), type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), + UntilSym0, UntilSym1, UntilSym2, UntilSym3, FlipSym0, FlipSym1, FlipSym2, FlipSym3, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2 @@ -91,9 +92,24 @@ f $! x = let {-!-}vx = x in f vx infixr 0 $! + until :: (a -> Bool) -> (a -> a) -> a -> a + until p f = go + where + -- Does not singletonize due to overlapping patterns. + {- + go x | p x = x + | otherwise = go (f x) + -} + go x = if p x then x else go (f x) + -- This is not part of GHC.Base, but we need to emulate seq and this is a good -- place to do it. seq :: a -> b -> b seq _ x = x infixr 0 `seq` |]) + +-- Workaround for #326 +infixr 5 ++ +infixr 0 $ +infixr 0 $! 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 @@ -1,12 +1,13 @@ -{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, TypeFamilies, TypeOperators, - GADTs, ScopedTypeVariables, DeriveDataTypeable, UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell, TypeApplications, TypeFamilies, TypeOperators, + GADTs, ScopedTypeVariables, DeriveDataTypeable, UndecidableInstances, + DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Bool -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -77,6 +78,10 @@ STrue %&& a = a infixr 3 %&& $(genDefunSymbols [''(&&)]) +instance SingI (&&@#@$) where + sing = singFun2 (%&&) +instance SingI x => SingI ((&&@#@$$) x) where + sing = singFun1 (sing @x %&&) -- | Disjunction of singletons (%||) :: Sing a -> Sing b -> Sing (a || b) @@ -84,12 +89,18 @@ STrue %|| _ = STrue infixr 2 %|| $(genDefunSymbols [''(||)]) +instance SingI (||@#@$) where + sing = singFun2 (%||) +instance SingI x => SingI ((||@#@$$) x) where + sing = singFun1 (sing @x %||) -- | Negation of a singleton sNot :: Sing a -> Sing (Not a) sNot SFalse = STrue sNot STrue = SFalse $(genDefunSymbols [''Not]) +instance SingI NotSym0 where + sing = singFun1 sNot -- | Conditional over singletons sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c) diff --git a/src/Data/Singletons/Prelude/Const.hs b/src/Data/Singletons/Prelude/Const.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Const.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Const +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports the promoted and singled versions of the 'Const' data type. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Const ( + -- * The 'Const' singleton + Sing(SConst, sGetConst), + SConst, GetConst, + + -- * Defunctionalization symbols + ConstSym0, ConstSym1, + GetConstSym0, GetConstSym1 + ) where + +import Control.Applicative +import Data.Kind (Type) +import Data.Singletons.Internal +import Data.Singletons.Prelude.Base + hiding ( Const, ConstSym0, ConstSym1 + , Foldr, FoldrSym0, sFoldr ) +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Instances hiding (FoldlSym0, sFoldl) +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Semigroup.Internal +import Data.Singletons.Prelude.Show +import Data.Singletons.Promote +import Data.Singletons.Single + +{- +Const's argument `b` is poly-kinded, and as a result, we have a choice as to +what Sing instance to give it. We could use either + +1. data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type +2. data instance Sing :: forall (a :: Type) (b :: Type). Const a b -> Type + +Option (1) is the more permissive one, so we opt for that. However, singletons' +TH machinery does not jive with this option, since the SingKind instance it +tries to generate: + + instance (SingKind a, SingKind b) => SingKind (Const a b) where + type Demote (Const a b) = Const (Demote a) (Demote b) + +Assumes that `b` is of kind Type. Until we get a more reliable story for +poly-kinded Sing instances (see #150), we simply write the Sing instance by +hand. +-} +data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type where + SConst :: { sGetConst :: Sing a } -> Sing ('Const a) +type SConst = (Sing :: Const a b -> Type) +instance SingKind a => SingKind (Const a b) where + type Demote (Const a b) = Const (Demote a) b + fromSing (SConst sa) = Const (fromSing sa) + toSing (Const a) = withSomeSing a $ SomeSing . SConst +instance SingI a => SingI ('Const a) where + sing = SConst sing + +$(genDefunSymbols [''Const]) +instance SingI ConstSym0 where + sing = singFun1 SConst +instance SingI (TyCon1 'Const) where + sing = singFun1 SConst + +$(singletons [d| + type family GetConst (x :: Const a b) :: a where + GetConst ('Const x) = x + |]) + +$(singletonsOnly [d| + deriving instance Bounded a => Bounded (Const a b) + deriving instance Eq a => Eq (Const a b) + deriving instance Ord a => Ord (Const a b) + + -- deriving instance Enum a => Enum (Const a b) + instance Enum a => Enum (Const a b) where + succ (Const x) = Const (succ x) + pred (Const x) = Const (pred x) + toEnum i = Const (toEnum i) + fromEnum (Const x) = fromEnum x + enumFromTo (Const x) (Const y) = map Const (enumFromTo x y) + enumFromThenTo (Const x) (Const y) (Const z) = + map Const (enumFromThenTo x y z) + + -- deriving instance Monoid a => Monoid (Const a b) + instance Monoid a => Monoid (Const a b) where + mempty = Const mempty + + -- deriving instance Num a => Num (Const a b) + instance Num a => Num (Const a b) where + Const x + Const y = Const (x + y) + Const x - Const y = Const (x - y) + Const x * Const y = Const (x * y) + negate (Const x) = Const (negate x) + abs (Const x) = Const (abs x) + signum (Const x) = Const (signum x) + fromInteger n = Const (fromInteger n) + + -- deriving instance Semigroup a => Semigroup (Const a b) + instance Semigroup a => Semigroup (Const a b) where + Const x <> Const y = Const (x <> y) + + -- -| This instance would be equivalent to the derived instances of the + -- 'Const' newtype if the 'runConst' field were removed + instance Show a => Show (Const a b) where + showsPrec d (Const x) = showParen (d > 10) $ + showString "Const " . showsPrec 11 x + + deriving instance Functor (Const m) + deriving instance Foldable (Const m) + + instance Monoid m => Applicative (Const m) where + pure _ = Const mempty + liftA2 _ (Const x) (Const y) = Const (x `mappend` y) + Const x <*> Const y = Const (x `mappend` y) + |]) diff --git a/src/Data/Singletons/Prelude/Either.hs b/src/Data/Singletons/Prelude/Either.hs --- a/src/Data/Singletons/Prelude/Either.hs +++ b/src/Data/Singletons/Prelude/Either.hs @@ -1,12 +1,12 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, GADTs, - DataKinds, PolyKinds, RankNTypes, UndecidableInstances #-} + RankNTypes, UndecidableInstances, DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Either -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -52,8 +52,8 @@ ) where import Data.Singletons.Prelude.Instances -import Data.Singletons.TH import Data.Singletons.Prelude.Base +import Data.Singletons.Single -- NB: The haddock comments are disabled because TH can't deal with them. diff --git a/src/Data/Singletons/Prelude/Enum.hs b/src/Data/Singletons/Prelude/Enum.hs --- a/src/Data/Singletons/Prelude/Enum.hs +++ b/src/Data/Singletons/Prelude/Enum.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, TypeOperators, GADTs, UndecidableInstances, - FlexibleContexts, DefaultSignatures, BangPatterns, TypeInType, + FlexibleContexts, DefaultSignatures, BangPatterns, InstanceSigs #-} ----------------------------------------------------------------------------- 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 @@ -1,13 +1,14 @@ -{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TypeInType, +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, RankNTypes, FlexibleContexts, TemplateHaskell, - UndecidableInstances, GADTs, DefaultSignatures #-} + UndecidableInstances, GADTs, DefaultSignatures, + ScopedTypeVariables, TypeApplications #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Eq -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -17,34 +18,50 @@ module Data.Singletons.Prelude.Eq ( PEq(..), SEq(..), + DefaultEq, + + -- * Defunctionalization symbols type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (/=@#@$), type (/=@#@$$), type (/=@#@$$$) + type (/=@#@$), type (/=@#@$$), type (/=@#@$$$), + DefaultEqSym0, DefaultEqSym1, DefaultEqSym2 ) where +import Data.Singletons.Internal import Data.Singletons.Prelude.Bool import Data.Singletons.Single import Data.Singletons.Prelude.Instances import Data.Singletons.Util import Data.Singletons.Promote -import qualified Data.Type.Equality as DTE +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 DefaultEq -- | The promoted analogue of 'Eq'. If you supply no definition for '(==)', --- then it defaults to a use of '(DTE.==)', from "Data.Type.Equality". +-- then it defaults to a use of 'DefaultEq'. class PEq a where type (==) (x :: a) (y :: a) :: Bool type (/=) (x :: a) (y :: a) :: Bool - type (x :: a) == (y :: a) = x DTE.== y + type (x :: a) == (y :: a) = x `DefaultEq` y type (x :: a) /= (y :: a) = Not (x == y) -infix 4 == -infix 4 /= + infix 4 == + infix 4 /= -$(genDefunSymbols [''(==), ''(/=)]) +-- | A sensible way to compute Boolean equality for types of any kind. Note +-- that this definition is slightly different from the '(DTE.==)' type family +-- from "Data.Type.Equality" in @base@, as '(DTE.==)' attempts to distinguish +-- applications of type constructors from other types. As a result, +-- @a == a@ does not reduce to 'True' for every @a@, but @'DefaultEq' a a@ +-- /does/ reduce to 'True' for every @a@. The latter behavior is more desirable +-- for @singletons@' purposes, so we use it instead of '(DTE.==)'. +type family DefaultEq (a :: k) (b :: k) :: Bool where + DefaultEq a a = 'True + DefaultEq a b = 'False +$(genDefunSymbols [''(==), ''(/=), ''DefaultEq]) + -- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is required -- that instances define a body for '(%==)'. You may also supply a body for '(%/=)'. class SEq k where @@ -61,3 +78,13 @@ infix 4 %/= $(singEqInstances basicTypes) + +instance SEq a => SingI ((==@#@$) :: a ~> a ~> Bool) where + sing = singFun2 (%==) +instance (SEq a, SingI x) => SingI ((==@#@$$) x :: a ~> Bool) where + sing = singFun1 (sing @x %==) + +instance SEq a => SingI ((/=@#@$) :: a ~> a ~> Bool) where + sing = singFun2 (%/=) +instance (SEq a, SingI x) => SingI ((/=@#@$$) x :: a ~> Bool) where + sing = singFun1 (sing @x %/=) diff --git a/src/Data/Singletons/Prelude/Foldable.hs b/src/Data/Singletons/Prelude/Foldable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Foldable.hs @@ -0,0 +1,645 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Foldable +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'Foldable' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Foldable ( + PFoldable(..), SFoldable(..), + + FoldrM, sFoldrM, + FoldlM, sFoldlM, + + Traverse_, sTraverse_, + For_, sFor_, + SequenceA_, sSequenceA_, + Asum, sAsum, + + MapM_, sMapM_, + ForM_, sForM_, + Sequence_, sSequence_, + Msum, sMsum, + + Concat, sConcat, + ConcatMap, sConcatMap, + And, sAnd, + Or, sOr, + Any, sAny, + All, sAll, + MaximumBy, sMaximumBy, + MinimumBy, sMinimumBy, + + NotElem, sNotElem, + Find, sFind, + + -- * Defunctionalization symbols + FoldSym0, FoldSym1, + FoldMapSym0, FoldMapSym1, FoldMapSym2, + FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, + Foldr'Sym0, Foldr'Sym1, Foldr'Sym2, Foldr'Sym3, + FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, + Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, + Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, + Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, + ToListSym0, ToListSym1, + NullSym0, NullSym1, + LengthSym0, LengthSym1, + ElemSym0, ElemSym1, ElemSym2, + MaximumSym0, MaximumSym1, + MinimumSym0, MinimumSym1, + SumSym0, SumSym1, + ProductSym0, ProductSym1, + + FoldrMSym0, FoldrMSym1, FoldrMSym2, FoldrMSym3, + FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3, + + Traverse_Sym0, Traverse_Sym1, Traverse_Sym2, + For_Sym0, For_Sym1, For_Sym2, + SequenceA_Sym0, SequenceA_Sym1, + AsumSym0, AsumSym1, + + MapM_Sym0, MapM_Sym1, MapM_Sym2, + ForM_Sym0, ForM_Sym1, ForM_Sym2, + Sequence_Sym0, Sequence_Sym1, + MsumSym0, MsumSym1, + + ConcatSym0, ConcatSym1, + ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, + AndSym0, AndSym1, + OrSym0, OrSym1, + AnySym0, AnySym1, AnySym2, + AllSym0, AllSym1, AllSym2, + MaximumBySym0, MaximumBySym1, MaximumBySym2, + MinimumBySym0, MinimumBySym1, MinimumBySym2, + + NotElemSym0, NotElemSym1, NotElemSym2, + FindSym0, FindSym1, FindSym2 + ) where + +import Control.Applicative +import Control.Monad +import Data.Kind +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..)) +import qualified Data.Monoid as Monoid (All(..), Any(..), Product(..), Sum(..)) +import Data.Singletons.Internal +import Data.Singletons.Prelude.Base + hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) +import Data.Singletons.Prelude.Bool +import Data.Singletons.Prelude.Either +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Instances (Sing(..), type (:@#@$)) +import Data.Singletons.Prelude.List.Internal.Disambiguation +import Data.Singletons.Prelude.Maybe +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid + hiding ( AllSym0, AllSym1 + , AnySym0, AnySym1 + , ProductSym0, ProductSym1 + , SumSym0, SumSym1 ) +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord + hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax + , Min, MinSym0, MinSym1, MinSym2, sMin ) +import Data.Singletons.Prelude.Semigroup.Internal + hiding ( AllSym0(..), AllSym1, SAll + , AnySym0(..), AnySym1, SAny + , FirstSym0, FirstSym1, SFirst + , LastSym0, LastSym1, SLast + , ProductSym0(..), ProductSym1, SProduct + , SumSym0(..), SumSym1, SSum ) +import Data.Singletons.Promote +import Data.Singletons.Single +import Data.Singletons.TypeLits.Internal + +newtype Endo a = Endo (a ~> a) +data instance Sing :: forall a. Endo a -> Type where + SEndo :: Sing x -> Sing ('Endo x) +data EndoSym0 :: forall a. (a ~> a) ~> Endo a +type instance Apply EndoSym0 x = 'Endo x + +$(singletonsOnly [d| + instance Semigroup (Endo a) where + Endo x <> Endo y = Endo (x . y) + + instance Monoid (Endo a) where + mempty = Endo id + |]) + +newtype MaxInternal a = MaxInternal (Maybe a) +data instance Sing :: forall a. MaxInternal a -> Type where + SMaxInternal :: Sing x -> Sing ('MaxInternal x) +$(genDefunSymbols [''MaxInternal]) + +newtype MinInternal a = MinInternal (Maybe a) +data instance Sing :: forall a. MinInternal a -> Type where + SMinInternal :: Sing x -> Sing ('MinInternal x) +$(genDefunSymbols [''MinInternal]) + +$(singletonsOnly [d| + instance Ord a => Semigroup (MaxInternal a) where + m <> MaxInternal Nothing = m + MaxInternal Nothing <> n = n + (MaxInternal m@(Just x)) <> (MaxInternal n@(Just y)) + = if x >= y then MaxInternal m else MaxInternal n + + instance Ord a => Monoid (MaxInternal a) where + mempty = MaxInternal Nothing + + instance Ord a => Semigroup (MinInternal a) where + m <> MinInternal Nothing = m + MinInternal Nothing <> n = n + (MinInternal m@(Just x)) <> (MinInternal n@(Just y)) + = if x <= y then MinInternal m else MinInternal n + + instance Ord a => Monoid (MinInternal a) where + mempty = MinInternal Nothing + |]) + +$(singletonsOnly [d| + -- -| Data structures that can be folded. + -- + -- For example, given a data type + -- + -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) + -- + -- a suitable instance would be + -- + -- > instance Foldable Tree where + -- > foldMap f Empty = mempty + -- > foldMap f (Leaf x) = f x + -- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r + -- + -- This is suitable even for abstract types, as the monoid is assumed + -- to satisfy the monoid laws. Alternatively, one could define @foldr@: + -- + -- > instance Foldable Tree where + -- > foldr f z Empty = z + -- > foldr f z (Leaf x) = f x z + -- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l + -- + -- @Foldable@ instances are expected to satisfy the following laws: + -- + -- > foldr f z t = appEndo (foldMap (Endo . f) t ) z + -- + -- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z + -- + -- > fold = foldMap id + -- + -- > length = getSum . foldMap (Sum . const 1) + -- + -- @sum@, @product@, @maximum@, and @minimum@ should all be essentially + -- equivalent to @foldMap@ forms, such as + -- + -- > sum = getSum . foldMap Sum + -- + -- but may be less defined. + -- + -- If the type is also a 'Functor' instance, it should satisfy + -- + -- > foldMap f = fold . fmap f + -- + -- which implies that + -- + -- > foldMap f . fmap g = foldMap (f . g) + + class Foldable (t :: Type -> Type) where + -- {-# MINIMAL foldMap | foldr #-} + + -- -| Combine the elements of a structure using a monoid. + fold :: Monoid m => t m -> m + fold = foldMap id + + -- -| Map each element of the structure to a monoid, + -- and combine the results. + foldMap :: Monoid m => (a -> m) -> t a -> m + foldMap f = foldr (mappend . f) mempty + + -- -| Right-associative fold of a structure. + -- + -- In the case of lists, 'foldr', when applied to a binary operator, a + -- starting value (typically the right-identity of the operator), and a + -- list, reduces the list using the binary operator, from right to left: + -- + -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) + -- + -- Note that, since the head of the resulting expression is produced by + -- an application of the operator to the first element of the list, + -- 'foldr' can produce a terminating expression from an infinite list. + -- + -- For a general 'Foldable' structure this should be semantically identical + -- to, + -- + -- @foldr f z = 'List.foldr' f z . 'toList'@ + -- + foldr :: (a -> b -> b) -> b -> t a -> b + foldr f z t = case foldMap (Endo . f) t of + Endo g -> g z + + -- -| Right-associative fold of a structure, but with strict application of + -- the operator. + -- + foldr' :: (a -> b -> b) -> b -> t a -> b + foldr' f z0 xs = foldl f' id xs z0 + where f' k x z = k $! f x z + + -- -| Left-associative fold of a structure. + -- + -- In the case of lists, 'foldl', when applied to a binary + -- operator, a starting value (typically the left-identity of the operator), + -- and a list, reduces the list using the binary operator, from left to + -- right: + -- + -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn + -- + -- Note that to produce the outermost application of the operator the + -- entire input list must be traversed. This means that 'foldl'' will + -- diverge if given an infinite list. + -- + -- Also note that if you want an efficient left-fold, you probably want to + -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does + -- not force the "inner" results (e.g. @z `f` x1@ in the above example) + -- before applying them to the operator (e.g. to @(`f` x2)@). This results + -- in a thunk chain @O(n)@ elements long, which then must be evaluated from + -- the outside-in. + -- + -- For a general 'Foldable' structure this should be semantically identical + -- to, + -- + -- @foldl f z = 'List.foldl' f z . 'toList'@ + -- + foldl :: (b -> a -> b) -> b -> t a -> b + foldl f z t = case foldMap (Dual . Endo . flip f) t of + Dual (Endo g) -> g z + -- There's no point mucking around with coercions here, + -- because flip forces us to build a new function anyway. + + -- -| Left-associative fold of a structure but with strict application of + -- the operator. + -- + -- This ensures that each step of the fold is forced to weak head normal + -- form before being applied, avoiding the collection of thunks that would + -- otherwise occur. This is often what you want to strictly reduce a finite + -- list to a single, monolithic result (e.g. 'length'). + -- + -- For a general 'Foldable' structure this should be semantically identical + -- to, + -- + -- @foldl f z = 'List.foldl'' f z . 'toList'@ + -- + foldl' :: (b -> a -> b) -> b -> t a -> b + foldl' f z0 xs = foldr f' id xs z0 + where f' x k z = k $! f z x + + -- -| A variant of 'foldr' that has no base case, + -- and thus may only be applied to non-empty structures. + -- + -- @'foldr1' f = 'List.foldr1' f . 'toList'@ + foldr1 :: (a -> a -> a) -> t a -> a + foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") + (foldr mf Nothing xs) + where + mf x m = Just (case m of + Nothing -> x + Just y -> f x y) + + -- -| A variant of 'foldl' that has no base case, + -- and thus may only be applied to non-empty structures. + -- + -- @'foldl1' f = 'List.foldl1' f . 'toList'@ + foldl1 :: (a -> a -> a) -> t a -> a + foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") + (foldl mf Nothing xs) + where + mf m y = Just (case m of + Nothing -> y + Just x -> f x y) + + -- -| List of elements of a structure, from left to right. + toList :: t a -> [a] + toList = foldr (:) [] + + -- -| Test whether the structure is empty. The default implementation is + -- optimized for structures that are similar to cons-lists, because there + -- is no general way to do better. + null :: t a -> Bool + null = foldr (\_ _ -> False) True + + -- -| Returns the size/length of a finite structure as an 'Int'. The + -- default implementation is optimized for structures that are similar to + -- cons-lists, because there is no general way to do better. + length :: t a -> Nat + length = foldl' (\c _ -> c+1) 0 + + -- -| Does the element occur in the structure? + elem :: Eq a => a -> t a -> Bool + elem = any . (==) + + -- -| The largest element of a non-empty structure. + maximum :: forall a . Ord a => t a -> a + maximum x = + case foldMap (MaxInternal . Just) x of + MaxInternal y -> fromMaybe (errorWithoutStackTrace "maximum: empty structure") y + + -- -| The least element of a non-empty structure. + minimum :: forall a . Ord a => t a -> a + minimum x = + case foldMap (MinInternal . Just) x of + MinInternal y -> fromMaybe (errorWithoutStackTrace "minimum: empty structure") y + + -- -| The 'sum' function computes the sum of the numbers of a structure. + sum :: Num a => t a -> a + sum x = case foldMap sum_ x of + Monoid.Sum y -> y + + -- -| The 'product' function computes the product of the numbers of a + -- structure. + product :: Num a => t a -> a + product x = case foldMap product_ x of + Monoid.Product y -> y + + -- instances for Prelude types + + instance Foldable Maybe where + foldMap = maybe_ mempty + + foldr _ z Nothing = z + foldr f z (Just x) = f x z + + foldl _ z Nothing = z + foldl f z (Just x) = f z x + + instance Foldable [] where + elem = listelem + foldl = listfoldl + foldl' = listfoldl' + foldl1 = listfoldl1 + foldr = listfoldr + foldr1 = listfoldr1 + length = listlength + maximum = listmaximum + minimum = listminimum + null = listnull + product = listproduct + sum = listsum + toList = id + + instance Foldable NonEmpty where + foldr f z (a :| as) = f a (listfoldr f z as) + foldl f z (a :| as) = listfoldl f (f z a) as + foldl1 f (a :| as) = listfoldl f a as + + -- GHC isn't clever enough to transform the default definition + -- into anything like this, so we'd end up shuffling a bunch of + -- Maybes around. + foldr1 f (p :| ps) = foldr go id ps p + where + go x r prev = f prev (r x) + + -- We used to say + -- + -- length (_ :| as) = 1 + length as + -- + -- but the default definition is better, counting from 1. + -- + -- The default definition also works great for null and foldl'. + -- As usual for cons lists, foldr' is basically hopeless. + + foldMap f (a :| as) = f a `mappend` foldMap f as + fold (m :| ms) = m `mappend` fold ms + toList (a :| as) = a : as + + instance Foldable (Either a) where + foldMap _ (Left _) = mempty + foldMap f (Right y) = f y + + foldr _ z (Left _) = z + foldr f z (Right y) = f y z + + length (Left _) = 0 + length (Right _) = 1 + + null = isLeft + + instance Foldable Dual where + foldMap f (Dual x) = f x + + elem x (Dual y) = x == y + foldl f z (Dual x) = f z x + foldl' f z (Dual x) = f z x + foldl1 _ (Dual x) = x + foldr f z (Dual x) = f x z + foldr' = foldr + foldr1 _ (Dual x) = x + length _ = 1 + maximum (Dual x) = x + minimum (Dual x) = x + null _ = False + product (Dual x) = x + sum (Dual x) = x + toList (Dual x) = [x] + + instance Foldable Monoid.Sum where + foldMap f (Monoid.Sum x) = f x + + elem x (Monoid.Sum y) = x == y + foldl f z (Monoid.Sum x) = f z x + foldl' f z (Monoid.Sum x) = f z x + foldl1 _ (Monoid.Sum x) = x + foldr f z (Monoid.Sum x) = f x z + foldr' = foldr + foldr1 _ (Monoid.Sum x) = x + length _ = 1 + maximum (Monoid.Sum x) = x + minimum (Monoid.Sum x) = x + null _ = False + product (Monoid.Sum x) = x + sum (Monoid.Sum x) = x + toList (Monoid.Sum x) = [x] + + instance Foldable Monoid.Product where + foldMap f (Monoid.Product x) = f x + + elem x (Monoid.Product y) = x == y + foldl f z (Monoid.Product x) = f z x + foldl' f z (Monoid.Product x) = f z x + foldl1 _ (Monoid.Product x) = x + foldr f z (Monoid.Product x) = f x z + foldr' = foldr + foldr1 _ (Monoid.Product x) = x + length _ = 1 + maximum (Monoid.Product x) = x + minimum (Monoid.Product x) = x + null _ = False + product (Monoid.Product x) = x + sum (Monoid.Product x) = x + toList (Monoid.Product x) = [x] + + -- -| Monadic fold over the elements of a structure, + -- associating to the right, i.e. from right to left. + foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b + foldrM f z0 xs = foldl f' return xs z0 + where f' k x z = f x z >>= k + + -- -| Monadic fold over the elements of a structure, + -- associating to the left, i.e. from left to right. + foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b + foldlM f z0 xs = foldr f' return xs z0 + where f' x k z = f z x >>= k + + -- -| Map each element of a structure to an action, evaluate these + -- actions from left to right, and ignore the results. For a version + -- that doesn't ignore the results see 'Data.Traversable.traverse'. + traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () + traverse_ f = foldr ((*>) . f) (pure ()) + + -- -| 'for_' is 'traverse_' with its arguments flipped. For a version + -- that doesn't ignore the results see 'Data.Traversable.for'. + -- + -- >>> for_ [1..4] print + -- 1 + -- 2 + -- 3 + -- 4 + for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () + for_ = flip traverse_ + + -- -| Map each element of a structure to a monadic action, evaluate + -- these actions from left to right, and ignore the results. For a + -- version that doesn't ignore the results see + -- 'Data.Traversable.mapM'. + -- + -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to + -- 'Monad'. + mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () + mapM_ f= foldr ((>>) . f) (return ()) + + -- -| 'forM_' is 'mapM_' with its arguments flipped. For a version that + -- doesn't ignore the results see 'Data.Traversable.forM'. + -- + -- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'. + forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m () + forM_ = flip mapM_ + + -- -| Evaluate each action in the structure from left to right, and + -- ignore the results. For a version that doesn't ignore the results + -- see 'Data.Traversable.sequenceA'. + sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f () + sequenceA_ = foldr (*>) (pure ()) + + -- -| Evaluate each monadic action in the structure from left to right, + -- and ignore the results. For a version that doesn't ignore the + -- results see 'Data.Traversable.sequence'. + -- + -- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized + -- to 'Monad'. + sequence_ :: (Foldable t, Monad m) => t (m a) -> m () + sequence_ = foldr (>>) (return ()) + + -- -| The sum of a collection of actions, generalizing 'concat'. + -- + -- asum [Just "Hello", Nothing, Just "World"] + -- Just "Hello" + asum :: (Foldable t, Alternative f) => t (f a) -> f a + asum = foldr (<|>) empty + + -- -| The sum of a collection of actions, generalizing 'concat'. + -- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'. + msum :: (Foldable t, MonadPlus m) => t (m a) -> m a + msum = asum + + -- -| The concatenation of all the elements of a container of lists. + concat :: Foldable t => t [a] -> [a] + concat xs = foldr (\x y -> foldr (:) y x) [] xs + + -- -| Map a function over all the elements of a container and concatenate + -- the resulting lists. + concatMap :: Foldable t => (a -> [b]) -> t a -> [b] + concatMap f xs = foldr (\x b -> foldr (:) b (f x)) [] xs + + -- These use foldr rather than foldMap to avoid repeated concatenation. + + -- -| 'and' returns the conjunction of a container of Bools. For the + -- result to be 'True', the container must be finite; 'False', however, + -- results from a 'False' value finitely far from the left end. + and :: Foldable t => t Bool -> Bool + and x = case foldMap all_ x of + Monoid.All y -> y + + -- -| 'or' returns the disjunction of a container of Bools. For the + -- result to be 'False', the container must be finite; 'True', however, + -- results from a 'True' value finitely far from the left end. + or :: Foldable t => t Bool -> Bool + or x = case foldMap any_ x of + Monoid.Any y -> y + + -- -| Determines whether any element of the structure satisfies the predicate. + any :: Foldable t => (a -> Bool) -> t a -> Bool + any p x = case foldMap (any_ . p) x of + Monoid.Any y -> y + + -- -| Determines whether all elements of the structure satisfy the predicate. + all :: Foldable t => (a -> Bool) -> t a -> Bool + all p x = case foldMap (all_ . p) x of + Monoid.All y -> y + + -- -| The largest element of a non-empty structure with respect to the + -- given comparison function. + + -- See Note [maximumBy/minimumBy space usage] + maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a + maximumBy cmp = foldl1 max' + where max' x y = case cmp x y of + GT -> x + LT -> y + EQ -> y + + -- -| The least element of a non-empty structure with respect to the + -- given comparison function. + + -- See Note [maximumBy/minimumBy space usage] + minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a + minimumBy cmp = foldl1 min' + where min' x y = case cmp x y of + GT -> y + LT -> x + EQ -> x + + -- -| 'notElem' is the negation of 'elem'. + notElem :: (Foldable t, Eq a) => a -> t a -> Bool + notElem x = not . elem x + + -- -| The 'find' function takes a predicate and a structure and returns + -- the leftmost element of the structure matching the predicate, or + -- 'Nothing' if there is no such element. + find :: Foldable t => (a -> Bool) -> t a -> Maybe a + find p y = case foldMap (\ x -> First (if p x then Just x else Nothing)) y of + First z -> z + |]) + +$(singletonsOnly [d| + -- instances for Prelude types (part 2) + + deriving instance Foldable ((,) a) + deriving instance Foldable First + deriving instance Foldable Last + |]) 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.Prelude.Function -- Copyright : (C) 2016 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -17,8 +17,9 @@ -- ---------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, TypeFamilies, - TypeOperators, UndecidableInstances, GADTs #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, + TypeOperators, UndecidableInstances, GADTs, + DataKinds, PolyKinds #-} module Data.Singletons.Prelude.Function ( -- * "Prelude" re-exports @@ -113,3 +114,6 @@ x & f = f x infixl 1 & |]) + +-- Workaround for #326 +infixl 1 & diff --git a/src/Data/Singletons/Prelude/Functor.hs b/src/Data/Singletons/Prelude/Functor.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Functor.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Functor +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'Functor' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Functor ( + PFunctor(..), SFunctor(..), + type ($>), (%$>), + type (<$>), (%<$>), + type (<&>), (%<&>), + Void, sVoid, + + -- * Defunctionalization symbols + FmapSym0, FmapSym1, FmapSym2, + type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), + type ($>@#@$), type ($>@#@$$), type ($>@#@$$$), + type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), + type (<&>@#@$), type (<&>@#@$$), type (<&>@#@$$$), + VoidSym0, VoidSym1 + ) where + +import Data.Ord (Down(..)) +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Ord +import Data.Singletons.Single + +$(singletonsOnly [d| + infixl 4 <$> + + -- -| An infix synonym for 'fmap'. + -- + -- The name of this operator is an allusion to '$'. + -- Note the similarities between their types: + -- + -- > ($) :: (a -> b) -> a -> b + -- > (<$>) :: Functor f => (a -> b) -> f a -> f b + -- + -- Whereas '$' is function application, '<$>' is function + -- application lifted over a 'Functor'. + -- + -- ==== __Examples__ + -- + -- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show': + -- + -- >>> show <$> Nothing + -- Nothing + -- >>> show <$> Just 3 + -- Just "3" + -- + -- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@ + -- 'String' using 'show': + -- + -- >>> show <$> Left 17 + -- Left 17 + -- >>> show <$> Right 17 + -- Right "17" + -- + -- Double each element of a list: + -- + -- >>> (*2) <$> [1,2,3] + -- [2,4,6] + -- + -- Apply 'even' to the second element of a pair: + -- + -- >>> even <$> (2,2) + -- (2,True) + -- + (<$>) :: Functor f => (a -> b) -> f a -> f b + (<$>) = fmap + + infixl 4 $> + + -- -| Flipped version of '<$>'. + -- + -- @ + -- ('<&>') = 'flip' 'fmap' + -- @ + -- + -- @since 4.11.0.0 + -- + -- ==== __Examples__ + -- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right': + -- + -- >>> Just 2 <&> (+1) + -- Just 3 + -- + -- >>> [1,2,3] <&> (+1) + -- [2,3,4] + -- + -- >>> Right 3 <&> (+1) + -- Right 4 + -- + (<&>) :: Functor f => f a -> (a -> b) -> f b + as <&> f = f <$> as + + infixl 1 <&> + + -- -| Flipped version of '<$'. + -- + -- @since 4.7.0.0 + -- + -- ==== __Examples__ + -- + -- Replace the contents of a @'Maybe' 'Int'@ with a constant 'String': + -- + -- >>> Nothing $> "foo" + -- Nothing + -- >>> Just 90210 $> "foo" + -- Just "foo" + -- + -- Replace the contents of an @'Either' 'Int' 'Int'@ with a constant + -- 'String', resulting in an @'Either' 'Int' 'String'@: + -- + -- >>> Left 8675309 $> "foo" + -- Left 8675309 + -- >>> Right 8675309 $> "foo" + -- Right "foo" + -- + -- Replace each element of a list with a constant 'String': + -- + -- >>> [1,2,3] $> "foo" + -- ["foo","foo","foo"] + -- + -- Replace the second element of a pair with a constant 'String': + -- + -- >>> (1,2) $> "foo" + -- (1,"foo") + -- + ($>) :: Functor f => f a -> b -> f b + ($>) = flip (<$) + + -- -| @'void' value@ discards or ignores the result of evaluation, such + -- as the return value of an 'System.IO.IO' action. + -- + -- ==== __Examples__ + -- + -- Replace the contents of a @'Maybe' 'Int'@ with unit: + -- + -- >>> void Nothing + -- Nothing + -- >>> void (Just 3) + -- Just () + -- + -- Replace the contents of an @'Either' 'Int' 'Int'@ with unit, + -- resulting in an @'Either' 'Int' '()'@: + -- + -- >>> void (Left 8675309) + -- Left 8675309 + -- >>> void (Right 8675309) + -- Right () + -- + -- Replace every element of a list with unit: + -- + -- >>> void [1,2,3] + -- [(),(),()] + -- + -- Replace the second element of a pair with unit: + -- + -- >>> void (1,2) + -- (1,()) + -- + -- Discard the result of an 'System.IO.IO' action: + -- + -- >>> mapM print [1,2] + -- 1 + -- 2 + -- [(),()] + -- >>> void $ mapM print [1,2] + -- 1 + -- 2 + -- + void :: Functor f => f a -> f () + void x = () <$ x + + deriving instance Functor ((,) a) + deriving instance Functor Down + |]) + +-- Workaround for #326 +infixl 4 <$> +infixl 4 $> +infixl 1 <&> diff --git a/src/Data/Singletons/Prelude/Identity.hs b/src/Data/Singletons/Prelude/Identity.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Identity.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Identity +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports the promoted and singled versions of the 'Identity' data type. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Identity ( + -- * The 'Identity' singleton + Sing(SIdentity, sRunIdentity), + SIdentity, RunIdentity, + + -- * Defunctionalization symbols + IdentitySym0, IdentitySym1, + RunIdentitySym0, RunIdentitySym1 + ) where + +import Control.Applicative +import Data.Foldable (Foldable(..)) +import Data.Functor.Identity +import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr) +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Instances hiding (Foldl, sFoldl) +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Semigroup.Internal +import Data.Singletons.Prelude.Show +import Data.Singletons.Single + +$(singletonsOnly [d| + -- deriving instance Enum a => Enum (Identity a) + instance Enum a => Enum (Identity a) where + succ (Identity x) = Identity (succ x) + pred (Identity x) = Identity (pred x) + toEnum i = Identity (toEnum i) + fromEnum (Identity x) = fromEnum x + enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y) + enumFromThenTo (Identity x) (Identity y) (Identity z) = + map Identity (enumFromThenTo x y z) + + -- deriving instance Monoid a => Monoid (Identity a) + instance Monoid a => Monoid (Identity a) where + mempty = Identity mempty + + -- deriving instance Num a => Num (Identity a) + instance Num a => Num (Identity a) where + Identity x + Identity y = Identity (x + y) + Identity x - Identity y = Identity (x - y) + Identity x * Identity y = Identity (x * y) + negate (Identity x) = Identity (negate x) + abs (Identity x) = Identity (abs x) + signum (Identity x) = Identity (signum x) + fromInteger n = Identity (fromInteger n) + + -- deriving instance Semigroup a => Semigroup (Identity a) + instance Semigroup a => Semigroup (Identity a) where + Identity x <> Identity y = Identity (x <> y) + + -- -| This instance would be equivalent to the derived instances of the + -- 'Identity' newtype if the 'runIdentity' field were removed + instance Show a => Show (Identity a) where + showsPrec d (Identity x) = showParen (d > 10) $ + showString "Identity " . showsPrec 11 x + + deriving instance Functor Identity + + instance Foldable Identity where + foldMap f (Identity x) = f x + + elem x (Identity y) = x == y + foldl f z (Identity x) = f z x + foldl' f z (Identity x) = f z x + foldl1 _ (Identity x) = x + foldr f z (Identity x) = f x z + foldr' = foldr + foldr1 _ (Identity x) = x + length _ = 1 + maximum (Identity x) = x + minimum (Identity x) = x + null _ = False + product (Identity x) = x + sum (Identity x) = x + toList (Identity x) = [x] + + instance Applicative Identity where + pure = Identity + Identity f <*> Identity x = Identity (f x) + liftA2 f (Identity x) (Identity y) = Identity (f x y) + + instance Monad Identity where + Identity m >>= k = k m + |]) 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,7 +8,7 @@ -} -{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies, EmptyCase, +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs, TypeFamilies, EmptyCase, FlexibleContexts, TemplateHaskell, ScopedTypeVariables, UndecidableInstances, TypeOperators, FlexibleInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/src/Data/Singletons/Prelude/IsString.hs b/src/Data/Singletons/Prelude/IsString.hs --- a/src/Data/Singletons/Prelude/IsString.hs +++ b/src/Data/Singletons/Prelude/IsString.hs @@ -1,14 +1,18 @@ -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.IsString -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -23,6 +27,10 @@ FromStringSym0, FromStringSym1 ) where +import Data.Functor.Const +import Data.Functor.Identity +import Data.Singletons.Prelude.Const +import Data.Singletons.Prelude.Identity import Data.Singletons.Single import Data.Singletons.TypeLits () -- for the IsString instance! import GHC.TypeLits (Symbol) @@ -32,6 +40,14 @@ -- extension (-XOverloadedStrings in GHC). class IsString a where fromString :: Symbol -> a + + -- deriving instance IsString a => IsString (Const a (b :: k)) + instance IsString a => IsString (Const a (b :: k)) where + fromString x = Const (fromString x) + + -- deriving instance IsString a => IsString (Identity a) + instance IsString a => IsString (Identity a) where + fromString x = Identity (fromString x) |]) -- PIsString instance 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 @@ -1,14 +1,11 @@ -{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TypeInType, - TemplateHaskell, GADTs, UndecidableInstances, RankNTypes, - ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-} -{-# OPTIONS_GHC -O0 #-} +{-# LANGUAGE ExplicitNamespaces #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -73,7 +70,9 @@ -- ** Extracting sublists Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, DropWhile, sDropWhile, DropWhileEnd, sDropWhileEnd, - Span, sSpan, Break, sBreak, Group, sGroup, + Span, sSpan, Break, sBreak, + StripPrefix, + Group, sGroup, Inits, sInits, Tails, sTails, -- ** Predicates @@ -93,7 +92,10 @@ FindIndex, sFindIndex, FindIndices, sFindIndices, -- * Zipping and unzipping lists - Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3, + Zip, sZip, Zip3, sZip3, + Zip4, Zip5, Zip6, Zip7, + ZipWith, sZipWith, ZipWith3, sZipWith3, + ZipWith4, ZipWith5, ZipWith6, ZipWith7, Unzip, sUnzip, Unzip3, sUnzip3, Unzip4, sUnzip4, Unzip5, sUnzip5, Unzip6, sUnzip6, Unzip7, sUnzip7, @@ -130,6 +132,8 @@ -- | The prefix \`@generic@\' indicates an overloaded function that -- is a generalized version of a "Prelude" function. GenericLength, sGenericLength, + GenericTake, GenericDrop, + GenericSplitAt, GenericIndex, GenericReplicate, -- * Defunctionalization symbols NilSym0, @@ -184,6 +188,7 @@ DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, SpanSym0, SpanSym1, SpanSym2, BreakSym0, BreakSym1, BreakSym2, + StripPrefixSym0, StripPrefixSym1, StripPrefixSym2, GroupSym0, GroupSym1, InitsSym0, InitsSym1, TailsSym0, TailsSym1, @@ -207,8 +212,16 @@ ZipSym0, ZipSym1, ZipSym2, Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, + Zip4Sym0, Zip4Sym1, Zip4Sym2, Zip4Sym3, Zip4Sym4, + Zip5Sym0, Zip5Sym1, Zip5Sym2, Zip5Sym3, Zip5Sym4, Zip5Sym5, + Zip6Sym0, Zip6Sym1, Zip6Sym2, Zip6Sym3, Zip6Sym4, Zip6Sym5, Zip6Sym6, + Zip7Sym0, Zip7Sym1, Zip7Sym2, Zip7Sym3, Zip7Sym4, Zip7Sym5, Zip7Sym6, Zip7Sym7, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4, + ZipWith4Sym0, ZipWith4Sym1, ZipWith4Sym2, ZipWith4Sym3, ZipWith4Sym4, ZipWith4Sym5, + ZipWith5Sym0, ZipWith5Sym1, ZipWith5Sym2, ZipWith5Sym3, ZipWith5Sym4, ZipWith5Sym5, ZipWith5Sym6, + ZipWith6Sym0, ZipWith6Sym1, ZipWith6Sym2, ZipWith6Sym3, ZipWith6Sym4, ZipWith6Sym5, ZipWith6Sym6, ZipWith6Sym7, + ZipWith7Sym0, ZipWith7Sym1, ZipWith7Sym2, ZipWith7Sym3, ZipWith7Sym4, ZipWith7Sym5, ZipWith7Sym6, ZipWith7Sym7, ZipWith7Sym8, UnzipSym0, UnzipSym1, Unzip3Sym0, Unzip3Sym1, Unzip4Sym0, Unzip4Sym1, @@ -240,579 +253,44 @@ MaximumBySym0, MaximumBySym1, MaximumBySym2, MinimumBySym0, MinimumBySym1, MinimumBySym2, - GenericLengthSym0, GenericLengthSym1 + GenericLengthSym0, GenericLengthSym1, + GenericTakeSym0, GenericTakeSym1, GenericTakeSym2, + GenericDropSym0, GenericDropSym1, GenericDropSym2, + GenericSplitAtSym0, GenericSplitAtSym1, GenericSplitAtSym2, + GenericIndexSym0, GenericIndexSym1, GenericIndexSym2, + GenericReplicateSym0, GenericReplicateSym1, GenericReplicateSym2, ) where -import Data.Singletons.Internal -import Data.Singletons.Prelude.Instances -import Data.Singletons.Single -import Data.Singletons.TypeLits import Data.Singletons.Prelude.Base -import Data.Singletons.Prelude.Bool -import Data.Singletons.Prelude.Eq -import Data.Singletons.Prelude.Maybe -import Data.Singletons.Prelude.Tuple -import Data.Singletons.Prelude.Num -import Data.Singletons.Prelude.Ord -import Data.Maybe - -$(singletonsOnly [d| - head :: [a] -> a - head (a : _) = a - head [] = error "Data.Singletons.List.head: empty list" - - last :: [a] -> a - last [] = error "Data.Singletons.List.last: empty list" - last [x] = x - last (_:x:xs) = last (x:xs) - - tail :: [a] -> [a] - tail (_ : t) = t - tail [] = error "Data.Singletons.List.tail: empty list" - - init :: [a] -> [a] - init [] = error "Data.Singletons.List.init: empty list" - init (x:xs) = init' x xs - where init' :: a -> [a] -> [a] - init' _ [] = [] - init' y (z:zs) = y : init' z zs - - null :: [a] -> Bool - null [] = True - null (_:_) = False - - reverse :: [a] -> [a] - reverse l = rev l [] - where - rev :: [a] -> [a] -> [a] - rev [] a = a - rev (x:xs) a = rev xs (x:a) - - intersperse :: a -> [a] -> [a] - intersperse _ [] = [] - intersperse sep (x:xs) = x : prependToAll sep xs - - intercalate :: [a] -> [[a]] -> [a] - intercalate xs xss = concat (intersperse xs xss) - - subsequences :: [a] -> [[a]] - subsequences xs = [] : nonEmptySubsequences xs - - nonEmptySubsequences :: [a] -> [[a]] - nonEmptySubsequences [] = [] - nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs) - where f ys r = ys : (x : ys) : r - - prependToAll :: a -> [a] -> [a] - prependToAll _ [] = [] - prependToAll sep (x:xs) = sep : x : prependToAll sep xs - - permutations :: forall a. [a] -> [[a]] - permutations xs0 = xs0 : perms xs0 [] - where - perms [] _ = [] - perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is) - where interleave xs r = let (_,zs) = interleave' id xs r in zs - - -- This type signature isn't present in the reference - -- implementation of permutations in base. However, it is needed - -- here, since (at least in GHC 8.2.1) the singletonized version - -- will fail to typecheck without it. See #13549 for the full story. - interleave' :: ([a] -> b) -> [a] -> [b] -> ([a], [b]) - interleave' _ [] r = (ts, r) - interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r - in (y:us, f (t:y:us) : zs) - - foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b - foldl' f z0 xs0 = lgo z0 xs0 - where lgo :: b -> [a] -> b - lgo z [] = z - lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs - - foldl1 :: (a -> a -> a) -> [a] -> a - foldl1 f (x:xs) = foldl f x xs - foldl1 _ [] = error "Data.Singletons.List.foldl1: empty list" - - foldl1' :: (a -> a -> a) -> [a] -> a - foldl1' f (x:xs) = foldl' f x xs - foldl1' _ [] = error "Data.Singletons.List.foldl1': empty list" - - foldr1 :: (a -> a -> a) -> [a] -> a - foldr1 _ [x] = x - foldr1 f (x:xs@(_:_)) = f x (foldr1 f xs) - foldr1 _ [] = error "Data.Singletons.List.foldr1: empty list" - - concat :: [[a]] -> [a] - concat = foldr (++) [] - - concatMap :: (a -> [b]) -> [a] -> [b] - concatMap f = foldr ((++) . f) [] - - and :: [Bool] -> Bool - and [] = True - and (x:xs) = x && and xs - - or :: [Bool] -> Bool - or [] = False - or (x:xs) = x || or xs - - all :: (a -> Bool) -> [a] -> Bool - all _ [] = True - all p (x:xs) = p x && all p xs - - any :: (a -> Bool) -> [a] -> Bool - any _ [] = False - any p (x:xs) = p x || any p xs - - scanl :: (b -> a -> b) -> b -> [a] -> [b] - scanl f q ls = q : (case ls of - [] -> [] - x:xs -> scanl f (f q x) xs) - scanl1 :: (a -> a -> a) -> [a] -> [a] - scanl1 f (x:xs) = scanl f x xs - scanl1 _ [] = [] - - scanr :: (a -> b -> b) -> b -> [a] -> [b] - scanr _ q0 [] = [q0] - scanr f q0 (x:xs) = case scanr f q0 xs of - [] -> error "Data.Singletons.List.scanr: empty list" - (q:qs) -> f x q : (q:qs) - - scanr1 :: (a -> a -> a) -> [a] -> [a] - scanr1 _ [] = [] - scanr1 _ [x] = [x] - scanr1 f (x:xs@(_:_)) = case scanr1 f xs of - [] -> error "Data.Singletons.List.scanr1: empty list" - (q:qs) -> f x q : (q:qs) - - mapAccumL :: (acc -> x -> (acc, y)) - -> acc - -> [x] - -> (acc, [y]) - mapAccumL _ s [] = (s, []) - mapAccumL f s (x:xs) = (s'',y:ys) - where (s', y ) = f s x - (s'',ys) = mapAccumL f s' xs - - mapAccumR :: (acc -> x -> (acc, y)) - -> acc - -> [x] - -> (acc, [y]) - mapAccumR _ s [] = (s, []) - mapAccumR f s (x:xs) = (s'', y:ys) - where (s'',y ) = f s' x - (s', ys) = mapAccumR f s xs - - unfoldr :: (b -> Maybe (a, b)) -> b -> [a] - unfoldr f b = - case f b of - Just (a,new_b) -> a : unfoldr f new_b - Nothing -> [] - - inits :: [a] -> [[a]] - inits xs = [] : case xs of - [] -> [] - x : xs' -> map (x :) (inits xs') - - tails :: [a] -> [[a]] - tails xs = xs : case xs of - [] -> [] - _ : xs' -> tails xs' - - isPrefixOf :: (Eq a) => [a] -> [a] -> Bool - isPrefixOf [] [] = True - isPrefixOf [] (_:_) = True - isPrefixOf (_:_) [] = False - isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys - - isSuffixOf :: (Eq a) => [a] -> [a] -> Bool - isSuffixOf x y = reverse x `isPrefixOf` reverse y - - isInfixOf :: (Eq a) => [a] -> [a] -> Bool - isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) - - elem :: (Eq a) => a -> [a] -> Bool - elem _ [] = False - elem x (y:ys) = x==y || elem x ys - infix 4 `elem` - - notElem :: (Eq a) => a -> [a] -> Bool - notElem _ [] = True - notElem x (y:ys) = x /= y && notElem x ys - infix 4 `notElem` - - zip :: [a] -> [b] -> [(a,b)] - zip (x:xs) (y:ys) = (x,y) : zip xs ys - zip [] [] = [] - zip (_:_) [] = [] - zip [] (_:_) = [] - - zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] - zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs - zip3 [] [] [] = [] - zip3 [] [] (_:_) = [] - zip3 [] (_:_) [] = [] - zip3 [] (_:_) (_:_) = [] - zip3 (_:_) [] [] = [] - zip3 (_:_) [] (_:_) = [] - zip3 (_:_) (_:_) [] = [] - - zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys - zipWith _ [] [] = [] - zipWith _ (_:_) [] = [] - zipWith _ [] (_:_) = [] - - zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] - zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs - zipWith3 _ [] [] [] = [] - zipWith3 _ [] [] (_:_) = [] - zipWith3 _ [] (_:_) [] = [] - zipWith3 _ [] (_:_) (_:_) = [] - zipWith3 _ (_:_) [] [] = [] - zipWith3 _ (_:_) [] (_:_) = [] - zipWith3 _ (_:_) (_:_) [] = [] - - unzip :: [(a,b)] -> ([a],[b]) - unzip xs = foldr (\(a,b) (as,bs) -> (a:as,b:bs)) ([],[]) xs - - -- Lazy patterns removed from unzip - unzip3 :: [(a,b,c)] -> ([a],[b],[c]) - unzip3 xs = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs)) - ([],[],[]) xs - - unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d]) - unzip4 xs = foldr (\(a,b,c,d) (as,bs,cs,ds) -> - (a:as,b:bs,c:cs,d:ds)) - ([],[],[],[]) xs - - unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e]) - unzip5 xs = foldr (\(a,b,c,d,e) (as,bs,cs,ds,es) -> - (a:as,b:bs,c:cs,d:ds,e:es)) - ([],[],[],[],[]) xs - - unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f]) - unzip6 xs = foldr (\(a,b,c,d,e,f) (as,bs,cs,ds,es,fs) -> - (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) - ([],[],[],[],[],[]) xs - - unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g]) - unzip7 xs = foldr (\(a,b,c,d,e,f,g) (as,bs,cs,ds,es,fs,gs) -> - (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) - ([],[],[],[],[],[],[]) xs - --- We can't promote any of these functions because at the type level --- String literals are no longer considered to be lists of Chars, so --- there is mismatch between term-level and type-level semantics --- lines :: String -> [String] --- lines "" = [] --- lines s = cons (case break (== '\n') s of --- (l, s') -> (l, case s' of --- [] -> [] --- _:s'' -> lines s'')) --- where --- cons ~(h, t) = h : t --- --- words :: String -> [String] --- words s = case dropWhile isSpace s of --- "" -> [] --- s' -> w : words s'' --- where (w, s'') = --- break isSpace s' - - unlines :: [Symbol] -> Symbol - unlines [] = "" - unlines (l:ls) = l <> "\n" <> unlines ls - - unwords :: [Symbol] -> Symbol - unwords [] = "" - unwords (w:ws) = w <> go ws - where - go [] = "" - go (v:vs) = " " <> (v <> go vs) - - delete :: (Eq a) => a -> [a] -> [a] - delete = deleteBy (==) - - (\\) :: (Eq a) => [a] -> [a] -> [a] - (\\) = foldl (flip delete) - infix 5 \\ -- This comment is necessary so CPP doesn't treat the - -- trailing backslash as a line splice. Urgh. - - deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] - deleteBy _ _ [] = [] - deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys - - deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] - deleteFirstsBy eq = foldl (flip (deleteBy eq)) - - sortBy :: (a -> a -> Ordering) -> [a] -> [a] - sortBy cmp = foldr (insertBy cmp) [] - - insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] - insertBy _ x [] = [x] - insertBy cmp x ys@(y:ys') - = case cmp x y of - GT -> y : insertBy cmp x ys' - LT -> x : ys - EQ -> x : ys - - maximumBy :: (a -> a -> Ordering) -> [a] -> a - maximumBy _ [] = error "Data.Singletons.List.maximumBy: empty list" - maximumBy cmp xs@(_:_) = foldl1 maxBy xs - where - maxBy x y = case cmp x y of - GT -> x - EQ -> y - LT -> y - - minimumBy :: (a -> a -> Ordering) -> [a] -> a - minimumBy _ [] = error "Data.Singletons.List.minimumBy: empty list" - minimumBy cmp xs@(_:_) = foldl1 minBy xs - where - minBy x y = case cmp x y of - GT -> y - EQ -> x - LT -> x - - filter :: (a -> Bool) -> [a] -> [a] - filter _p [] = [] - filter p (x:xs) = if p x then x : filter p xs else filter p xs - - find :: (a -> Bool) -> [a] -> Maybe a - find p = listToMaybe . filter p - --- These three rely on findIndices, which does not promote. --- Since we have our own implementation of findIndices these are perfectly valid - elemIndex :: Eq a => a -> [a] -> Maybe Nat - elemIndex x = findIndex (x==) - - elemIndices :: Eq a => a -> [a] -> [Nat] - elemIndices x = findIndices (x==) - - findIndex :: (a -> Bool) -> [a] -> Maybe Nat - findIndex p = listToMaybe . findIndices p - --- Uses list comprehensions, infinite lists and and Ints --- findIndices :: (a -> Bool) -> [a] -> [Int] --- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] - - findIndices :: (a -> Bool) -> [a] -> [Nat] - findIndices p xs = map snd (filter (\(x,_) -> p x) - (zip xs (buildList 0 xs))) - where buildList :: Nat -> [b] -> [Nat] - buildList _ [] = [] - buildList a (_:rest) = a : buildList (a+1) rest - - -- Relies on intersectBy, which does not singletonize - intersect :: (Eq a) => [a] -> [a] -> [a] - intersect = intersectBy (==) - --- Uses list comprehensions. --- intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] --- intersectBy _ [] [] = [] --- intersectBy _ [] (_:_) = [] --- intersectBy _ (_:_) [] = [] --- intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] - - intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] - intersectBy _ [] [] = [] - intersectBy _ [] (_:_) = [] - intersectBy _ (_:_) [] = [] - intersectBy eq xs@(_:_) ys@(_:_) = filter (\x -> any (eq x) ys) xs - - takeWhile :: (a -> Bool) -> [a] -> [a] - takeWhile _ [] = [] - takeWhile p (x:xs) = if p x then x : takeWhile p xs else [] - - dropWhile :: (a -> Bool) -> [a] -> [a] - dropWhile _ [] = [] - dropWhile p xs@(x:xs') = if p x then dropWhile p xs' else xs - - dropWhileEnd :: (a -> Bool) -> [a] -> [a] - dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] - - span :: (a -> Bool) -> [a] -> ([a],[a]) - span _ xs@[] = (xs, xs) - span p xs@(x:xs') = if p x then let (ys,zs) = span p xs' in (x:ys,zs) - else ([], xs) - - break :: (a -> Bool) -> [a] -> ([a],[a]) - break _ xs@[] = (xs, xs) - break p xs@(x:xs') = if p x then ([],xs) - else let (ys,zs) = break p xs' in (x:ys,zs) - --- Can't be promoted because of limitations of Int promotion --- Below is a re-implementation using Nat --- take :: Int -> [a] -> [a] --- take n _ | n <= 0 = [] --- take _ [] = [] --- take n (x:xs) = x : take (n-1) xs - --- drop :: Int -> [a] -> [a] --- drop n xs | n <= 0 = xs --- drop _ [] = [] --- drop n (_:xs) = drop (n-1) xs - --- splitAt :: Int -> [a] -> ([a],[a]) --- splitAt n xs = (take n xs, drop n xs) - - take :: Nat -> [a] -> [a] - take _ [] = [] - take n (x:xs) = if n == 0 then [] else x : take (n-1) xs - - drop :: Nat -> [a] -> [a] - drop _ [] = [] - drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs - - splitAt :: Nat -> [a] -> ([a],[a]) - splitAt n xs = (take n xs, drop n xs) - - group :: Eq a => [a] -> [[a]] - group xs = groupBy (==) xs - - maximum :: (Ord a) => [a] -> a - maximum [] = error "Data.Singletons.List.maximum: empty list" - maximum xs@(_:_) = foldl1 max xs - - minimum :: (Ord a) => [a] -> a - minimum [] = error "Data.Singletons.List.minimum: empty list" - minimum xs@(_:_) = foldl1 min xs - - insert :: Ord a => a -> [a] -> [a] - insert e ls = insertBy (compare) e ls - - sort :: (Ord a) => [a] -> [a] - sort = sortBy compare - - groupBy :: (a -> a -> Bool) -> [a] -> [[a]] - groupBy _ [] = [] - groupBy eq (x:xs) = (x:ys) : groupBy eq zs - where (ys,zs) = span (eq x) xs - - lookup :: (Eq a) => a -> [(a,b)] -> Maybe b - lookup _key [] = Nothing - lookup key ((x,y):xys) = if key == x then Just y else lookup key xys - - partition :: (a -> Bool) -> [a] -> ([a],[a]) - partition p xs = foldr (select p) ([],[]) xs - - -- Lazy pattern removed from select - select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) - select p x (ts,fs) = if p x then (x:ts,fs) else (ts, x:fs) - --- Can't be promoted because of limitations of Int promotion --- Below is a re-implementation using Nat --- sum :: (Num a) => [a] -> a --- sum l = sum' l 0 --- where --- sum' [] a = a --- sum' (x:xs) a = sum' xs (a+x) --- --- product :: (Num a) => [a] -> a --- product l = prod l 1 --- where --- prod [] a = a --- prod (x:xs) a = prod xs (a*x) - - sum :: forall a. Num a => [a] -> a - sum l = sum' l 0 - where - sum' :: [a] -> a -> a - sum' [] a = a - sum' (x:xs) a = sum' xs (a+x) - - product :: forall a. Num a => [a] -> a - product l = prod l 1 - where - prod :: [a] -> a -> a - prod [] a = a - prod (x:xs) a = prod xs (a*x) - - --- Can't be promoted because of limitations of Int promotion --- Below is a re-implementation using Nat --- length :: [a] -> Int --- length l = lenAcc l 0# --- --- lenAcc :: [a] -> Int# -> Int --- lenAcc [] a# = I# a# --- lenAcc (_:xs) a# = lenAcc xs (a# +# 1#) --- --- incLen :: a -> (Int# -> Int) -> Int# -> Int --- incLen _ g x = g (x +# 1#) - - length :: [a] -> Nat - length [] = 0 - length (_:xs) = 1 + length xs - --- Functions working on infinite lists don't promote because they create --- infinite types. replicate also uses integers, but luckily it can be rewritten --- iterate :: (a -> a) -> a -> [a] --- iterate f x = x : iterate f (f x) --- --- repeat :: a -> [a] --- repeat x = xs where xs = x : xs --- --- replicate :: Int -> a -> [a] --- replicate n x = take n (repeat x) --- --- cycle :: [a] -> [a] --- cycle [] = error "Data.Singletons.List.cycle: empty list" --- cycle xs = xs' where xs' = xs ++ xs' - - replicate :: Nat -> a -> [a] - replicate n x = if n == 0 then [] else x : replicate (n-1) x - --- Uses list comprehensions --- transpose :: [[a]] -> [[a]] --- transpose [] = [] --- transpose ([] : xss) = transpose xss --- transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) - - transpose :: [[a]] -> [[a]] - transpose [] = [] - transpose ([] : xss) = transpose xss - transpose ((x:xs) : xss) = (x : (map head xss)) : transpose (xs : (map tail xss)) - --- Can't be promoted because of limitations of Int promotion. --- Below is a re-implementation using Nat --- (!!) :: [a] -> Int -> a --- xs !! n | n < 0 = error "Data.Singletons.List.!!: negative index" --- [] !! _ = error "Data.Singletons.List.!!: index too large" --- (x:_) !! 0 = x --- (_:xs) !! n = xs !! (n-1) - - (!!) :: [a] -> Nat -> a - [] !! _ = error "Data.Singletons.List.!!: index too large" - (x:xs) !! n = if n == 0 then x else xs !! (n-1) - infixl 9 !! - - nub :: forall a. (Eq a) => [a] -> [a] - nub l = nub' l [] - where - nub' :: [a] -> [a] -> [a] - nub' [] _ = [] - nub' (x:xs) ls = if x `elem` ls then nub' xs ls else x : nub' xs (x:ls) - - nubBy :: (a -> a -> Bool) -> [a] -> [a] - nubBy eq l = nubBy' l [] - where - nubBy' [] _ = [] - nubBy' (y:ys) xs = if elem_by eq y xs then nubBy' ys xs else y : nubBy' ys (y:xs) - - elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool - elem_by _ _ [] = False - elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs - - unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] - unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs - - union :: (Eq a) => [a] -> [a] -> [a] - union = unionBy (==) - - genericLength :: (Num i) => [a] -> i - genericLength [] = 0 - genericLength (_:xs) = 1 + genericLength xs + ( Map, MapSym0, MapSym1, MapSym2, sMap + , type (++), type (++@#@$), type (++@#@$$), type (++@#@$$$), (%++) + ) +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Instances + (Sing(..), SList, NilSym0, type (:@#@$), type (:@#@$$), type (:@#@$$$)) +import Data.Singletons.Prelude.Traversable - |]) +import Data.Singletons.Prelude.List.Internal + hiding ( All, AllSym0, AllSym1, AllSym2, sAll + , And, AndSym0, AndSym1, sAnd + , Any, AnySym0, AnySym1, AnySym2, sAny + , Concat, ConcatSym0, ConcatSym1, sConcat + , ConcatMap, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, sConcatMap + , Elem, ElemSym0, ElemSym1, ElemSym2, sElem + , Find, FindSym0, FindSym1, FindSym2, sFind + , Foldl1, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, sFoldl1 + , Foldl', Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, sFoldl' + , Foldr1, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, sFoldr1 + , MapAccumL, MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, sMapAccumL + , MapAccumR, MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, sMapAccumR + , Maximum, MaximumSym0, MaximumSym1, sMaximum + , MaximumBy, MaximumBySym0, MaximumBySym1, MaximumBySym2, sMaximumBy + , Minimum, MinimumSym0, MinimumSym1, sMinimum + , MinimumBy, MinimumBySym0, MinimumBySym1, MinimumBySym2, sMinimumBy + , Length, LengthSym0, LengthSym1, sLength + , NotElem, NotElemSym0, NotElemSym1, NotElemSym2, sNotElem + , Null, NullSym0, NullSym1, sNull + , Or, OrSym0, OrSym1, sOr + , Product, ProductSym0, ProductSym1, sProduct + , Sum, SumSym0, SumSym1, sSum + ) diff --git a/src/Data/Singletons/Prelude/List/Internal.hs b/src/Data/Singletons/Prelude/List/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/List/Internal.hs @@ -0,0 +1,670 @@ +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, + TemplateHaskell, GADTs, UndecidableInstances, RankNTypes, + ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-} +{-# OPTIONS_GHC -O0 #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.List.Internal +-- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines functions and datatypes relating to the singleton for '[]', +-- including a singletons version of a few of the definitions in @Data.List@. +-- +-- All of the functions defined in this module are specialized for lists, +-- unlike "Data.Singletons.Prelude.List", which uses 'Foldable' and +-- 'Traversable' contexts when available. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.List.Internal where + +import Data.Singletons.Prelude.Instances +import Data.Singletons.Promote +import Data.Singletons.Single +import Data.Singletons.TypeLits +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Bool +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Maybe +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Semigroup.Internal (SSemigroup(..), type (<>@#@$)) +import Data.Singletons.Prelude.Tuple +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Maybe + +$(singletonsOnly [d| + head :: [a] -> a + head (a : _) = a + head [] = error "Data.Singletons.List.head: empty list" + + last :: [a] -> a + last [] = error "Data.Singletons.List.last: empty list" + last [x] = x + last (_:x:xs) = last (x:xs) + + tail :: [a] -> [a] + tail (_ : t) = t + tail [] = error "Data.Singletons.List.tail: empty list" + + init :: [a] -> [a] + init [] = error "Data.Singletons.List.init: empty list" + init (x:xs) = init' x xs + where init' :: a -> [a] -> [a] + init' _ [] = [] + init' y (z:zs) = y : init' z zs + + null :: [a] -> Bool + null [] = True + null (_:_) = False + + reverse :: [a] -> [a] + reverse l = rev l [] + where + rev :: [a] -> [a] -> [a] + rev [] a = a + rev (x:xs) a = rev xs (x:a) + + intersperse :: a -> [a] -> [a] + intersperse _ [] = [] + intersperse sep (x:xs) = x : prependToAll sep xs + + intercalate :: [a] -> [[a]] -> [a] + intercalate xs xss = concat (intersperse xs xss) + + subsequences :: [a] -> [[a]] + subsequences xs = [] : nonEmptySubsequences xs + + nonEmptySubsequences :: [a] -> [[a]] + nonEmptySubsequences [] = [] + nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs) + where f ys r = ys : (x : ys) : r + + prependToAll :: a -> [a] -> [a] + prependToAll _ [] = [] + prependToAll sep (x:xs) = sep : x : prependToAll sep xs + + permutations :: forall a. [a] -> [[a]] + permutations xs0 = xs0 : perms xs0 [] + where + perms [] _ = [] + perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is) + where interleave xs r = let (_,zs) = interleave' id xs r in zs + + -- This type signature isn't present in the reference + -- implementation of permutations in base. However, it is needed + -- here, since (at least in GHC 8.2.1) the singletonized version + -- will fail to typecheck without it. See #13549 for the full story. + interleave' :: ([a] -> b) -> [a] -> [b] -> ([a], [b]) + interleave' _ [] r = (ts, r) + interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r + in (y:us, f (t:y:us) : zs) + + foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b + foldl' f z0 xs0 = lgo z0 xs0 + where lgo :: b -> [a] -> b + lgo z [] = z + lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs + + foldl1 :: (a -> a -> a) -> [a] -> a + foldl1 f (x:xs) = foldl f x xs + foldl1 _ [] = error "Data.Singletons.List.foldl1: empty list" + + foldl1' :: (a -> a -> a) -> [a] -> a + foldl1' f (x:xs) = foldl' f x xs + foldl1' _ [] = error "Data.Singletons.List.foldl1': empty list" + + foldr1 :: (a -> a -> a) -> [a] -> a + foldr1 _ [x] = x + foldr1 f (x:xs@(_:_)) = f x (foldr1 f xs) + foldr1 _ [] = error "Data.Singletons.List.foldr1: empty list" + + concat :: [[a]] -> [a] + concat = foldr (++) [] + + concatMap :: (a -> [b]) -> [a] -> [b] + concatMap f = foldr ((++) . f) [] + + and :: [Bool] -> Bool + and [] = True + and (x:xs) = x && and xs + + or :: [Bool] -> Bool + or [] = False + or (x:xs) = x || or xs + + all :: (a -> Bool) -> [a] -> Bool + all _ [] = True + all p (x:xs) = p x && all p xs + + any :: (a -> Bool) -> [a] -> Bool + any _ [] = False + any p (x:xs) = p x || any p xs + + scanl :: (b -> a -> b) -> b -> [a] -> [b] + scanl f q ls = q : (case ls of + [] -> [] + x:xs -> scanl f (f q x) xs) + scanl1 :: (a -> a -> a) -> [a] -> [a] + scanl1 f (x:xs) = scanl f x xs + scanl1 _ [] = [] + + scanr :: (a -> b -> b) -> b -> [a] -> [b] + scanr _ q0 [] = [q0] + scanr f q0 (x:xs) = case scanr f q0 xs of + [] -> error "Data.Singletons.List.scanr: empty list" + (q:qs) -> f x q : (q:qs) + + scanr1 :: (a -> a -> a) -> [a] -> [a] + scanr1 _ [] = [] + scanr1 _ [x] = [x] + scanr1 f (x:xs@(_:_)) = case scanr1 f xs of + [] -> error "Data.Singletons.List.scanr1: empty list" + (q:qs) -> f x q : (q:qs) + + mapAccumL :: (acc -> x -> (acc, y)) + -> acc + -> [x] + -> (acc, [y]) + mapAccumL _ s [] = (s, []) + mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' xs + + mapAccumR :: (acc -> x -> (acc, y)) + -> acc + -> [x] + -> (acc, [y]) + mapAccumR _ s [] = (s, []) + mapAccumR f s (x:xs) = (s'', y:ys) + where (s'',y ) = f s' x + (s', ys) = mapAccumR f s xs + + unfoldr :: (b -> Maybe (a, b)) -> b -> [a] + unfoldr f b = + case f b of + Just (a,new_b) -> a : unfoldr f new_b + Nothing -> [] + + inits :: [a] -> [[a]] + inits xs = [] : case xs of + [] -> [] + x : xs' -> map (x :) (inits xs') + + tails :: [a] -> [[a]] + tails xs = xs : case xs of + [] -> [] + _ : xs' -> tails xs' + + isPrefixOf :: (Eq a) => [a] -> [a] -> Bool + isPrefixOf [] [] = True + isPrefixOf [] (_:_) = True + isPrefixOf (_:_) [] = False + isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys + + isSuffixOf :: (Eq a) => [a] -> [a] -> Bool + isSuffixOf x y = reverse x `isPrefixOf` reverse y + + isInfixOf :: (Eq a) => [a] -> [a] -> Bool + isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) + + elem :: (Eq a) => a -> [a] -> Bool + elem _ [] = False + elem x (y:ys) = x==y || elem x ys + infix 4 `elem` + + notElem :: (Eq a) => a -> [a] -> Bool + notElem _ [] = True + notElem x (y:ys) = x /= y && notElem x ys + infix 4 `notElem` + + zip :: [a] -> [b] -> [(a,b)] + zip (x:xs) (y:ys) = (x,y) : zip xs ys + zip [] [] = [] + zip (_:_) [] = [] + zip [] (_:_) = [] + + zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] + zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs + zip3 [] [] [] = [] + zip3 [] [] (_:_) = [] + zip3 [] (_:_) [] = [] + zip3 [] (_:_) (_:_) = [] + zip3 (_:_) [] [] = [] + zip3 (_:_) [] (_:_) = [] + zip3 (_:_) (_:_) [] = [] + + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys + zipWith _ [] [] = [] + zipWith _ (_:_) [] = [] + zipWith _ [] (_:_) = [] + + zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] + zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs + zipWith3 _ [] [] [] = [] + zipWith3 _ [] [] (_:_) = [] + zipWith3 _ [] (_:_) [] = [] + zipWith3 _ [] (_:_) (_:_) = [] + zipWith3 _ (_:_) [] [] = [] + zipWith3 _ (_:_) [] (_:_) = [] + zipWith3 _ (_:_) (_:_) [] = [] + + unzip :: [(a,b)] -> ([a],[b]) + unzip xs = foldr (\(a,b) (as,bs) -> (a:as,b:bs)) ([],[]) xs + + -- Lazy patterns removed from unzip + unzip3 :: [(a,b,c)] -> ([a],[b],[c]) + unzip3 xs = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs)) + ([],[],[]) xs + + unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d]) + unzip4 xs = foldr (\(a,b,c,d) (as,bs,cs,ds) -> + (a:as,b:bs,c:cs,d:ds)) + ([],[],[],[]) xs + + unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e]) + unzip5 xs = foldr (\(a,b,c,d,e) (as,bs,cs,ds,es) -> + (a:as,b:bs,c:cs,d:ds,e:es)) + ([],[],[],[],[]) xs + + unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f]) + unzip6 xs = foldr (\(a,b,c,d,e,f) (as,bs,cs,ds,es,fs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) + ([],[],[],[],[],[]) xs + + unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g]) + unzip7 xs = foldr (\(a,b,c,d,e,f,g) (as,bs,cs,ds,es,fs,gs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) + ([],[],[],[],[],[],[]) xs + +-- We can't promote any of these functions because at the type level +-- String literals are no longer considered to be lists of Chars, so +-- there is mismatch between term-level and type-level semantics +-- lines :: String -> [String] +-- lines "" = [] +-- lines s = cons (case break (== '\n') s of +-- (l, s') -> (l, case s' of +-- [] -> [] +-- _:s'' -> lines s'')) +-- where +-- cons ~(h, t) = h : t +-- +-- words :: String -> [String] +-- words s = case dropWhile isSpace s of +-- "" -> [] +-- s' -> w : words s'' +-- where (w, s'') = +-- break isSpace s' + + unlines :: [Symbol] -> Symbol + unlines [] = "" + unlines (l:ls) = l <> "\n" <> unlines ls + + unwords :: [Symbol] -> Symbol + unwords [] = "" + unwords (w:ws) = w <> go ws + where + go [] = "" + go (v:vs) = " " <> (v <> go vs) + + delete :: (Eq a) => a -> [a] -> [a] + delete = deleteBy (==) + + (\\) :: (Eq a) => [a] -> [a] -> [a] + (\\) = foldl (flip delete) + infix 5 \\ -- This comment is necessary so CPP doesn't treat the + -- trailing backslash as a line splice. Urgh. + + deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] + deleteBy _ _ [] = [] + deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys + + deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] + deleteFirstsBy eq = foldl (flip (deleteBy eq)) + + sortBy :: (a -> a -> Ordering) -> [a] -> [a] + sortBy cmp = foldr (insertBy cmp) [] + + insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] + insertBy _ x [] = [x] + insertBy cmp x ys@(y:ys') + = case cmp x y of + GT -> y : insertBy cmp x ys' + LT -> x : ys + EQ -> x : ys + + maximumBy :: (a -> a -> Ordering) -> [a] -> a + maximumBy _ [] = error "Data.Singletons.List.maximumBy: empty list" + maximumBy cmp xs@(_:_) = foldl1 maxBy xs + where + maxBy x y = case cmp x y of + GT -> x + EQ -> y + LT -> y + + minimumBy :: (a -> a -> Ordering) -> [a] -> a + minimumBy _ [] = error "Data.Singletons.List.minimumBy: empty list" + minimumBy cmp xs@(_:_) = foldl1 minBy xs + where + minBy x y = case cmp x y of + GT -> y + EQ -> x + LT -> x + + filter :: (a -> Bool) -> [a] -> [a] + filter _p [] = [] + filter p (x:xs) = if p x then x : filter p xs else filter p xs + + find :: (a -> Bool) -> [a] -> Maybe a + find p = listToMaybe . filter p + +-- These three rely on findIndices, which does not promote. +-- Since we have our own implementation of findIndices these are perfectly valid + elemIndex :: Eq a => a -> [a] -> Maybe Nat + elemIndex x = findIndex (x==) + + elemIndices :: Eq a => a -> [a] -> [Nat] + elemIndices x = findIndices (x==) + + findIndex :: (a -> Bool) -> [a] -> Maybe Nat + findIndex p = listToMaybe . findIndices p + +-- Uses infinite lists and and Ints +-- findIndices :: (a -> Bool) -> [a] -> [Int] +-- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] + + findIndices :: (a -> Bool) -> [a] -> [Nat] + findIndices p xs = map snd (filter (\(x,_) -> p x) + (zip xs (buildList 0 xs))) + where buildList :: Nat -> [b] -> [Nat] + buildList _ [] = [] + buildList a (_:rest) = a : buildList (a+1) rest + + intersect :: (Eq a) => [a] -> [a] -> [a] + intersect = intersectBy (==) + + intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] + intersectBy _ [] [] = [] + intersectBy _ [] (_:_) = [] + intersectBy _ (_:_) [] = [] + intersectBy eq xs@(_:_) ys@(_:_) = [x | x <- xs, any (eq x) ys] + + takeWhile :: (a -> Bool) -> [a] -> [a] + takeWhile _ [] = [] + takeWhile p (x:xs) = if p x then x : takeWhile p xs else [] + + dropWhile :: (a -> Bool) -> [a] -> [a] + dropWhile _ [] = [] + dropWhile p xs@(x:xs') = if p x then dropWhile p xs' else xs + + dropWhileEnd :: (a -> Bool) -> [a] -> [a] + dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] + + span :: (a -> Bool) -> [a] -> ([a],[a]) + span _ xs@[] = (xs, xs) + span p xs@(x:xs') = if p x then let (ys,zs) = span p xs' in (x:ys,zs) + else ([], xs) + + break :: (a -> Bool) -> [a] -> ([a],[a]) + break _ xs@[] = (xs, xs) + break p xs@(x:xs') = if p x then ([],xs) + else let (ys,zs) = break p xs' in (x:ys,zs) + +-- Can't be promoted because of limitations of Int promotion +-- Below is a re-implementation using Nat +-- take :: Int -> [a] -> [a] +-- take n _ | n <= 0 = [] +-- take _ [] = [] +-- take n (x:xs) = x : take (n-1) xs + +-- drop :: Int -> [a] -> [a] +-- drop n xs | n <= 0 = xs +-- drop _ [] = [] +-- drop n (_:xs) = drop (n-1) xs + +-- splitAt :: Int -> [a] -> ([a],[a]) +-- splitAt n xs = (take n xs, drop n xs) + + take :: Nat -> [a] -> [a] + take _ [] = [] + take n (x:xs) = if n == 0 then [] else x : take (n-1) xs + + drop :: Nat -> [a] -> [a] + drop _ [] = [] + drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs + + splitAt :: Nat -> [a] -> ([a],[a]) + splitAt n xs = (take n xs, drop n xs) + + group :: Eq a => [a] -> [[a]] + group xs = groupBy (==) xs + + maximum :: (Ord a) => [a] -> a + maximum [] = error "Data.Singletons.List.maximum: empty list" + maximum xs@(_:_) = foldl1 max xs + + minimum :: (Ord a) => [a] -> a + minimum [] = error "Data.Singletons.List.minimum: empty list" + minimum xs@(_:_) = foldl1 min xs + + insert :: Ord a => a -> [a] -> [a] + insert e ls = insertBy (compare) e ls + + sort :: (Ord a) => [a] -> [a] + sort = sortBy compare + + groupBy :: (a -> a -> Bool) -> [a] -> [[a]] + groupBy _ [] = [] + groupBy eq (x:xs) = (x:ys) : groupBy eq zs + where (ys,zs) = span (eq x) xs + + lookup :: (Eq a) => a -> [(a,b)] -> Maybe b + lookup _key [] = Nothing + lookup key ((x,y):xys) = if key == x then Just y else lookup key xys + + partition :: (a -> Bool) -> [a] -> ([a],[a]) + partition p xs = foldr (select p) ([],[]) xs + + -- Lazy pattern removed from select + select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) + select p x (ts,fs) = if p x then (x:ts,fs) else (ts, x:fs) + +-- Can't be promoted because of limitations of Int promotion +-- Below is a re-implementation using Nat +-- sum :: (Num a) => [a] -> a +-- sum l = sum' l 0 +-- where +-- sum' [] a = a +-- sum' (x:xs) a = sum' xs (a+x) +-- +-- product :: (Num a) => [a] -> a +-- product l = prod l 1 +-- where +-- prod [] a = a +-- prod (x:xs) a = prod xs (a*x) + + sum :: forall a. Num a => [a] -> a + sum l = sum' l 0 + where + sum' :: [a] -> a -> a + sum' [] a = a + sum' (x:xs) a = sum' xs (a+x) + + product :: forall a. Num a => [a] -> a + product l = prod l 1 + where + prod :: [a] -> a -> a + prod [] a = a + prod (x:xs) a = prod xs (a*x) + + +-- Can't be promoted because of limitations of Int promotion +-- Below is a re-implementation using Nat +-- length :: [a] -> Int +-- length l = lenAcc l 0# +-- +-- lenAcc :: [a] -> Int# -> Int +-- lenAcc [] a# = I# a# +-- lenAcc (_:xs) a# = lenAcc xs (a# +# 1#) +-- +-- incLen :: a -> (Int# -> Int) -> Int# -> Int +-- incLen _ g x = g (x +# 1#) + + length :: [a] -> Nat + length [] = 0 + length (_:xs) = 1 + length xs + +-- Functions working on infinite lists don't promote because they create +-- infinite types. replicate also uses integers, but luckily it can be rewritten +-- iterate :: (a -> a) -> a -> [a] +-- iterate f x = x : iterate f (f x) +-- +-- repeat :: a -> [a] +-- repeat x = xs where xs = x : xs +-- +-- replicate :: Int -> a -> [a] +-- replicate n x = take n (repeat x) +-- +-- cycle :: [a] -> [a] +-- cycle [] = error "Data.Singletons.List.cycle: empty list" +-- cycle xs = xs' where xs' = xs ++ xs' + + replicate :: Nat -> a -> [a] + replicate n x = if n == 0 then [] else x : replicate (n-1) x + +-- Uses partial pattern-matching in a list comprehension +-- (see https://github.com/goldfirere/singletons/issues/340) +-- transpose :: [[a]] -> [[a]] +-- transpose [] = [] +-- transpose ([] : xss) = transpose xss +-- transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) + + transpose :: [[a]] -> [[a]] + transpose [] = [] + transpose ([] : xss) = transpose xss + transpose ((x:xs) : xss) = (x : (map head xss)) : transpose (xs : (map tail xss)) + +-- Can't be promoted because of limitations of Int promotion. +-- Below is a re-implementation using Nat +-- (!!) :: [a] -> Int -> a +-- xs !! n | n < 0 = error "Data.Singletons.List.!!: negative index" +-- [] !! _ = error "Data.Singletons.List.!!: index too large" +-- (x:_) !! 0 = x +-- (_:xs) !! n = xs !! (n-1) + + (!!) :: [a] -> Nat -> a + [] !! _ = error "Data.Singletons.List.!!: index too large" + (x:xs) !! n = if n == 0 then x else xs !! (n-1) + infixl 9 !! + + nub :: forall a. (Eq a) => [a] -> [a] + nub l = nub' l [] + where + nub' :: [a] -> [a] -> [a] + nub' [] _ = [] + nub' (x:xs) ls = if x `elem` ls then nub' xs ls else x : nub' xs (x:ls) + + nubBy :: (a -> a -> Bool) -> [a] -> [a] + nubBy eq l = nubBy' l [] + where + nubBy' [] _ = [] + nubBy' (y:ys) xs = if elem_by eq y xs then nubBy' ys xs else y : nubBy' ys (y:xs) + + elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool + elem_by _ _ [] = False + elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs + + unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] + unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs + + union :: (Eq a) => [a] -> [a] -> [a] + union = unionBy (==) + + genericLength :: (Num i) => [a] -> i + genericLength [] = 0 + genericLength (_:xs) = 1 + genericLength xs + + |]) + +-- Workaround for #326 +infix 5 \\ -- This comment is necessary so CPP doesn't treat the +infixl 9 !! + +-- The following functions are supported for promotion only. +$(promoteOnly [d| + + -- Overlapping patterns don't singletonize + stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] + stripPrefix [] ys = Just ys + stripPrefix (x:xs) (y:ys) + | x == y = stripPrefix xs ys + stripPrefix _ _ = Nothing + + -- To singletonize these we would need to rewrite all patterns + -- as non-overlapping. This means 2^7 equations for zipWith7. + + zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] + zip4 = zipWith4 (,,,) + + zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] + zip5 = zipWith5 (,,,,) + + zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> + [(a,b,c,d,e,f)] + zip6 = zipWith6 (,,,,,) + + zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> + [g] -> [(a,b,c,d,e,f,g)] + zip7 = zipWith7 (,,,,,,) + + zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] + zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds + zipWith4 _ _ _ _ _ = [] + + zipWith5 :: (a->b->c->d->e->f) -> + [a]->[b]->[c]->[d]->[e]->[f] + zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es + zipWith5 _ _ _ _ _ _ = [] + + zipWith6 :: (a->b->c->d->e->f->g) -> + [a]->[b]->[c]->[d]->[e]->[f]->[g] + zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs + zipWith6 _ _ _ _ _ _ _ = [] + + zipWith7 :: (a->b->c->d->e->f->g->h) -> + [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] + zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs + zipWith7 _ _ _ _ _ _ _ _ = [] + +-- These functions use Integral or Num typeclass instead of Int. +-- +-- genericLength, genericTake, genericDrop, genericSplitAt, genericIndex +-- genericReplicate +-- +-- We provide aliases below to improve compatibility + + genericTake :: (Integral i) => i -> [a] -> [a] + genericTake = take + + genericDrop :: (Integral i) => i -> [a] -> [a] + genericDrop = drop + + genericSplitAt :: (Integral i) => i -> [a] -> ([a], [a]) + genericSplitAt = splitAt + + genericIndex :: (Integral i) => [a] -> i -> a + genericIndex = (!!) + + genericReplicate :: (Integral i) => i -> a -> [a] + genericReplicate = replicate + |]) diff --git a/src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs b/src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs @@ -0,0 +1,169 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.List.Internal.Disambiguation +-- Copyright : (C) 2016 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Renames a bunch of List functions because singletons can't support qualified +-- names. :( +-- +---------------------------------------------------------------------------- + +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, + UndecidableInstances, GADTs, DataKinds, PolyKinds #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} + +module Data.Singletons.Prelude.List.Internal.Disambiguation where + +import Data.Singletons.Single +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.List.Internal +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Eq +import Data.List +import GHC.TypeLits + +-- singletons doesn't support qualified names :( +$(singletons [d| + listlast :: [a] -> a + listlast = last + + listinit :: [a] -> [a] + listinit = init + + listsort :: Ord a => [a] -> [a] + listsort = sort + + listinits :: [a] -> [[a]] + listinits = inits + + listtails :: [a] -> [[a]] + listtails = tails + + listinsert :: Ord a => a -> [a] -> [a] + listinsert = insert + + listscanl :: (b -> a -> b) -> b -> [a] -> [b] + listscanl = scanl + + listscanr :: (a -> b -> b) -> b -> [a] -> [b] + listscanr = scanr + + listscanr1 :: (a -> a -> a) -> [a] -> [a] + listscanr1 = scanr1 + + listintersperse :: a -> [a] -> [a] + listintersperse = intersperse + + listreverse :: [a] -> [a] + listreverse = reverse + + listtakeWhile :: (a -> Bool) -> [a] -> [a] + listtakeWhile = takeWhile + + listdropWhile :: (a -> Bool) -> [a] -> [a] + listdropWhile = dropWhile + + listspan :: (a -> Bool) -> [a] -> ([a], [a]) + listspan = span + + listfilter :: (a -> Bool) -> [a] -> [a] + listfilter = filter + + listpartition :: (a -> Bool) -> [a] -> ([a], [a]) + listpartition = partition + + listsortBy :: (a -> a -> Ordering) -> [a] -> [a] + listsortBy = sortBy + + listisPrefixOf :: Eq a => [a] -> [a] -> Bool + listisPrefixOf = isPrefixOf + + listzip :: [a] -> [b] -> [(a, b)] + listzip = zip + + listzipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + listzipWith = zipWith + + listnubBy :: (a -> a -> Bool) -> [a] -> [a] + listnubBy = nubBy + + listtranspose :: [[a]] -> [[a]] + listtranspose = transpose + + listunzip :: [(a,b)] -> ([a],[b]) + listunzip = unzip + + listmap :: (a -> b) -> [a] -> [b] + listmap = map + + listelem :: Eq a => a -> [a] -> Bool + listelem = elem + + listfoldl :: (b -> a -> b) -> b -> [a] -> b + listfoldl = foldl + + listfoldl' :: (b -> a -> b) -> b -> [a] -> b + listfoldl' = foldl' + + listfoldl1 :: (a -> a -> a) -> [a] -> a + listfoldl1 = foldl1 + + listfoldr :: (a -> b -> b) -> b -> [a] -> b + listfoldr = foldr + + listfoldr1 :: (a -> a -> a) -> [a] -> a + listfoldr1 = foldr1 + + listmaximum :: Ord a => [a] -> a + listmaximum = maximum + + listminimum :: Ord a => [a] -> a + listminimum = minimum + + listnull :: [a] -> Bool + listnull = null + + listproduct :: Num a => [a] -> a + listproduct = product + + listsum :: Num a => [a] -> a + listsum = sum + |]) + +$(singletonsOnly [d| + listtake :: Nat -> [a] -> [a] + listtake = take + + listdrop :: Nat -> [a] -> [a] + listdrop = drop + + listsplitAt :: Nat -> [a] -> ([a], [a]) + listsplitAt = splitAt + + listindex :: [a] -> Nat -> a + listindex = (!!) + + listlength :: [a] -> Nat + listlength = length + |]) + +listtake :: Nat -> [a] -> [a] +listtake = undefined + +listdrop :: Nat -> [a] -> [a] +listdrop = undefined + +listsplitAt :: Nat -> [a] -> ([a], [a]) +listsplitAt = undefined + +listindex :: [a] -> Nat -> a +listindex = undefined + +listlength :: [a] -> Nat +listlength = undefined 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 @@ -1,12 +1,14 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, TypeOperators, - TypeFamilies, GADTs, UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, + TypeFamilies, GADTs, UndecidableInstances, InstanceSigs, + DataKinds, PolyKinds #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List.NonEmpty -- Copyright : (C) 2016 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -145,14 +147,16 @@ XorSym0, XorSym1 ) where +import Control.Monad.Zip import Data.List.NonEmpty -import Data.Singletons.Prelude.List.NonEmpty.Internal +import Data.Singletons.Prelude.List.Internal.Disambiguation import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Base hiding ( MapSym0, MapSym1, MapSym2, Map, sMap ) import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Monad.Zip import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Function import Data.Function @@ -172,13 +176,12 @@ instance MonadFix NonEmpty where mfix f = case fix (f . head) of ~(x :| _) -> x :| mfix (tail . f) + -} - -- | @since 4.9.0.0 instance MonadZip NonEmpty where mzip = zip mzipWith = zipWith munzip = unzip - -} -- needed to implement other functions fmap :: (a -> b) -> NonEmpty a -> NonEmpty b diff --git a/src/Data/Singletons/Prelude/List/NonEmpty/Internal.hs b/src/Data/Singletons/Prelude/List/NonEmpty/Internal.hs deleted file mode 100644 --- a/src/Data/Singletons/Prelude/List/NonEmpty/Internal.hs +++ /dev/null @@ -1,133 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Prelude.List.NonEmpty.Internal --- Copyright : (C) 2016 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Renames a bunch of List functions because singletons can't support qualified --- names. :( --- ----------------------------------------------------------------------------- - -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, TypeFamilies, - UndecidableInstances, GADTs #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} - -module Data.Singletons.Prelude.List.NonEmpty.Internal where - -import Data.Singletons.Single -import Data.Singletons.Prelude.List -import Data.Singletons.Prelude.Ord -import Data.Singletons.Prelude.Eq -import Data.List -import GHC.TypeLits - --- singletons doesn't support qualified names :( -$(singletons [d| - listlast :: [a] -> a - listlast = last - - listinit :: [a] -> [a] - listinit = init - - listsort :: Ord a => [a] -> [a] - listsort = sort - - listinits :: [a] -> [[a]] - listinits = inits - - listtails :: [a] -> [[a]] - listtails = tails - - listinsert :: Ord a => a -> [a] -> [a] - listinsert = insert - - listscanl :: (b -> a -> b) -> b -> [a] -> [b] - listscanl = scanl - - listscanr :: (a -> b -> b) -> b -> [a] -> [b] - listscanr = scanr - - listscanr1 :: (a -> a -> a) -> [a] -> [a] - listscanr1 = scanr1 - - listintersperse :: a -> [a] -> [a] - listintersperse = intersperse - - listreverse :: [a] -> [a] - listreverse = reverse - - listtakeWhile :: (a -> Bool) -> [a] -> [a] - listtakeWhile = takeWhile - - listdropWhile :: (a -> Bool) -> [a] -> [a] - listdropWhile = dropWhile - - listspan :: (a -> Bool) -> [a] -> ([a], [a]) - listspan = span - - listfilter :: (a -> Bool) -> [a] -> [a] - listfilter = filter - - listpartition :: (a -> Bool) -> [a] -> ([a], [a]) - listpartition = partition - - listsortBy :: (a -> a -> Ordering) -> [a] -> [a] - listsortBy = sortBy - - listisPrefixOf :: Eq a => [a] -> [a] -> Bool - listisPrefixOf = isPrefixOf - - listzip :: [a] -> [b] -> [(a, b)] - listzip = zip - - listzipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - listzipWith = zipWith - - listnubBy :: (a -> a -> Bool) -> [a] -> [a] - listnubBy = nubBy - - listtranspose :: [[a]] -> [[a]] - listtranspose = transpose - - listunzip :: [(a,b)] -> ([a],[b]) - listunzip = unzip - - listmap :: (a -> b) -> [a] -> [b] - listmap = map - |]) - -$(singletonsOnly [d| - listtake :: Nat -> [a] -> [a] - listtake = take - - listdrop :: Nat -> [a] -> [a] - listdrop = drop - - listsplitAt :: Nat -> [a] -> ([a], [a]) - listsplitAt = splitAt - - listindex :: [a] -> Nat -> a - listindex = (!!) - - listlength :: [a] -> Nat - listlength = length - |]) - -listtake :: Nat -> [a] -> [a] -listtake = undefined - -listdrop :: Nat -> [a] -> [a] -listdrop = undefined - -listsplitAt :: Nat -> [a] -> ([a], [a]) -listsplitAt = undefined - -listindex :: [a] -> Nat -> a -listindex = undefined - -listlength :: [a] -> Nat -listlength = undefined 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 @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, TypeInType, +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, DataKinds, PolyKinds, UndecidableInstances, GADTs, RankNTypes #-} ----------------------------------------------------------------------------- @@ -6,7 +6,7 @@ -- Module : Data.Singletons.Prelude.Maybe -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- diff --git a/src/Data/Singletons/Prelude/Monad.hs b/src/Data/Singletons/Prelude/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Monad.hs @@ -0,0 +1,293 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Monad +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'Monad' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Monad ( + PFunctor(Fmap), SFunctor(sFmap), + PMonad(..), SMonad(..), PMonadPlus(..), SMonadPlus(..), + + MapM, sMapM, MapM_, sMapM_, ForM, sForM, + Sequence, sSequence, Sequence_, sSequence_, + type (=<<), (%=<<), type (>=>), (%>=>), type (<=<), (%<=<), + Void, sVoid, + + Join, sJoin, + Msum, sMsum, + Mfilter, sMfilter, FilterM, sFilterM, + MapAndUnzipM, sMapAndUnzipM, ZipWithM, sZipWithM, + ZipWithM_, sZipWithM_, FoldlM, sFoldlM, + ReplicateM, sReplicateM, ReplicateM_, sReplicateM_, + + Guard, sGuard, When, sWhen, Unless, sUnless, + + LiftM, sLiftM, LiftM2, sLiftM2, LiftM3, sLiftM3, + LiftM4, sLiftM4, LiftM5, sLiftM5, Ap, sAp, + + type (<$!>), (%<$!>), + + -- * Defunctionalization symbols + FmapSym0, FmapSym1, FmapSym2, + type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$), + type (>>@#@$), type (>>@#@$$), type (>>@#@$$$), + ReturnSym0, ReturnSym1, FailSym0, FailSym1, + MzeroSym0, MplusSym0, MplusSym1, MplusSym2, + + MapMSym0, MapMSym1, MapMSym2, + MapM_Sym0, MapM_Sym1, MapM_Sym2, + ForMSym0, ForMSym1, ForMSym2, + SequenceSym0, SequenceSym1, + Sequence_Sym0, Sequence_Sym1, + type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$), + type (>=>@#@$), type (>=>@#@$$), type (>=>@#@$$$), + type (<=<@#@$), type (<=<@#@$$), type (<=<@#@$$$), + VoidSym0, VoidSym1, + + JoinSym0, JoinSym1, + MsumSym0, MsumSym1, + MfilterSym0, MfilterSym1, MfilterSym2, + FilterMSym0, FilterMSym1, FilterMSym2, + MapAndUnzipMSym0, MapAndUnzipMSym1, MapAndUnzipMSym2, + ZipWithMSym0, ZipWithMSym1, ZipWithMSym2, ZipWithMSym3, + ZipWithM_Sym0, ZipWithM_Sym1, ZipWithM_Sym2, ZipWithM_Sym3, + FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3, + ReplicateMSym0, ReplicateMSym1, ReplicateMSym2, + ReplicateM_Sym0, ReplicateM_Sym1, ReplicateM_Sym2, + + GuardSym0, GuardSym1, + WhenSym0, WhenSym1, WhenSym2, + UnlessSym0, UnlessSym1, UnlessSym2, + + LiftMSym0, LiftMSym1, LiftMSym2, + LiftM2Sym0, LiftM2Sym1, LiftM2Sym2, LiftM2Sym3, + LiftM3Sym0, LiftM3Sym1, LiftM3Sym2, LiftM3Sym3, LiftM3Sym4, + LiftM4Sym0, LiftM4Sym1, LiftM4Sym2, LiftM4Sym3, LiftM4Sym4, LiftM4Sym5, + LiftM5Sym0, LiftM5Sym1, LiftM5Sym2, LiftM5Sym3, LiftM5Sym4, LiftM5Sym5, LiftM5Sym6, + ApSym0, ApSym1, ApSym2, + + type (<$!>@#@$), type (<$!>@#@$$), type (<$!>@#@$$$), + ) where + +import Control.Applicative +import Control.Monad +import Data.Ord (Down(..)) +import Data.Singletons.Prelude.Applicative () +import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr) +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Functor +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.List (UnzipSym0, sUnzip, ZipWithSym0, sZipWith) +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Traversable +import Data.Singletons.Single +import GHC.TypeNats + +$(singletonsOnly [d| + -- ----------------------------------------------------------------------------- + -- Functions mandated by the Prelude + + -- -| This generalizes the list-based 'filter' function. + + filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a] + filterM p = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x)) (pure []) + + infixr 1 <=<, >=> + + -- -| Left-to-right Kleisli composition of monads. + (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) + f >=> g = \x -> f x >>= g + + -- -| Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped. + -- + -- Note how this operator resembles function composition @('.')@: + -- + -- > (.) :: (b -> c) -> (a -> b) -> a -> c + -- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c + (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) + (<=<) = flip (>=>) + + {- + Relies on infinite lists + + -- -| @'forever' act@ repeats the action infinitely. + forever :: (Applicative f) => f a -> f b + forever a = let a' = a *> a' in a' + -- Use explicit sharing here, as it prevents a space leak regardless of + -- optimizations. + -} + + -- ----------------------------------------------------------------------------- + -- Other monad functions + + -- -| The 'mapAndUnzipM' function maps its first argument over a list, returning + -- the result as a pair of lists. This function is mainly used with complicated + -- data structures or a state-transforming monad. + mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) + mapAndUnzipM f xs = unzip <$> traverse f xs + + -- -| The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors. + zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c] + zipWithM f xs ys = sequenceA (zipWith f xs ys) + + -- -| 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. + zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m () + zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys) + + {- -| The 'foldM' function is analogous to 'foldl', except that its result is + encapsulated in a monad. Note that 'foldM' works from left-to-right over + the list arguments. This could be an issue where @('>>')@ and the `folded + function' are not commutative. + + + > foldM f a1 [x1, x2, ..., xm] + + == + + > do + > a2 <- f a1 x1 + > a3 <- f a2 x2 + > ... + > f am xm + + If right-to-left evaluation is required, the input list should be reversed. + + Note: 'foldM' is the same as 'foldlM' + -} + + foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b + foldM = foldlM + + -- -| Like 'foldM', but discards the result. + foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m () + foldM_ f a xs = foldlM f a xs >> return () + + {- + Note [Worker/wrapper transform on replicateM/replicateM_] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + The implementations of replicateM and replicateM_ both leverage the + worker/wrapper transform. The simpler implementation of replicateM_, as an + example, would be: + + replicateM_ 0 _ = pure () + replicateM_ n f = f *> replicateM_ (n - 1) f + + However, the self-recursive nature of this implementation inhibits inlining, + which means we never get to specialise to the action (`f` in the code above). + By contrast, the implementation below with a local loop makes it possible to + inline the entire definition (as happens for foldr, for example) thereby + specialising for the particular action. + + For further information, see this Trac comment, which includes side-by-side + Core: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6 + -} + + -- -| @'replicateM' n act@ performs the action @n@ times, + -- gathering the results. + replicateM :: (Applicative m) => Nat -> m a -> m [a] + replicateM cnt0 f = + loop cnt0 + where + loop cnt + | cnt <= 0 = pure [] + | otherwise = liftA2 (:) f (loop (cnt - 1)) + + -- -| Like 'replicateM', but discards the result. + replicateM_ :: (Applicative m) => Nat -> m a -> m () + replicateM_ cnt0 f = + loop cnt0 + where + loop cnt + | cnt <= 0 = pure () + | otherwise = f *> loop (cnt - 1) + + + -- -| The reverse of 'when'. + unless :: (Applicative f) => Bool -> f () -> f () + unless p s = if p then pure () else s + + infixl 4 <$!> + + -- -| Strict version of 'Data.Functor.<$>'. + -- + -- @since 4.8.0.0 + (<$!>) :: Monad m => (a -> b) -> m a -> m b + f <$!> m = do + x <- m + let z = f x + z `seq` return z + + + -- ----------------------------------------------------------------------------- + -- Other MonadPlus functions + + -- -| Direct 'MonadPlus' equivalent of 'filter' + -- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@ + -- applicable to any 'MonadPlus', for example + -- @mfilter odd (Just 1) == Just 1@ + -- @mfilter odd (Just 2) == Nothing@ + + mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a + mfilter p ma = do + a <- ma + if p a then return a else mzero + + {- -$naming + + The functions in this library use the following naming conventions: + + * A postfix \'@M@\' always stands for a function in the Kleisli category: + The monad type constructor @m@ is added to function results + (modulo currying) and nowhere else. So, for example, + + > filter :: (a -> Bool) -> [a] -> [a] + > filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] + + * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@. + Thus, for example: + + > sequence :: Monad m => [m a] -> m [a] + > sequence_ :: Monad m => [m a] -> m () + + * A prefix \'@m@\' generalizes an existing function to a monadic form. + Thus, for example: + + > sum :: Num a => [a] -> a + > msum :: MonadPlus m => [m a] -> m a + + -} + + instance Monoid a => Monad ((,) a) where + (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b) + + instance Monad Down where + Down a >>= k = k a + |]) + +-- Workaround for #326 +infixr 1 <=<, >=> +infixl 4 <$!> diff --git a/src/Data/Singletons/Prelude/Monad/Internal.hs b/src/Data/Singletons/Prelude/Monad/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Monad/Internal.hs @@ -0,0 +1,519 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Monad.Internal +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of: +-- +-- * Functor +-- * Applicative +-- * Alternative +-- * Monad +-- * MonadPlus +-- +-- As well as auxiliary definitions. +-- +-- This module exists to break up import cycles. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Monad.Internal where + +import Control.Applicative +import Control.Monad +import Data.Kind +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Instances +import Data.Singletons.Single +import Data.Singletons.TypeLits.Internal + +{- +Note [How to get the right kinds when promoting Functor and friends] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To avoid running afoul of a CUSK validity check (see Note [CUSKification]), +classes with type parameters that lack explicit kind signatures will be +defaulted to be of kind Type. This is not what you want for Functor, however, +since its argument is of kind (Type -> Type), so we must explicitly use this +kind when declaring the Functor class (and other classes in this module). +-} + +$(singletonsOnly [d| + infixl 4 <$ + + {- -| The 'Functor' class is used for types that can be mapped over. + Instances of 'Functor' should satisfy the following laws: + + > fmap id == id + > fmap (f . g) == fmap f . fmap g + + The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' + satisfy these laws. + -} + + class Functor (f :: Type -> Type) where + fmap :: (a -> b) -> f a -> f b + + -- -| Replace all locations in the input with the same value. + -- The default definition is @'fmap' . 'const'@, but this may be + -- overridden with a more efficient version. + (<$) :: a -> f b -> f a + (<$) = fmap . const + + infixl 4 <*>, <*, *>, <**> + + -- -| A functor with application, providing operations to + -- + -- -* embed pure expressions ('pure'), and + -- + -- -* sequence computations and combine their results ('<*>' and 'liftA2'). + -- + -- A minimal complete definition must include implementations of 'pure' + -- and of either '<*>' or 'liftA2'. If it defines both, then they must behave + -- the same as their default definitions: + -- + -- @('<*>') = 'liftA2' 'id'@ + -- + -- @'liftA2' f x y = f '<$>' x '<*>' y@ + -- + -- Further, any definition must satisfy the following: + -- + -- [/identity/] + -- + -- @'pure' 'id' '<*>' v = v@ + -- + -- [/composition/] + -- + -- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ + -- + -- [/homomorphism/] + -- + -- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ + -- + -- [/interchange/] + -- + -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ + -- + -- + -- The other methods have the following default definitions, which may + -- be overridden with equivalent specialized implementations: + -- + -- * @u '*>' v = ('id' '<$' u) '<*>' v@ + -- + -- * @u '<*' v = 'liftA2' 'const' u v@ + -- + -- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy + -- + -- * @'fmap' f x = 'pure' f '<*>' x@ + -- + -- + -- It may be useful to note that supposing + -- + -- @forall x y. p (q x y) = f x . g y@ + -- + -- it follows from the above that + -- + -- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ + -- + -- + -- If @f@ is also a 'Monad', it should satisfy + -- + -- * @'pure' = 'return'@ + -- + -- * @('<*>') = 'ap'@ + -- + -- * @('*>') = ('>>')@ + -- + -- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). + + class Functor f => Applicative (f :: Type -> Type) where + -- {-# MINIMAL pure, ((<*>) | liftA2) #-} + -- -| Lift a value. + pure :: a -> f a + + -- -| Sequential application. + -- + -- A few functors support an implementation of '<*>' that is more + -- efficient than the default one. + (<*>) :: f (a -> b) -> f a -> f b + (<*>) = liftA2 id + + -- -| Lift a binary function to actions. + -- + -- Some functors support an implementation of 'liftA2' that is more + -- efficient than the default one. In particular, if 'fmap' is an + -- expensive operation, it is likely better to use 'liftA2' than to + -- 'fmap' over the structure and then use '<*>'. + liftA2 :: (a -> b -> c) -> f a -> f b -> f c + liftA2 f x = (<*>) (fmap f x) + + -- -| Sequence actions, discarding the value of the first argument. + (*>) :: f a -> f b -> f b + a1 *> a2 = (id <$ a1) <*> a2 + -- This is essentially the same as liftA2 (flip const), but if the + -- Functor instance has an optimized (<$), it may be better to use + -- that instead. Before liftA2 became a method, this definition + -- was strictly better, but now it depends on the functor. For a + -- functor supporting a sharing-enhancing (<$), this definition + -- may reduce allocation by preventing a1 from ever being fully + -- realized. In an implementation with a boring (<$) but an optimizing + -- liftA2, it would likely be better to define (*>) using liftA2. + + -- -| Sequence actions, discarding the value of the second argument. + (<*) :: f a -> f b -> f a + (<*) = liftA2 const + + -- -| A variant of '<*>' with the arguments reversed. + (<**>) :: Applicative f => f a -> f (a -> b) -> f b + (<**>) = liftA2 (\a f -> f a) + -- Don't use $ here, see the note at the top of the page + + -- -| Lift a function to actions. + -- This function may be used as a value for `fmap` in a `Functor` instance. + liftA :: Applicative f => (a -> b) -> f a -> f b + liftA f a = pure f <*> a + -- Caution: since this may be used for `fmap`, we can't use the obvious + -- definition of liftA = fmap. + + -- -| Lift a ternary function to actions. + liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d + liftA3 f a b c = liftA2 f a b <*> c + + infixl 1 >>, >>= + infixr 1 =<< + + -- -| The 'join' function is the conventional monad join operator. It + -- is used to remove one level of monadic structure, projecting its + -- bound argument into the outer level. + -- + -- ==== __Examples__ + -- + -- A common use of 'join' is to run an 'IO' computation returned from + -- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions + -- can't perform 'IO' directly. Recall that + -- + -- @ + -- 'GHC.Conc.atomically' :: STM a -> IO a + -- @ + -- + -- is used to run 'GHC.Conc.STM' transactions atomically. So, by + -- specializing the types of 'GHC.Conc.atomically' and 'join' to + -- + -- @ + -- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) + -- 'join' :: IO (IO b) -> IO b + -- @ + -- + -- we can compose them as + -- + -- @ + -- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b + -- @ + -- + -- to run an 'GHC.Conc.STM' transaction and the 'IO' action it + -- returns. + join :: (Monad m) => m (m a) -> m a + join x = x >>= id + + {- -| The 'Monad' class defines the basic operations over a /monad/, + a concept from a branch of mathematics known as /category theory/. + From the perspective of a Haskell programmer, however, it is best to + think of a monad as an /abstract datatype/ of actions. + Haskell's @do@ expressions provide a convenient syntax for writing + monadic expressions. + + Instances of 'Monad' should satisfy the following laws: + + * @'return' a '>>=' k = k a@ + * @m '>>=' 'return' = m@ + * @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ + + Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: + + * @'pure' = 'return'@ + * @('<*>') = 'ap'@ + + The above laws imply: + + * @'fmap' f xs = xs '>>=' 'return' . f@ + * @('>>') = ('*>')@ + + and that 'pure' and ('<*>') satisfy the applicative functor laws. + + The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' + defined in the "Prelude" satisfy these laws. + -} + class Applicative m => Monad (m :: Type -> Type) where + -- -| Sequentially compose two actions, passing any value produced + -- by the first as an argument to the second. + (>>=) :: forall a b. m a -> (a -> m b) -> m b + + -- -| Sequentially compose two actions, discarding any value produced + -- by the first, like sequencing operators (such as the semicolon) + -- in imperative languages. + (>>) :: forall a b. m a -> m b -> m b + m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] + + -- -| Inject a value into the monadic type. + return :: a -> m a + return = pure + + -- -| Fail with a message. This operation is not part of the + -- mathematical definition of a monad, but is invoked on pattern-match + -- failure in a @do@ expression. + -- + -- As part of the MonadFail proposal (MFP), this function is moved + -- to its own class 'MonadFail' (see "Control.Monad.Fail" for more + -- details). The definition here will be removed in a future + -- release. + fail :: Symbol -> m a + fail s = error s + + {- Note [Recursive bindings for Applicative/Monad] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + The original Applicative/Monad proposal stated that after + implementation, the designated implementation of (>>) would become + + (>>) :: forall a b. m a -> m b -> m b + (>>) = (*>) + + by default. You might be inclined to change this to reflect the stated + proposal, but you really shouldn't! Why? Because people tend to define + such instances the /other/ way around: in particular, it is perfectly + legitimate to define an instance of Applicative (*>) in terms of (>>), + which would lead to an infinite loop for the default implementation of + Monad! And people do this in the wild. + + This turned into a nasty bug that was tricky to track down, and rather + than eliminate it everywhere upstream, it's easier to just retain the + original default. + + -} + + -- -| Same as '>>=', but with the arguments interchanged. + (=<<) :: Monad m => (a -> m b) -> m a -> m b + f =<< x = x >>= f + + -- -| Conditional execution of 'Applicative' expressions. For example, + -- + -- > when debug (putStrLn "Debugging") + -- + -- will output the string @Debugging@ if the Boolean value @debug@ + -- is 'True', and otherwise do nothing. + when :: (Applicative f) => Bool -> f () -> f () + when p s = if p then s else pure () + + -- -| Promote a function to a monad. + liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r + liftM f m1 = do { x1 <- m1; return (f x1) } + + -- -| Promote a function to a monad, scanning the monadic arguments from + -- left to right. For example, + -- + -- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] + -- > liftM2 (+) (Just 1) Nothing = Nothing + -- + liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r + liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } + -- Caution: since this may be used for `liftA2`, we can't use the obvious + -- definition of liftM2 = liftA2. + + -- -| Promote a function to a monad, scanning the monadic arguments from + -- left to right (cf. 'liftM2'). + liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r + liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } + + -- -| Promote a function to a monad, scanning the monadic arguments from + -- left to right (cf. 'liftM2'). + liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r + liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } + + -- -| Promote a function to a monad, scanning the monadic arguments from + -- left to right (cf. 'liftM2'). + liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r + liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } + + {- -| In many situations, the 'liftM' operations can be replaced by uses of + 'ap', which promotes function application. + + > return f `ap` x1 `ap` ... `ap` xn + + is equivalent to + + > liftMn f x1 x2 ... xn + + -} + + ap :: (Monad m) => m (a -> b) -> m a -> m b + ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } + -- Since many Applicative instances define (<*>) = ap, we + -- cannot define ap = (<*>) + + -- ----------------------------------------------------------------------------- + -- The Alternative class definition + + infixl 3 <|> + + -- -| A monoid on applicative functors. + -- + -- If defined, 'some' and 'many' should be the least solutions + -- of the equations: + -- + -- -* @'some' v = (:) '<$>' v '<*>' 'many' v@ + -- + -- -* @'many' v = 'some' v '<|>' 'pure' []@ + class Applicative f => Alternative (f :: Type -> Type) where + -- -| The identity of '<|>' + empty :: f a + -- -| An associative binary operation + (<|>) :: f a -> f a -> f a + + {- + some and many rely on infinite lists + + -- -| One or more. + some :: f a -> f [a] + some v = some_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + + -- -| Zero or more. + many :: f a -> f [a] + many v = many_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + -} + + -- -| @'guard' b@ is @'pure' ()@ if @b@ is 'True', + -- and 'empty' if @b@ is 'False'. + guard :: (Alternative f) => Bool -> f () + guard True = pure () + guard False = empty + + -- ----------------------------------------------------------------------------- + -- The MonadPlus class definition + + -- -| Monads that also support choice and failure. + class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where + -- -| The identity of 'mplus'. It should also satisfy the equations + -- + -- > mzero >>= f = mzero + -- > v >> mzero = mzero + -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ + mzero :: m a + mzero = empty + + -- -| An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ + mplus :: m a -> m a -> m a + mplus = (<|>) + |]) + +-- Workaround for #326 +infixl 4 <$ +infixl 4 <*>, <*, *>, <**> +infixl 1 >>, >>= +infixr 1 =<< +infixl 3 <|> + +$(singletonsOnly [d| + ------------------------------------------------------------------------------- + -- Instances + + deriving instance Functor Maybe + deriving instance Functor NonEmpty + deriving instance Functor [] + deriving instance Functor (Either a) + + instance Applicative Maybe where + pure = Just + + Just f <*> m = fmap f m + Nothing <*> _m = Nothing + + liftA2 f (Just x) (Just y) = Just (f x y) + liftA2 _ Just{} Nothing = Nothing + liftA2 _ Nothing Just{} = Nothing + liftA2 _ Nothing Nothing = Nothing + + Just _m1 *> m2 = m2 + Nothing *> _m2 = Nothing + + instance Applicative NonEmpty where + pure a = a :| [] + (<*>) = ap + liftA2 = liftM2 + + instance Applicative [] where + pure x = [x] + (<*>) = ap + liftA2 = liftM2 + (*>) = (>>) + + instance Applicative (Either e) where + pure = Right + Left e <*> _ = Left e + Right f <*> r = fmap f r + + instance Monad Maybe where + (Just x) >>= k = k x + Nothing >>= _ = Nothing + + (>>) = (*>) + + fail _ = Nothing + + instance Monad NonEmpty where + (a :| as) >>= f = b :| (bs ++ bs') + where b :| bs = f a + bs' = as >>= toList . f + toList (c :| cs) = c : cs + + instance Monad [] where + xs >>= f = foldr ((++) . f) [] xs + fail _ = [] + + instance Monad (Either e) where + Left l >>= _ = Left l + Right r >>= k = k r + + instance Alternative Maybe where + empty = Nothing + Nothing <|> r = r + l@(Just{}) <|> _ = l + + instance Alternative [] where + empty = [] + (<|>) = (++) + + instance MonadPlus Maybe + instance MonadPlus [] + |]) diff --git a/src/Data/Singletons/Prelude/Monad/Zip.hs b/src/Data/Singletons/Prelude/Monad/Zip.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Monad/Zip.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Monad.Zip +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'MonadZip' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Monad.Zip ( + PMonadZip(..), SMonadZip(..), + + -- * Defunctionalization symbols + MzipSym0, MzipSym1, MzipSym2, + MzipWithSym0, MzipWithSym1, MzipWithSym2, MzipWithSym3, + MunzipSym0, MunzipSym1, + ) where + +import Control.Monad.Zip +import Data.Functor.Identity +import Data.Kind +import Data.Monoid +import Data.Singletons.Prelude.Identity +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.List + ( ZipSym0, ZipWithSym0, UnzipSym0 + , sZip, sZipWith, sUnzip ) +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid () +import Data.Singletons.Prelude.Tuple +import Data.Singletons.Single + +$(singletonsOnly [d| + -- -| `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` + -- + -- Instances should satisfy the laws: + -- + -- -* Naturality : + -- + -- > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb) + -- + -- -* Information Preservation: + -- + -- > liftM (const ()) ma = liftM (const ()) mb + -- > ==> + -- > munzip (mzip ma mb) = (ma, mb) + -- + class Monad m => MonadZip (m :: Type -> Type) where + -- {-# MINIMAL mzip | mzipWith #-} + + mzip :: m a -> m b -> m (a,b) + mzip = mzipWith (,) + + mzipWith :: (a -> b -> c) -> m a -> m b -> m c + mzipWith f ma mb = liftM (uncurry f) (mzip ma mb) + + munzip :: m (a,b) -> (m a, m b) + munzip mab = (liftM fst mab, liftM snd mab) + -- munzip is a member of the class because sometimes + -- you can implement it more efficiently than the + -- above default code. See Trac #4370 comment by giorgidze + + instance MonadZip [] where + mzip = zip + mzipWith = zipWith + munzip = unzip + + instance MonadZip Identity where + mzipWith = liftM2 + munzip (Identity (a, b)) = (Identity a, Identity b) + + instance MonadZip Dual where + -- Cannot use coerce, it's unsafe + mzipWith = liftM2 + + instance MonadZip Sum where + mzipWith = liftM2 + + instance MonadZip Product where + mzipWith = liftM2 + + instance MonadZip Maybe where + mzipWith = liftM2 + + instance MonadZip First where + mzipWith = liftM2 + + instance MonadZip Last where + mzipWith = liftM2 + |]) diff --git a/src/Data/Singletons/Prelude/Monoid.hs b/src/Data/Singletons/Prelude/Monoid.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Monoid.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Monoid +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted version of 'Monoid', 'PMonoid', and the +-- singleton version, 'SMonoid'. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Monoid ( + PMonoid(..), SMonoid(..), + + Sing(SDual, sGetDual, SAll, sGetAll, SAny, sGetAny, SSum, sGetSum, + SProduct, sGetProduct, SFirst, sGetFirst, SLast, sGetLast), + GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast, + + SDual, SAll, SAny, SSum, SProduct, SFirst, SLast, + + -- ** Defunctionalization symbols + MemptySym0, + MappendSym0, MappendSym1, MappendSym2, + MconcatSym0, MconcatSym1, + DualSym0, DualSym1, GetDualSym0, GetDualSym1, + AllSym0, AllSym1, GetAllSym0, GetAllSym1, + AnySym0, AnySym1, GetAnySym0, GetAnySym1, + SumSym0, SumSym1, GetSumSym0, GetSumSym1, + ProductSym0, ProductSym1, GetProductSym0, GetProductSym1, + FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1, + LastSym0, LastSym1, GetLastSym0, GetLastSym1 + ) where + +import Data.Monoid (First(..), Last(..)) +import Data.Ord (Down(..)) +import Data.Semigroup hiding (First(..), Last(..)) +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Semigroup.Internal hiding + (Sing(SFirst, SLast), SFirst, SLast, + FirstSym0, FirstSym1, FirstSym0KindInference, + LastSym0, LastSym1, LastSym0KindInference, + GetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference, + GetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference) +import Data.Singletons.Prelude.Show +import Data.Singletons.Single +import Data.Singletons.Util + +import GHC.TypeLits (Symbol) + +$(singletonsOnly [d| + -- -| The class of monoids (types with an associative binary operation that + -- has an identity). Instances should satisfy the following laws: + -- + -- * @x '<>' 'mempty' = x@ + -- + -- * @'mempty' '<>' x = x@ + -- + -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) + -- + -- * @'mconcat' = 'foldr' '(<>)' 'mempty'@ + -- + -- The method names refer to the monoid of lists under concatenation, + -- but there are many other instances. + -- + -- Some types can be viewed as a monoid in more than one way, + -- e.g. both addition and multiplication on numbers. + -- In such cases we often define @newtype@s and make those instances + -- of 'Monoid', e.g. 'Sum' and 'Product'. + class Semigroup a => Monoid a where + -- -| Identity of 'mappend' + mempty :: a + + -- -| An associative operation + -- + -- __NOTE__: This method is redundant and has the default + -- implementation @'mappend' = '(<>)'@. + mappend :: a -> a -> a + mappend = (<>) + + -- -| Fold a list using the monoid. + -- + -- For most types, the default definition for 'mconcat' will be + -- used, but the function is included in the class definition so + -- that an optimized version can be provided for specific types. + mconcat :: [a] -> a + mconcat = foldr mappend mempty + + instance Monoid [a] where + mempty = [] + -- mconcat xss = [x | xs <- xss, x <- xs] + + instance Monoid b => Monoid (a -> b) where + mempty _ = mempty + + instance Monoid () where + -- Should it be strict? + mempty = () + mconcat _ = () + + instance (Monoid a, Monoid b) => Monoid (a,b) where + mempty = (mempty, mempty) + + instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where + mempty = (mempty, mempty, mempty) + + instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where + mempty = (mempty, mempty, mempty, mempty) + + instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => + Monoid (a,b,c,d,e) where + mempty = (mempty, mempty, mempty, mempty, mempty) + + -- lexicographical ordering + instance Monoid Ordering where + mempty = EQ + + -- -| Lift a semigroup into 'Maybe' forming a 'Monoid' according to + -- : \"Any semigroup @S@ may be + -- turned into a monoid simply by adjoining an element @e@ not in @S@ + -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" + instance Semigroup a => Monoid (Maybe a) where + mempty = Nothing + + instance Monoid Symbol where + mempty = "" + |]) + +$(genSingletons monoidBasicTypes) +$(showSingInstances monoidBasicTypes) +$(singEqInstances monoidBasicTypes) +$(singDecideInstances monoidBasicTypes) +$(singOrdInstances monoidBasicTypes) +$(singShowInstances monoidBasicTypes) + +$(singletonsOnly [d| + instance Monoid a => Monoid (Dual a) where + mempty = Dual mempty + + instance Monoid All where + mempty = All True + + instance Monoid Any where + mempty = Any False + + instance Num a => Monoid (Sum a) where + mempty = Sum 0 + + instance Num a => Monoid (Product a) where + mempty = Product 1 + + -- deriving newtype instance Monoid a => Monoid (Down a) + instance Monoid a => Monoid (Down a) where + mempty = Down mempty + Down a `mappend` Down b = Down (a `mappend` b) + + -- deriving newtype instance Applicative First + instance Applicative First where + pure = First . pure + First f <*> First x = First (f <*> x) + + deriving instance Functor First + + -- deriving newtype instance Monad First + instance Monad First where + First a >>= k = First (a >>= \x -> case k x of First y -> y) + + instance Semigroup (First a) where + First Nothing <> b = b + a@(First Just{}) <> _ = a + + instance Monoid (First a) where + mempty = First Nothing + + -- deriving newtype instance Applicative Last + instance Applicative Last where + pure = Last . pure + Last f <*> Last x = Last (f <*> x) + + deriving instance Functor Last + + -- deriving newtype instance Monad Last + instance Monad Last where + Last a >>= k = Last (a >>= \x -> case k x of Last y -> y) + + instance Semigroup (Last a) where + a <> Last Nothing = a + _ <> b@(Last Just {}) = b + + instance Monoid (Last a) where + mempty = Last Nothing + |]) 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 @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies, TypeInType, +{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies, TypeOperators, GADTs, ScopedTypeVariables, UndecidableInstances, - DefaultSignatures, FlexibleContexts + DefaultSignatures, FlexibleContexts, InstanceSigs, NoStarIsType #-} ----------------------------------------------------------------------------- @@ -8,7 +8,7 @@ -- Module : Data.Singletons.Prelude.Num -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -34,8 +34,10 @@ SubtractSym0, SubtractSym1, SubtractSym2 ) where +import Data.Ord (Down(..)) import Data.Singletons.Single import Data.Singletons.Internal +import Data.Singletons.Prelude.Ord import Data.Singletons.TypeLits.Internal import Data.Singletons.Decide import qualified GHC.TypeNats as TN @@ -69,7 +71,22 @@ x - y = x + negate y negate x = 0 - x + + -- deriving newtype instance Num a => Num (Down a) + instance Num a => Num (Down a) where + Down a + Down b = Down (a + b) + Down a - Down b = Down (a - b) + Down a * Down b = Down (a * b) + negate (Down a) = Down (negate a) + abs (Down a) = Down (abs a) + signum (Down a) = Down (signum a) + fromInteger n = Down (fromInteger n) |]) + +-- Workaround for #326 +infixl 6 + +infixl 6 - +infixl 7 * -- PNum instance type family SignumNat (a :: Nat) :: Nat where 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 @@ -1,13 +1,15 @@ {-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, TypeOperators, GADTs, UndecidableInstances, - FlexibleContexts, DefaultSignatures, InstanceSigs, TypeInType #-} + FlexibleContexts, DefaultSignatures, InstanceSigs, + StandaloneDeriving, FlexibleInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Ord -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -25,8 +27,10 @@ -- it returns its first argument. thenCmp, ThenCmp, sThenCmp, - Sing(SLT, SEQ, SGT), + Sing(SLT, SEQ, SGT, SDown), + SOrdering, SDown, + -- ** Defunctionalization symbols ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, LTSym0, EQSym0, GTSym0, @@ -37,9 +41,11 @@ type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), MaxSym0, MaxSym1, MaxSym2, MinSym0, MinSym1, MinSym2, - ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3 + ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3, + DownSym0, DownSym1 ) where +import Data.Ord (Down(..)) import Data.Singletons.Single import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances @@ -82,6 +88,21 @@ -- > ... sortBy (comparing fst) ... comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) + |]) + +-- Workaround for #326 +infix 4 <= +infix 4 < +infix 4 > +infix 4 >= + +$(genSingletons [''Down]) + +$(singletonsOnly [d| + deriving instance Eq a => Eq (Down a) + + instance Ord a => Ord (Down a) where + compare (Down x) (Down y) = y `compare` x |]) $(singletons [d| diff --git a/src/Data/Singletons/Prelude/Semigroup.hs b/src/Data/Singletons/Prelude/Semigroup.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Semigroup.hs @@ -0,0 +1,308 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Semigroup +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted version of 'Semigroup', 'PSemigroup', and the +-- singleton version, 'SSemigroup'. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Semigroup ( + PSemigroup(..), SSemigroup(..), + + Sing(SMin, sGetMin, SMax, sGetMax, + SFirst, sGetFirst, SLast, sGetLast, + SWrapMonoid, sUnwrapMonoid, SDual, sGetDual, + SAll, sGetAll, SAny, sGetAny, + SSum, sGetSum, SProduct, sGetProduct, + SOption, sGetOption, SArg), + GetMin, GetMax, GetFirst, GetLast, GetDual, + GetAll, GetAny, GetSum, GetProduct, GetOption, + + SMin, SMax, SFirst, SLast, SWrappedMonoid, SDual, + SAll, SAny, SSum, SProduct, SOption, SArg, + + option_, sOption_, Option_, + + -- ** Defunctionalization symbols + type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + SconcatSym0, SconcatSym1, + MinSym0, MinSym1, GetMinSym0, GetMinSym1, + MaxSym0, MaxSym1, GetMaxSym0, GetMaxSym1, + FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1, + LastSym0, LastSym1, GetLastSym0, GetLastSym1, + WrapMonoidSym0, WrapMonoidSym1, UnwrapMonoidSym0, UnwrapMonoidSym1, + DualSym0, DualSym1, GetDualSym0, GetDualSym1, + AllSym0, AllSym1, GetAllSym0, GetAllSym1, + AnySym0, AnySym1, GetAnySym0, GetAnySym1, + SumSym0, SumSym1, GetSumSym0, GetSumSym1, + ProductSym0, ProductSym1, GetProductSym0, GetProductSym1, + OptionSym0, OptionSym1, GetOptionSym0, GetOptionSym1, + ArgSym0, ArgSym1, ArgSym2 + ) where + +import Control.Applicative +import Control.Monad +import qualified Data.Semigroup as Semi (Min(..), Max(..)) +import Data.Semigroup (First(..), Last(..), WrappedMonoid(..), Option(..), Arg(..)) +import Data.Singletons.Prelude.Base hiding + (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Foldable hiding + ( All, AllSym0, AllSym1 + , Any, AnySym0, AnySym1 + , Product, ProductSym0, ProductSym1 + , Sum, SumSym0, SumSym1 ) +import Data.Singletons.Prelude.Functor +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Maybe +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid hiding + (Sing(SFirst, SLast), SFirst, sGetFirst, SLast, sGetLast, + FirstSym0, FirstSym1, LastSym0, LastSym1, + GetFirst, GetFirstSym0, GetFirstSym1, + GetLast, GetLastSym0, GetLastSym1) +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord hiding + (MinSym0, MinSym1, MaxSym0, MaxSym1) +import Data.Singletons.Prelude.Semigroup.Internal +import Data.Singletons.Prelude.Show +import Data.Singletons.Prelude.Traversable +import Data.Singletons.Single +import Data.Singletons.Util + +$(genSingletons [''Arg]) +$(showSingInstances $ ''Option : semigroupBasicTypes) +$(singShowInstances $ ''Option : semigroupBasicTypes) + +$(singletonsOnly [d| + instance Applicative Semi.Min where + pure = Semi.Min + a <* _ = a + _ *> a = a + Semi.Min f <*> Semi.Min x = Semi.Min (f x) + liftA2 f (Semi.Min a) (Semi.Min b) = Semi.Min (f a b) + + instance Enum a => Enum (Semi.Min a) where + succ (Semi.Min a) = Semi.Min (succ a) + pred (Semi.Min a) = Semi.Min (pred a) + toEnum = Semi.Min . toEnum + fromEnum (Semi.Min a) = fromEnum a + enumFromTo (Semi.Min a) (Semi.Min b) = Semi.Min `map` enumFromTo a b + enumFromThenTo (Semi.Min a) (Semi.Min b) (Semi.Min c) = Semi.Min `map` enumFromThenTo a b c + + deriving instance Functor Semi.Min + + instance Monad Semi.Min where + (>>) = (*>) + Semi.Min a >>= f = f a + + instance Ord a => Semigroup (Semi.Min a) where + Semi.Min a <> Semi.Min b = Semi.Min (a `min_` b) + + instance (Ord a, Bounded a) => Monoid (Semi.Min a) where + mempty = maxBound + + instance Num a => Num (Semi.Min a) where + (Semi.Min a) + (Semi.Min b) = Semi.Min (a + b) + (Semi.Min a) * (Semi.Min b) = Semi.Min (a * b) + (Semi.Min a) - (Semi.Min b) = Semi.Min (a - b) + negate (Semi.Min a) = Semi.Min (negate a) + abs (Semi.Min a) = Semi.Min (abs a) + signum (Semi.Min a) = Semi.Min (signum a) + fromInteger = Semi.Min . fromInteger + + deriving instance Foldable Semi.Min + deriving instance Traversable Semi.Min + + instance Applicative Semi.Max where + pure = Semi.Max + a <* _ = a + _ *> a = a + Semi.Max f <*> Semi.Max x = Semi.Max (f x) + liftA2 f (Semi.Max a) (Semi.Max b) = Semi.Max (f a b) + + instance Enum a => Enum (Semi.Max a) where + succ (Semi.Max a) = Semi.Max (succ a) + pred (Semi.Max a) = Semi.Max (pred a) + toEnum = Semi.Max . toEnum + fromEnum (Semi.Max a) = fromEnum a + enumFromTo (Semi.Max a) (Semi.Max b) = Semi.Max `map` enumFromTo a b + enumFromThenTo (Semi.Max a) (Semi.Max b) (Semi.Max c) = Semi.Max `map` enumFromThenTo a b c + + deriving instance Functor Semi.Max + + instance Monad Semi.Max where + (>>) = (*>) + Semi.Max a >>= f = f a + + instance Ord a => Semigroup (Semi.Max a) where + Semi.Max a <> Semi.Max b = Semi.Max (a `max_` b) + + instance (Ord a, Bounded a) => Monoid (Semi.Max a) where + mempty = minBound + + instance Num a => Num (Semi.Max a) where + (Semi.Max a) + (Semi.Max b) = Semi.Max (a + b) + (Semi.Max a) * (Semi.Max b) = Semi.Max (a * b) + (Semi.Max a) - (Semi.Max b) = Semi.Max (a - b) + negate (Semi.Max a) = Semi.Max (negate a) + abs (Semi.Max a) = Semi.Max (abs a) + signum (Semi.Max a) = Semi.Max (signum a) + fromInteger = Semi.Max . fromInteger + + deriving instance Foldable Semi.Max + deriving instance Traversable Semi.Max + + instance Eq a => Eq (Arg a b) where + Arg a _ == Arg b _ = a == b + + deriving instance Functor (Arg a) + + instance Ord a => Ord (Arg a b) where + Arg a _ `compare` Arg b _ = compare a b + min x@(Arg a _) y@(Arg b _) + | a <= b = x + | otherwise = y + max x@(Arg a _) y@(Arg b _) + | a >= b = x + | otherwise = y + + deriving instance (Show a, Show b) => Show (Arg a b) + deriving instance Foldable (Arg a) + deriving instance Traversable (Arg a) + + instance Applicative First where + pure x = First x + a <* _ = a + _ *> a = a + First f <*> First x = First (f x) + liftA2 f (First a) (First b) = First (f a b) + + instance Enum a => Enum (First a) where + succ (First a) = First (succ a) + pred (First a) = First (pred a) + toEnum = First . toEnum + fromEnum (First a) = fromEnum a + enumFromTo (First a) (First b) = First `map` enumFromTo a b + enumFromThenTo (First a) (First b) (First c) = First `map` enumFromThenTo a b c + + deriving instance Functor First + + instance Monad First where + (>>) = (*>) + First a >>= f = f a + + instance Semigroup (First a) where + a <> _ = a + + deriving instance Foldable First + deriving instance Traversable First + + instance Applicative Last where + pure x = Last x + a <* _ = a + _ *> a = a + Last f <*> Last x = Last (f x) + liftA2 f (Last a) (Last b) = Last (f a b) + + instance Enum a => Enum (Last a) where + succ (Last a) = Last (succ a) + pred (Last a) = Last (pred a) + toEnum = Last . toEnum + fromEnum (Last a) = fromEnum a + enumFromTo (Last a) (Last b) = Last `map` enumFromTo a b + enumFromThenTo (Last a) (Last b) (Last c) = Last `map` enumFromThenTo a b c + + deriving instance Functor Last + + instance Monad Last where + (>>) = (*>) + Last a >>= f = f a + + instance Semigroup (Last a) where + _ <> b = b + + deriving instance Foldable Last + deriving instance Traversable Last + + instance Monoid m => Semigroup (WrappedMonoid m) where + WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b) + + instance Monoid m => Monoid (WrappedMonoid m) where + mempty = WrapMonoid mempty + + instance Enum a => Enum (WrappedMonoid a) where + succ (WrapMonoid a) = WrapMonoid (succ a) + pred (WrapMonoid a) = WrapMonoid (pred a) + toEnum = WrapMonoid . toEnum + fromEnum (WrapMonoid a) = fromEnum a + enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid `map` enumFromTo a b + enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) = + WrapMonoid `map` enumFromThenTo a b c + + instance Alternative Option where + empty = Option Nothing + Option Nothing <|> b = b + a@(Option Just{}) <|> _ = a + + instance Applicative Option where + pure a = Option (Just a) + Option a <*> Option b = Option (a <*> b) + liftA2 f (Option x) (Option y) = Option (liftA2 f x y) + + Option Nothing *> _ = Option Nothing + Option Just{} *> b = b + + deriving instance Functor Option + + instance Monad Option where + Option (Just a) >>= k = k a + Option Nothing >>= _ = Option Nothing + (>>) = (*>) + + instance MonadPlus Option + + -- deriving newtype instance Semigroup a => Semigroup (Option a) + instance Semigroup a => Semigroup (Option a) where + Option a <> Option b = Option (a <> b) + + instance Semigroup a => Monoid (Option a) where + mempty = Option Nothing + + instance Foldable Option where + foldMap f (Option (Just m)) = f m + foldMap _ (Option Nothing) = mempty + + instance Traversable Option where + traverse f (Option (Just a)) = Option . Just <$> f a + traverse _ (Option Nothing) = pure (Option Nothing) + |]) + +$(singletons [d| + -- Renamed to avoid name clash + -- -| Fold an 'Option' case-wise, just like 'maybe'. + option_ :: b -> (a -> b) -> Option a -> b + option_ n j (Option m) = maybe_ n j m + |]) diff --git a/src/Data/Singletons/Prelude/Semigroup/Internal.hs b/src/Data/Singletons/Prelude/Semigroup/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Semigroup/Internal.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Semigroup.Internal +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted version of 'Semigroup', 'PSemigroup'; the +-- singleton version, 'SSemigroup'; and some @newtype@ wrappers, all +-- of which are reexported from the "Data.Semigroup" module or +-- imported directly by some other modules. +-- +-- This module exists to avoid import cycles with +-- "Data.Singletons.Prelude.Monoid". +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Semigroup.Internal where + +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Ord (Down(..)) +import Data.Proxy +import Data.Semigroup (Dual(..), All(..), Any(..), Sum(..), Product(..), Option(..)) +import Data.Singletons.Internal +import Data.Singletons.Prelude.Base +import Data.Singletons.Prelude.Bool +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Num +import Data.Singletons.Prelude.Ord hiding (MinSym0, MinSym1, MaxSym0, MaxSym1) +import Data.Singletons.Promote +import Data.Singletons.Single +import Data.Singletons.TypeLits.Internal +import Data.Singletons.Util +import qualified Data.Text as T +import Data.Void (Void) + +import GHC.TypeLits (AppendSymbol, SomeSymbol(..), someSymbolVal, Symbol) + +import Unsafe.Coerce + +$(singletonsOnly [d| + -- -| The class of semigroups (types with an associative binary operation). + -- + -- Instances should satisfy the associativity law: + -- + -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ + class Semigroup a where + -- -| An associative operation. + (<>) :: a -> a -> a + infixr 6 <> + + -- -| Reduce a non-empty list with @\<\>@ + -- + -- The default definition should be sufficient, but this can be + -- overridden for efficiency. + -- + sconcat :: NonEmpty a -> a + sconcat (a :| as) = go a as where + go b (c:cs) = b <> go c cs + go b [] = b + + {- + Can't single 'stimes', since there's no singled 'Integral' class. + + -- -| Repeat a value @n@ times. + -- + -- Given that this works on a 'Semigroup' it is allowed to fail if + -- you request 0 or fewer repetitions, and the default definition + -- will do so. + -- + -- By making this a member of the class, idempotent semigroups + -- and monoids can upgrade this to execute in /O(1)/ by + -- picking @stimes = 'stimesIdempotent'@ or @stimes = + -- 'stimesIdempotentMonoid'@ respectively. + stimes :: Integral b => b -> a -> a + stimes = stimesDefault + -} + + + instance Semigroup [a] where + (<>) = (++) + + instance Semigroup (NonEmpty a) where + (a :| as) <> (b :| bs) = a :| (as ++ b : bs) + + instance Semigroup b => Semigroup (a -> b) where + f <> g = \x -> f x <> g x + + instance Semigroup () where + _ <> _ = () + sconcat _ = () + + instance (Semigroup a, Semigroup b) => Semigroup (a, b) where + (a,b) <> (a',b') = (a<>a',b<>b') + + instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where + (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') + + instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) + => Semigroup (a, b, c, d) where + (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') + + instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) + => Semigroup (a, b, c, d, e) where + (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') + + instance Semigroup Ordering where + LT <> _ = LT + EQ <> y = y + GT <> _ = GT + + instance Semigroup a => Semigroup (Maybe a) where + Nothing <> b = b + a <> Nothing = a + Just a <> Just b = Just (a <> b) + + instance Semigroup (Either a b) where + Left _ <> b = b + -- a <> _ = a + a@Right{} <> _ = a + + instance Semigroup Void where + a <> _ = a + + -- deriving newtype instance Semigroup a => Semigroup (Down a) + instance Semigroup a => Semigroup (Down a) where + Down a <> Down b = Down (a <> b) + |]) + +-- Workaround for #326 +infixr 6 <> + +$(genSingletons $ ''Option : semigroupBasicTypes) +$(singBoundedInstances semigroupBasicTypes) +$(singEqInstances $ ''Option : semigroupBasicTypes) +$(singDecideInstances $ ''Option : semigroupBasicTypes) +$(singOrdInstances $ ''Option : semigroupBasicTypes) + +$(singletonsOnly [d| + instance Applicative Dual where + pure = Dual + Dual f <*> Dual x = Dual (f x) + + deriving instance Functor Dual + + instance Monad Dual where + Dual a >>= k = k a + + instance Semigroup a => Semigroup (Dual a) where + Dual a <> Dual b = Dual (b <> a) + + instance Semigroup All where + All a <> All b = All (a && b) + + instance Semigroup Any where + Any a <> Any b = Any (a || b) + + instance Applicative Sum where + pure = Sum + Sum f <*> Sum x = Sum (f x) + + deriving instance Functor Sum + + instance Monad Sum where + Sum a >>= k = k a + + instance Num a => Semigroup (Sum a) where + Sum a <> Sum b = Sum (a + b) + + -- deriving newtype instance Num a => Num (Sum a) + instance Num a => Num (Sum a) where + Sum a + Sum b = Sum (a + b) + Sum a - Sum b = Sum (a - b) + Sum a * Sum b = Sum (a * b) + negate (Sum a) = Sum (negate a) + abs (Sum a) = Sum (abs a) + signum (Sum a) = Sum (signum a) + fromInteger n = Sum (fromInteger n) + + instance Applicative Product where + pure = Product + Product f <*> Product x = Product (f x) + + deriving instance Functor Product + + instance Monad Product where + Product a >>= k = k a + + instance Num a => Semigroup (Product a) where + Product a <> Product b = Product (a * b) + + -- deriving newtype instance Num a => Num (Product a) + instance Num a => Num (Product a) where + Product a + Product b = Product (a + b) + Product a - Product b = Product (a - b) + Product a * Product b = Product (a * b) + negate (Product a) = Product (negate a) + abs (Product a) = Product (abs a) + signum (Product a) = Product (signum a) + fromInteger n = Product (fromInteger n) + |]) + +instance PSemigroup Symbol where + type a <> b = AppendSymbol a b + +instance SSemigroup Symbol where + sa %<> sb = + let a = fromSing sa + b = fromSing sb + ex = someSymbolVal $ T.unpack $ a <> b + in case ex of + SomeSymbol (_ :: Proxy ab) -> unsafeCoerce (SSym :: Sing ab) + +-- We need these in Data.Singletons.Prelude.Semigroup, as we need to promote +-- code that simultaneously uses the Min/Max constructors and the min/max +-- functions, which have clashing defunctionalization symbol names. Our +-- workaround is to simply define synonyms for min/max and use those instead. +min_, max_ :: Ord a => a -> a -> a +min_ = min +max_ = max + +type Min_ x y = Min x y +type Max_ x y = Max x y +$(genDefunSymbols [''Min_, ''Max_]) + +sMin_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Min_` y) +sMin_ = sMin + +sMax_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Max_` y) +sMax_ = sMax + +-- We need these in Data.Singletons.Prelude.Foldable. +all_ :: Bool -> All +all_ = All + +any_ :: Bool -> Any +any_ = Any + +sum_ :: a -> Sum a +sum_ = Sum + +product_ :: a -> Product a +product_ = Product + +type All_ a = 'All a +type Any_ a = 'Any a +type Sum_ a = 'Sum a +type Product_ a = 'Product a +$(genDefunSymbols [''All_, ''Any_, ''Sum_, ''Product_]) + +sAll_ :: forall (x :: Bool). Sing x -> Sing (All_ x) +sAll_ = SAll + +sAny_ :: forall (x :: Bool). Sing x -> Sing (Any_ x) +sAny_ = SAny + +sSum_ :: forall a (x :: a). Sing x -> Sing (Sum_ x) +sSum_ = SSum + +sProduct_ :: forall a (x :: a). Sing x -> Sing (Product_ x) +sProduct_ = SProduct diff --git a/src/Data/Singletons/Prelude/Show.hs b/src/Data/Singletons/Prelude/Show.hs --- a/src/Data/Singletons/Prelude/Show.hs +++ b/src/Data/Singletons/Prelude/Show.hs @@ -1,13 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE EmptyCase #-} -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -16,7 +16,7 @@ -- Module : Data.Singletons.Prelude.Show -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -26,7 +26,6 @@ module Data.Singletons.Prelude.Show ( PShow(..), SShow(..), SymbolS, SChar, show_, - type (<>), (%<>), Shows, sShows, ShowListWith, sShowListWith, ShowChar, sShowChar, @@ -41,7 +40,6 @@ ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, Show_Sym0, Show_Sym1, ShowListSym0, ShowListSym1, ShowListSym2, - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), ShowsSym0, ShowsSym1, ShowsSym2, ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3, ShowCharSym0, ShowCharSym1, ShowCharSym2, @@ -53,12 +51,14 @@ ) where import Data.List.NonEmpty (NonEmpty) +import Data.Ord (Down) import Data.Proxy import Data.Singletons.Internal import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances -import Data.Singletons.Prelude.List +import Data.Singletons.Prelude.List.Internal import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Semigroup.Internal import Data.Singletons.Promote import Data.Singletons.Single import Data.Singletons.TypeLits @@ -154,6 +154,8 @@ => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s + + deriving instance Show a => Show (Down a) |]) $(promoteOnly [d| @@ -171,8 +173,6 @@ 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 diff --git a/src/Data/Singletons/Prelude/Traversable.hs b/src/Data/Singletons/Prelude/Traversable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Prelude/Traversable.hs @@ -0,0 +1,286 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Traversable +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the promoted and singled versions of the 'Traversable' type class. +-- +---------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Traversable ( + PTraversable(..), STraversable(..), + For, sFor, + ForM, sForM, + MapAccumL, sMapAccumL, + MapAccumR, sMapAccumR, + FmapDefault, sFmapDefault, + FoldMapDefault, sFoldMapDefault, + + -- * Defunctionalization symbols + TraverseSym0, TraverseSym1, TraverseSym2, + SequenceASym0, SequenceASym1, + MapMSym0, MapMSym1, MapMSym2, + SequenceSym0, SequenceSym1, + + ForSym0, ForSym1, ForSym2, + ForMSym0, ForMSym1, ForMSym2, + MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, + MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, + FmapDefaultSym0, FmapDefaultSym1, FmapDefaultSym2, + FoldMapDefaultSym0, FoldMapDefaultSym1, FoldMapDefaultSym2 + ) where + +import Control.Applicative +import Data.Functor.Identity +import Data.Kind +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Monoid +import Data.Singletons.Internal +import Data.Singletons.Prelude.Base hiding (Const, ConstSym0) +import Data.Singletons.Prelude.Const +import Data.Singletons.Prelude.Foldable (PFoldable, SFoldable) +import Data.Singletons.Prelude.Functor +import Data.Singletons.Prelude.Identity +import Data.Singletons.Prelude.Instances +import Data.Singletons.Prelude.Monad.Internal +import Data.Singletons.Prelude.Monoid +import Data.Singletons.Single + +newtype StateL s a = StateL (s ~> (s, a)) +data instance Sing :: forall s a. StateL s a -> Type where + SStateL :: Sing x -> Sing ('StateL x) +data StateLSym0 :: forall s a. (s ~> (s, a)) ~> StateL s a +type instance Apply StateLSym0 x = 'StateL x + +newtype StateR s a = StateR (s ~> (s, a)) +data instance Sing :: forall s a. StateR s a -> Type where + SStateR :: Sing x -> Sing ('StateR x) +data StateRSym0 :: forall s a. (s ~> (s, a)) ~> StateR s a +type instance Apply StateRSym0 x = 'StateR x + +$(singletonsOnly [d| + -- -| Functors representing data structures that can be traversed from + -- left to right. + -- + -- A definition of 'traverse' must satisfy the following laws: + -- + -- [/naturality/] + -- @t . 'traverse' f = 'traverse' (t . f)@ + -- for every applicative transformation @t@ + -- + -- [/identity/] + -- @'traverse' Identity = Identity@ + -- + -- [/composition/] + -- @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@ + -- + -- A definition of 'sequenceA' must satisfy the following laws: + -- + -- [/naturality/] + -- @t . 'sequenceA' = 'sequenceA' . 'fmap' t@ + -- for every applicative transformation @t@ + -- + -- [/identity/] + -- @'sequenceA' . 'fmap' Identity = Identity@ + -- + -- [/composition/] + -- @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@ + -- + -- where an /applicative transformation/ is a function + -- + -- @t :: (Applicative f, Applicative g) => f a -> g a@ + -- + -- preserving the 'Applicative' operations, i.e. + -- + -- * @t ('pure' x) = 'pure' x@ + -- + -- * @t (x '<*>' y) = t x '<*>' t y@ + -- + -- and the identity functor @Identity@ and composition of functors @Compose@ + -- are defined as + -- + -- > newtype Identity a = Identity a + -- > + -- > instance Functor Identity where + -- > fmap f (Identity x) = Identity (f x) + -- > + -- > instance Applicative Identity where + -- > pure x = Identity x + -- > Identity f <*> Identity x = Identity (f x) + -- > + -- > newtype Compose f g a = Compose (f (g a)) + -- > + -- > instance (Functor f, Functor g) => Functor (Compose f g) where + -- > fmap f (Compose x) = Compose (fmap (fmap f) x) + -- > + -- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where + -- > pure x = Compose (pure (pure x)) + -- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x) + -- + -- (The naturality law is implied by parametricity.) + -- + -- Instances are similar to 'Functor', e.g. given a data type + -- + -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) + -- + -- a suitable instance would be + -- + -- > instance Traversable Tree where + -- > traverse f Empty = pure Empty + -- > traverse f (Leaf x) = Leaf <$> f x + -- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r + -- + -- This is suitable even for abstract types, as the laws for '<*>' + -- imply a form of associativity. + -- + -- The superclass instances should satisfy the following: + -- + -- * In the 'Functor' instance, 'fmap' should be equivalent to traversal + -- with the identity applicative functor ('fmapDefault'). + -- + -- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be + -- equivalent to traversal with a constant applicative functor + -- ('foldMapDefault'). + -- + class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where + -- {-# MINIMAL traverse | sequenceA #-} + + -- -| Map each element of a structure to an action, evaluate these actions + -- from left to right, and collect the results. For a version that ignores + -- the results see 'Data.Foldable.traverse_'. + traverse :: Applicative f => (a -> f b) -> t a -> f (t b) + traverse f = sequenceA . fmap f + + -- -| Evaluate each action in the structure from left to right, and + -- and collect the results. For a version that ignores the results + -- see 'Data.Foldable.sequenceA_'. + sequenceA :: Applicative f => t (f a) -> f (t a) + sequenceA = traverse id + + -- -| Map each element of a structure to a monadic action, evaluate + -- these actions from left to right, and collect the results. For + -- a version that ignores the results see 'Data.Foldable.mapM_'. + mapM :: Monad m => (a -> m b) -> t a -> m (t b) + mapM = traverse + + -- -| Evaluate each monadic action in the structure from left to + -- right, and collect the results. For a version that ignores the + -- results see 'Data.Foldable.sequence_'. + sequence :: Monad m => t (m a) -> m (t a) + sequence = sequenceA + |]) + +$(singletonsOnly [d| + -- instances for Prelude types + + deriving instance Traversable Maybe + deriving instance Traversable [] + deriving instance Traversable NonEmpty + deriving instance Traversable (Either a) + deriving instance Traversable ((,) a) + deriving instance Traversable (Const m) + deriving instance Traversable Dual + deriving instance Traversable Sum + deriving instance Traversable Product + deriving instance Traversable First + deriving instance Traversable Last + deriving instance Traversable Identity + + -- general functions + + -- -| 'for' is 'traverse' with its arguments flipped. For a version + -- that ignores the results see 'Data.Foldable.for_'. + for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) + for = flip traverse + + -- -| 'forM' is 'mapM' with its arguments flipped. For a version that + -- ignores the results see 'Data.Foldable.forM_'. + forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) + forM = flip mapM + + instance Functor (StateL s) where + fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v) + + instance Applicative (StateL s) where + pure x = StateL (\ s -> (s, x)) + StateL kf <*> StateL kv = StateL $ \ s -> + let (s', f) = kf s + (s'', v) = kv s' + in (s'', f v) + liftA2 f (StateL kx) (StateL ky) = StateL $ \s -> + let (s', x) = kx s + (s'', y) = ky s' + in (s'', f x y) + + instance Functor (StateR s) where + fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v) + + instance Applicative (StateR s) where + pure x = StateR (\ s -> (s, x)) + StateR kf <*> StateR kv = StateR $ \ s -> + let (s', v) = kv s + (s'', f) = kf s' + in (s'', f v) + liftA2 f (StateR kx) (StateR ky) = StateR $ \ s -> + let (s', y) = ky s + (s'', x) = kx s' + in (s'', f x y) + + -- -|The 'mapAccumL' function behaves like a combination of 'fmap' + -- and 'foldl'; it applies a function to each element of a structure, + -- passing an accumulating parameter from left to right, and returning + -- a final value of this accumulator together with the new structure. + mapAccumL :: forall t a b c. Traversable t + => (a -> b -> (a, c)) -> a -> t b -> (a, t c) + mapAccumL f s t = case traverse (StateL . flip f) t of + StateL g -> g s + + -- -|The 'mapAccumR' function behaves like a combination of 'fmap' + -- and 'foldr'; it applies a function to each element of a structure, + -- passing an accumulating parameter from right to left, and returning + -- a final value of this accumulator together with the new structure. + mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) + mapAccumR f s t = case traverse (StateR . flip f) t of + StateR g -> g s + + -- -| This function may be used as a value for `fmap` in a `Functor` + -- instance, provided that 'traverse' is defined. (Using + -- `fmapDefault` with a `Traversable` instance defined only by + -- 'sequenceA' will result in infinite recursion.) + -- + -- @ + -- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f) + -- @ + fmapDefault :: forall t a b . Traversable t + => (a -> b) -> t a -> t b + fmapDefault f x = case traverse (Identity . f) x of Identity y -> y + + -- -| This function may be used as a value for `Data.Foldable.foldMap` + -- in a `Foldable` instance. + -- + -- @ + -- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f) + -- @ + foldMapDefault :: forall t m a . (Traversable t, Monoid m) + => (a -> m) -> t a -> m + foldMapDefault f x = case traverse (mkConst . f) x of Const y -> y + where + mkConst :: m -> Const m () + mkConst = Const + |]) 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 @@ -1,12 +1,12 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, PolyKinds, - RankNTypes, TypeFamilies, GADTs, UndecidableInstances, TypeInType #-} + RankNTypes, TypeFamilies, GADTs, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Tuple -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- diff --git a/src/Data/Singletons/Prelude/Void.hs b/src/Data/Singletons/Prelude/Void.hs --- a/src/Data/Singletons/Prelude/Void.hs +++ b/src/Data/Singletons/Prelude/Void.hs @@ -1,16 +1,17 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyCase #-} -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} {-# 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) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- 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 @@ -23,16 +23,21 @@ import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum import Data.Singletons.Deriving.Show +import Data.Singletons.Deriving.Util import Data.Singletons.Partition import Data.Singletons.Util import Data.Singletons.Syntax import Prelude hiding (exp) import Control.Applicative (Alternative(..)) +import Control.Arrow (second) import Control.Monad import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Maybe +import Control.Monad.Writer import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) +import qualified Data.Set as Set +import Data.Set ( Set ) import Data.Maybe import qualified GHC.LanguageExtensions.Type as LangExt @@ -41,7 +46,7 @@ genPromotions :: DsMonad q => [Name] -> q [Dec] genPromotions names = do checkForRep names - infos <- mapM reifyWithWarning names + infos <- mapM reifyWithLocals names dinfos <- mapM dsInfo infos ddecs <- promoteM_ [] $ mapM_ promoteInfo dinfos return $ decsToTH ddecs @@ -64,11 +69,41 @@ promDecls <- promoteM_ decls $ promoteDecs ddecls return $ decsToTH promDecls --- | Generate defunctionalization symbols for existing type family +-- | Generate defunctionalization symbols for existing type families. +-- +-- 'genDefunSymbols' has reasonable support for type families that use +-- dependent quantification. For instance, this: +-- +-- @ +-- type family MyProxy k (a :: k) :: Type where +-- MyProxy k (a :: k) = Proxy a +-- +-- $('genDefunSymbols' [''MyProxy]) +-- @ +-- +-- Will generate the following defunctionalization symbols: +-- +-- @ +-- data MyProxySym0 :: Type ~> k ~> Type +-- data MyProxySym1 (k :: Type) :: k ~> Type +-- @ +-- +-- Note that @MyProxySym0@ is a bit more general than it ought to be, since +-- there is no dependency between the first kind (@Type@) and the second kind +-- (@k@). But this would require the ability to write something like: +-- +-- @ +-- data MyProxySym0 :: forall (k :: Type) ~> k ~> Type +-- @ +-- +-- Which currently isn't possible. So for the time being, the kind of +-- @MyProxySym0@ will be slightly more general, which means that under rare +-- circumstances, you may have to provide extra type signatures if you write +-- code which exploits the dependency in @MyProxy@'s kind. genDefunSymbols :: DsMonad q => [Name] -> q [Dec] genDefunSymbols names = do checkForRep names - infos <- mapM (dsInfo <=< reifyWithWarning) names + infos <- mapM (dsInfo <=< reifyWithLocals) names decs <- promoteMDecs [] $ concatMapM defunInfo infos return $ decsToTH decs @@ -106,26 +141,28 @@ -- | Produce an instance for 'PShow' from the given type promoteShowInstance :: DsMonad q => Name -> q [Dec] -promoteShowInstance = promoteInstance (mkShowInstance ForPromotion) "Show" +promoteShowInstance = promoteInstance mkShowInstance "Show" -- | Produce an instance for @(==)@ (type-level equality) from the given type promoteEqInstance :: DsMonad q => Name -> q [Dec] promoteEqInstance name = do (tvbs, cons) <- getDataD "I cannot make an instance of (==) for it." name - cons' <- concatMapM dsCon cons tvbs' <- mapM dsTvb tvbs - kind <- promoteType (foldType (DConT name) (map tvbToType tvbs')) + let data_ty = foldTypeTvbs (DConT name) tvbs' + cons' <- concatMapM (dsCon tvbs' data_ty) cons + kind <- promoteType (foldTypeTvbs (DConT name) tvbs') inst_decs <- mkEqTypeInstance kind cons' return $ decsToTH inst_decs -promoteInstance :: DsMonad q => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl) - -> String -> Name -> q [Dec] +promoteInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec] promoteInstance mk_inst class_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ class_name ++ " for it.") name - cons' <- concatMapM dsCon cons tvbs' <- mapM dsTvb tvbs - raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType tvbs')) cons' + let data_ty = foldTypeTvbs (DConT name) tvbs' + cons' <- concatMapM (dsCon tvbs' data_ty) cons + let data_decl = DataDecl name tvbs' cons' + raw_inst <- mk_inst Nothing data_ty data_decl decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst return $ decsToTH decs @@ -167,7 +204,7 @@ -- each defining equation of foo uses it the same way. The foo -- function will be promoted to a type familty Foo like this: -- --- type family Foo (n :: Nat) :: TyFun Bool Bool -> * where +-- type family Foo (n :: Nat) :: Bool ~> Bool where -- Foo Zero = Id -- Foo a = Not -- @@ -181,17 +218,21 @@ promoteDecs raw_decls = do decls <- expand raw_decls -- expand type synonyms checkForRepInDecls decls - PDecs { pd_let_decs = let_decs - , pd_class_decs = classes - , pd_instance_decs = insts - , pd_data_decs = datas - , pd_derived_eq_decs = derived_eq_decs } <- partitionDecs decls + PDecs { pd_let_decs = let_decs + , pd_class_decs = classes + , pd_instance_decs = insts + , pd_data_decs = datas + , pd_ty_syn_decs = ty_syns + , pd_open_type_family_decs = o_tyfams + , pd_closed_type_family_decs = c_tyfams + , pd_derived_eq_decs = derived_eq_decs } <- partitionDecs decls + defunTypeDecls ty_syns c_tyfams o_tyfams -- promoteLetDecs returns LetBinds, which we don't need at top level _ <- promoteLetDecs noPrefix let_decs mapM_ promoteClassDec classes - let all_meth_sigs = foldMap (lde_types . cd_lde) classes - mapM_ (promoteInstanceDec all_meth_sigs) insts + let orig_meth_sigs = foldMap (lde_types . cd_lde) classes + mapM_ (promoteInstanceDec orig_meth_sigs) insts mapM_ promoteDerivedEqDec derived_eq_decs promoteDataDecs datas @@ -202,9 +243,8 @@ mapM_ promoteDataDec data_decs where extract_rec_selectors :: DataDecl -> PrM [DLetDec] - extract_rec_selectors (DataDecl _nd data_name tvbs cons _derivings) = - let arg_ty = foldType (DConT data_name) - (map tvbToType tvbs) + extract_rec_selectors (DataDecl data_name tvbs cons) = + let arg_ty = foldTypeTvbs (DConT data_name) tvbs in getRecordSelectors arg_ty cons @@ -237,8 +277,8 @@ -- -- * for each nullary data constructor we generate a type synonym promoteDataDec :: DataDecl -> PrM () -promoteDataDec (DataDecl _nd name tvbs ctors _derivings) = do - ctorSyms <- buildDefunSymsDataD name tvbs ctors +promoteDataDec (DataDecl _name _tvbs ctors) = do + ctorSyms <- buildDefunSymsDataD ctors emitDecs ctorSyms -- Note [CUSKification] @@ -248,7 +288,7 @@ -- seems to be no way to avoid this, so we embrace it: -- -- * If a class type variable has no explicit kind, we make no effort to --- guess it and default to *. This is OK because before TypeInType we were +-- guess it and default to *. This is OK because before GHC 8.0, we were -- limited by KProxy anyway. -- -- * If a class type variable has an explicit kind, it is preserved. @@ -267,43 +307,51 @@ , lde_infix = infix_decls } }) = do let -- a workaround for GHC Trac #12928; see Note [CUSKification] - cuskify :: DTyVarBndr -> DTyVarBndr - cuskify (DPlainTV tvname) = DKindedTV tvname DStarT - cuskify tv = tv tvbs = map cuskify tvbs' let pClsName = promoteClassName cls_name pCxt <- mapM promote_superclass_pred cxt - sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs) - let defaults_list = Map.toList defaults - defaults_names = map fst defaults_list - (default_decs, ann_rhss, prom_rhss) - <- mapAndUnzip3M (promoteMethod Nothing meth_sigs) defaults_list + forallBind cls_kvs_to_bind $ do + sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs) + let defaults_list = Map.toList defaults + defaults_names = map fst defaults_list + (default_decs, ann_rhss, prom_rhss) + <- mapAndUnzip3M (promoteMethod Map.empty Nothing meth_sigs) defaults_list - let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) infix_decls + let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) + $ Map.toList infix_decls - -- no need to do anything to the fundeps. They work as is! - emitDecs [DClassD pCxt pClsName tvbs fundeps - (sig_decs ++ default_decs ++ infix_decls')] - let defaults_list' = zip defaults_names ann_rhss - proms = zip defaults_names prom_rhss - return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list' - , lde_proms = Map.fromList proms } }) + -- no need to do anything to the fundeps. They work as is! + emitDecs [DClassD pCxt pClsName tvbs fundeps + (sig_decs ++ default_decs ++ infix_decls')] + let defaults_list' = zip defaults_names ann_rhss + proms = zip defaults_names prom_rhss + cls_kvs_to_bind' = cls_kvs_to_bind <$ meth_sigs + return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list' + , lde_proms = Map.fromList proms + , lde_bound_kvs = cls_kvs_to_bind' } }) where + cls_kvb_names, cls_tvb_names, cls_kvs_to_bind :: Set Name + cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) tvbs' + cls_tvb_names = Set.fromList $ map extractTvbName tvbs' + cls_kvs_to_bind = cls_kvb_names `Set.union` cls_tvb_names + promote_sig :: Name -> DType -> PrM DDec promote_sig name ty = do let proName = promoteValNameLhs name (argKs, resK) <- promoteUnraveled ty args <- mapM (const $ qNewName "arg") argKs - emitDecsM $ defunctionalize proName (map Just argKs) (Just resK) + let tvbs = zipWith DKindedTV args argKs + emitDecsM $ defunReifyFixity proName tvbs (Just resK) return $ DOpenTypeFamilyD (DTypeFamilyHead proName - (zipWith DKindedTV args argKs) + tvbs (DKindSig resK) Nothing) promote_superclass_pred :: DPred -> PrM DPred promote_superclass_pred = go where + go (DForallPr {}) = fail "Cannot promote quantified constraints" go (DAppPr pr ty) = DAppPr <$> go pr <*> promoteType ty go (DSigPr pr _k) = go pr -- just ignore the kind; it can't matter go (DVarPr name) = fail $ "Cannot promote ConstraintKinds variables like " @@ -313,17 +361,20 @@ -- returns (unpromoted method name, ALetDecRHS) pairs promoteInstanceDec :: Map Name DType -> UInstDecl -> PrM AInstDecl -promoteInstanceDec meth_sigs +promoteInstanceDec orig_meth_sigs decl@(InstDecl { id_name = cls_name , id_arg_tys = inst_tys + , id_sigs = inst_sigs , id_meths = meths }) = do cls_tvb_names <- lookup_cls_tvb_names inst_kis <- mapM promoteType inst_tys - let subst = Map.fromList $ zip cls_tvb_names inst_kis - (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod (Just subst) meth_sigs) meths - emitDecs [DInstanceD Nothing [] (foldType (DConT pClsName) - inst_kis) meths'] - return (decl { id_meths = zip (map fst meths) ann_rhss }) + let kvs_to_bind = foldMap fvDType inst_kis + forallBind kvs_to_bind $ do + let subst = Map.fromList $ zip cls_tvb_names inst_kis + (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod inst_sigs (Just subst) orig_meth_sigs) meths + emitDecs [DInstanceD Nothing [] (foldType (DConT pClsName) + inst_kis) meths'] + return (decl { id_meths = zip (map fst meths) ann_rhss }) where pClsName = promoteClassName cls_name @@ -379,27 +430,21 @@ that's in the type namespace) and _then_ reifies it. -} -promoteMethod :: Maybe (Map Name DKind) +promoteMethod :: Map Name DType -- InstanceSigs for methods + -> Maybe (Map Name DKind) -- ^ instantiations for class tyvars (Nothing for default decls) -- See Note [Promoted class method kinds] -> Map Name DType -- method types -> (Name, ULetDecRHS) -> PrM (DDec, ALetDecRHS, DType) -- returns (type instance, ALetDecRHS, promoted RHS) -promoteMethod m_subst sigs_map (meth_name, meth_rhs) = do - (arg_kis, res_ki) <- lookup_meth_ty +promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do + (meth_arg_kis, meth_res_ki) <- lookup_meth_ty ((_, _, _, eqns), _defuns, ann_rhs) - <- promoteLetDecRHS (Just (arg_kis, res_ki)) sigs_map noPrefix meth_name meth_rhs - meth_arg_tvs <- mapM (const $ qNewName "a") arg_kis - let -- If we're dealing with an associated type family instance, substitute - -- in the kind of the instance for better kind information in the RHS - -- helper function. If we're dealing with a default family implementation - -- (m_subst = Nothing), there's no need for a substitution. - -- See Note [Promoted class method kinds] - do_subst = maybe id substKind m_subst - meth_arg_kis' = map do_subst arg_kis - meth_res_ki' = do_subst res_ki - helperNameBase = case nameBase proName of + <- promoteLetDecRHS (Just (meth_arg_kis, meth_res_ki)) Map.empty Map.empty + noPrefix meth_name meth_rhs + meth_arg_tvs <- mapM (const $ qNewName "a") meth_arg_kis + let helperNameBase = case nameBase proName of first:_ | not (isHsLetter first) -> "TFHelper" alpha -> alpha @@ -417,13 +462,14 @@ -- strictly necessary, as kind inference can figure them out just as well. family_args = map DVarT meth_arg_tvs helperName <- newUniqueName helperNameBase + let tvbs = zipWith DKindedTV meth_arg_tvs meth_arg_kis emitDecs [DClosedTypeFamilyD (DTypeFamilyHead helperName - (zipWith DKindedTV meth_arg_tvs meth_arg_kis') - (DKindSig meth_res_ki') + tvbs + (DKindSig meth_res_ki) Nothing) eqns] - emitDecsM (defunctionalize helperName (map Just meth_arg_kis') (Just meth_res_ki')) + emitDecsM (defunctionalize helperName Nothing tvbs (Just meth_res_ki)) return ( DTySynInstD proName (DTySynEqn family_args @@ -434,19 +480,38 @@ proName = promoteValNameLhs meth_name lookup_meth_ty :: PrM ([DKind], DKind) - lookup_meth_ty = case Map.lookup meth_name sigs_map of - Nothing -> do - mb_info <- dsReifyTypeNameInfo proName - -- See Note [Using dsReifyTypeNameInfo when promoting instances] - case mb_info of - Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _) - -> let arg_kis = map (default_to_star . extractTvbKind) tvbs - res_ki = default_to_star (resultSigToMaybeKind mb_res_ki) - in return (arg_kis, res_ki) - _ -> fail $ "Cannot find type annotation for " ++ show proName - Just ty -> promoteUnraveled ty + lookup_meth_ty = + case Map.lookup meth_name inst_sigs_map of + Just ty -> + -- We have an InstanceSig. These are easy: no substitution for clas + -- variables is required at all! + promoteUnraveled ty + Nothing -> do + -- We don't have an InstanceSig, so we must compute the kind to use + -- ourselves (possibly substituting for class variables below). + (arg_kis, res_ki) <- + case Map.lookup meth_name orig_sigs_map of + Nothing -> do + mb_info <- dsReifyTypeNameInfo proName + -- See Note [Using dsReifyTypeNameInfo when promoting instances] + case mb_info of + Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _) + -> let arg_kis = map (default_to_star . extractTvbKind) tvbs + res_ki = default_to_star (resultSigToMaybeKind mb_res_ki) + in return (arg_kis, res_ki) + _ -> fail $ "Cannot find type annotation for " ++ show proName + Just ty -> promoteUnraveled ty + let -- If we're dealing with an associated type family instance, substitute + -- in the kind of the instance for better kind information in the RHS + -- helper function. If we're dealing with a default family implementation + -- (m_subst = Nothing), there's no need for a substitution. + -- See Note [Promoted class method kinds] + do_subst = maybe id substKind m_subst + meth_arg_kis' = map do_subst arg_kis + meth_res_ki' = do_subst res_ki + pure (meth_arg_kis', meth_res_ki') - default_to_star Nothing = DStarT + default_to_star Nothing = DConT typeKindName default_to_star (Just k) = k {- @@ -484,22 +549,25 @@ promoteLetDecEnv :: (String, String) -> ULetDecEnv -> PrM ([DDec], ALetDecEnv) promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env , lde_types = type_env - , lde_infix = infix_decls }) = do - let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) infix_decls + , lde_infix = fix_env }) = do + let infix_decls = catMaybes $ map (uncurry promoteInfixDecl) + $ Map.toList fix_env -- promote all the declarations, producing annotated declarations let (names, rhss) = unzip $ Map.toList value_env (payloads, defun_decss, ann_rhss) - <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env prefixes) names rhss + <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env fix_env prefixes) names rhss emitDecs $ concat defun_decss - let decs = map payload_to_dec payloads ++ infix_decls' + bound_kvs <- allBoundKindVars + let decs = map payload_to_dec payloads ++ infix_decls -- build the ALetDecEnv - let let_dec_env' = LetDecEnv { lde_defns = Map.fromList $ zip names ann_rhss - , lde_types = type_env - , lde_infix = infix_decls - , lde_proms = Map.empty } -- filled in promoteLetDecs + let let_dec_env' = LetDecEnv { lde_defns = Map.fromList $ zip names ann_rhss + , lde_types = type_env + , lde_infix = fix_env + , lde_proms = Map.empty -- filled in promoteLetDecs + , lde_bound_kvs = Map.fromList $ map (, bound_kvs) names } return (decs, let_dec_env') where @@ -509,14 +577,22 @@ where sig = maybe DNoSig DKindSig m_ki -promoteInfixDecl :: Fixity -> Name -> Maybe DDec -promoteInfixDecl fixity name - | isDataConName name || not (isHsLetter (head (nameBase name))) - = Nothing -- No need to promote fixity declarations for constructor names or - -- infix names, as those fixity declarations apply to both - -- the value and type namespaces. +promoteInfixDecl :: Name -> Fixity -> Maybe DDec +promoteInfixDecl name fixity + | nameBase name == nameBase promoted_name + -- If a name and its promoted counterpart are the same (modulo module + -- prefixes), then there's no need to promote a fixity declaration for + -- that name, since the existing fixity declaration will cover both + -- the term- and type-level versions of that name, + -- + -- Names that fall into this category include data constructor names + -- and infix names, with the exceptions of (.) and (!). + -- See Note [Special cases for (.) and (!)] in Data.Singletons.Names. + = Nothing | otherwise - = Just $ DLetDec $ DInfixD fixity (promoteValNameLhs name) + = Just $ DLetDec $ DInfixD fixity promoted_name + where + promoted_name = promoteValNameLhs name -- This function is used both to promote class method defaults and normal -- let bindings. Thus, it can't quite do all the work locally and returns @@ -524,13 +600,14 @@ promoteLetDecRHS :: Maybe ([DKind], DKind) -- the promoted type of the RHS (if known) -- needed to fix #136 -> Map Name DType -- local type env't + -> Map Name Fixity -- local fixity env't -> (String, String) -- let-binding prefixes -> Name -- name of the thing being promoted -> ULetDecRHS -- body of the thing -> PrM ( (Name, [DTyVarBndr], Maybe DKind, [DTySynEqn]) -- "type family" , [DDec] -- defunctionalization , ALetDecRHS ) -- annotated RHS -promoteLetDecRHS m_rhs_ki type_env prefixes name (UValue exp) = do +promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UValue exp) = do (res_kind, num_arrows) <- case m_rhs_ki of Just (arg_kis, res_ki) -> return ( Just (ravelTyFun (arg_kis ++ [res_ki])) @@ -543,10 +620,13 @@ case num_arrows of 0 -> do all_locals <- allLocals - (exp', ann_exp) <- promoteExp exp + let lde_kvs_to_bind = foldMap fvDType res_kind + (exp', ann_exp) <- forallBind lde_kvs_to_bind $ promoteExp exp let proName = promoteValNameLhsPrefix prefixes name - defuns <- defunctionalize proName (map (const Nothing) all_locals) res_kind - return ( ( proName, map DPlainTV all_locals, res_kind + m_fixity = Map.lookup name fix_env + tvbs = map DPlainTV all_locals + defuns <- defunctionalize proName m_fixity tvbs res_kind + return ( ( proName, tvbs, res_kind , [DTySynEqn (map DVarT all_locals) exp'] ) , defuns , AValue (foldType (DConT proName) (map DVarT all_locals)) @@ -555,10 +635,10 @@ names <- replicateM num_arrows (newUniqueName "a") let pats = map DVarPa names newArgs = map DVarE names - promoteLetDecRHS m_rhs_ki type_env prefixes name + promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction [DClause pats (foldExp exp newArgs)]) -promoteLetDecRHS m_rhs_ki type_env prefixes name (UFunction clauses) = do +promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction clauses) = do numArgs <- count_args clauses (m_argKs, m_resK, ty_num_args) <- case m_rhs_ki of Just (arg_kis, res_ki) -> return (map Just arg_kis, Just res_ki, length arg_kis) @@ -573,28 +653,37 @@ | otherwise -> return (replicate numArgs Nothing, Nothing, numArgs) - let proName = promoteValNameLhsPrefix prefixes name + let proName = promoteValNameLhsPrefix prefixes name + m_fixity = Map.lookup name fix_env all_locals <- allLocals - defun_decs <- defunctionalize proName - (map (const Nothing) all_locals ++ m_argKs) m_resK let local_tvbs = map DPlainTV all_locals tyvarNames <- mapM (const $ qNewName "a") m_argKs - expClauses <- mapM (etaExpand (ty_num_args - numArgs)) clauses - (eqns, ann_clauses) <- mapAndUnzipM promoteClause expClauses - prom_fun <- lookupVarE name let args = zipWith inferMaybeKindTV tyvarNames m_argKs all_args = local_tvbs ++ args + defun_decs <- defunctionalize proName m_fixity all_args m_resK + expClauses <- mapM (etaContractOrExpand ty_num_args numArgs) clauses + let lde_kvs_to_bind = foldMap (foldMap fvDType) m_argKs <> foldMap fvDType m_resK + (eqns, ann_clauses) <- forallBind lde_kvs_to_bind $ + mapAndUnzipM promoteClause expClauses + prom_fun <- lookupVarE name return ( (proName, all_args, m_resK, eqns) , defun_decs , AFunction prom_fun ty_num_args ann_clauses ) where - etaExpand :: Int -> DClause -> PrM DClause - etaExpand n (DClause pats exp) = do - names <- replicateM n (newUniqueName "a") - let newPats = map DVarPa names - newArgs = map DVarE names - return $ DClause (pats ++ newPats) (foldExp exp newArgs) + etaContractOrExpand :: Int -> Int -> DClause -> PrM DClause + etaContractOrExpand ty_num_args clause_num_args (DClause pats exp) + | n >= 0 = do -- Eta-expand + names <- replicateM n (newUniqueName "a") + let newPats = map DVarPa names + newArgs = map DVarE names + return $ DClause (pats ++ newPats) (foldExp exp newArgs) + | otherwise = do -- Eta-contract + let (clausePats, lamPats) = splitAt ty_num_args pats + lamExp <- mkDLamEFromDPats lamPats exp + return $ DClause clausePats lamExp + where + n = ty_num_args - clause_num_args count_args (DClause pats _ : _) = return $ length pats count_args _ = fail $ "Impossible! A function without clauses." @@ -603,51 +692,62 @@ promoteClause (DClause pats exp) = do -- promoting the patterns creates variable bindings. These are passed -- to the function promoted the RHS - (types, new_vars) <- evalForPair $ mapM promotePat pats - (ty, ann_exp) <- lambdaBind new_vars $ promoteExp exp + ((types, pats'), prom_pat_infos) <- evalForPair $ mapAndUnzipM promotePat pats + let PromDPatInfos { prom_dpat_vars = new_vars + , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos + (ty, ann_exp) <- forallBind sig_kvs $ + lambdaBind new_vars $ + promoteExp exp all_locals <- allLocals -- these are bound *outside* of this clause return ( DTySynEqn (map DVarT all_locals ++ types) ty - , ADClause new_vars pats ann_exp ) + , ADClause new_vars pats' ann_exp ) promoteMatch :: DMatch -> PrM (DTySynEqn, ADMatch) promoteMatch (DMatch pat exp) = do -- promoting the patterns creates variable bindings. These are passed -- to the function promoted the RHS - (ty, new_vars) <- evalForPair $ promotePat pat - (rhs, ann_exp) <- lambdaBind new_vars $ promoteExp exp + ((ty, pat'), prom_pat_infos) <- evalForPair $ promotePat pat + let PromDPatInfos { prom_dpat_vars = new_vars + , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos + (rhs, ann_exp) <- forallBind sig_kvs $ + lambdaBind new_vars $ + promoteExp exp all_locals <- allLocals return $ ( DTySynEqn (map DVarT all_locals ++ [ty]) rhs - , ADMatch new_vars pat ann_exp) + , ADMatch new_vars pat' ann_exp) -- promotes a term pattern into a type pattern, accumulating bound variable names -promotePat :: DPat -> QWithAux VarPromotions PrM DType -promotePat (DLitPa lit) = do - lit' <- promoteLitPat lit - return lit' +promotePat :: DPat -> QWithAux PromDPatInfos PrM (DType, ADPat) +promotePat (DLitPa lit) = (, ADLitPa lit) <$> promoteLitPat lit promotePat (DVarPa name) = do -- term vars can be symbols... type vars can't! tyName <- mkTyName name - addElement (name, tyName) - return $ DVarT tyName + tell $ PromDPatInfos [(name, tyName)] Set.empty + return (DVarT tyName, ADVarPa name) promotePat (DConPa name pats) = do - types <- mapM promotePat pats + (types, pats') <- mapAndUnzipM promotePat pats let name' = unboxed_tuple_to_tuple name - return $ foldType (DConT name') types + return (foldType (DConT name') types, ADConPa name pats') where unboxed_tuple_to_tuple n | Just deg <- unboxedTupleNameDegree_maybe n = tupleDataName deg | otherwise = n promotePat (DTildePa pat) = do qReportWarning "Lazy pattern converted into regular pattern in promotion" - promotePat pat + second ADTildePa <$> promotePat pat promotePat (DBangPa pat) = do qReportWarning "Strict pattern converted into regular pattern in promotion" - promotePat pat + second ADBangPa <$> promotePat pat promotePat (DSigPa pat ty) = do - promoted <- promotePat pat + -- We must maintain the invariant that any promoted pattern signature must + -- not have any wildcards in the underlying pattern. + -- See Note [Singling pattern signatures]. + wildless_pat <- removeWilds pat + (promoted, pat') <- promotePat wildless_pat ki <- promoteType ty - return $ DSigT promoted ki -promotePat DWildPa = return DWildCardT + tell $ PromDPatInfos [] (fvDType ki) + return (DSigT promoted ki, ADSigPa promoted pat' ki) +promotePat DWildPa = return (DWildCardT, ADWildPa) promoteExp :: DExp -> PrM (DType, ADExp) promoteExp (DVarE name) = fmap (, ADVarE name) $ lookupVarE name @@ -677,7 +777,7 @@ Nothing) [DTySynEqn (map DVarT (all_locals ++ tyNames)) rhs]] - emitDecsM $ defunctionalize lambdaName (map (const Nothing) all_args) Nothing + emitDecsM $ defunctionalize lambdaName Nothing tvbs Nothing let promLambda = foldl apply (DConT (promoteTySym lambdaName 0)) (map DVarT all_locals) return (promLambda, ADLamE tyNames promLambda names ann_exp) @@ -704,7 +804,7 @@ promoteExp (DSigE exp ty) = do (exp', ann_exp) <- promoteExp exp ty' <- promoteType ty - return (DSigT exp' ty', ADSigE ann_exp ty) + return (DSigT exp' ty', ADSigE exp' ann_exp ty) promoteExp e@(DStaticE _) = fail ("Static expressions cannot be promoted: " ++ show e) promoteLitExp :: Quasi q => Lit -> q DType @@ -733,7 +833,8 @@ -- See Note [DerivedDecl] promoteDerivedEqDec :: DerivedEqDecl -> PrM () -promoteDerivedEqDec (DerivedDecl { ded_type = ty, ded_cons = cons }) = do +promoteDerivedEqDec (DerivedDecl { ded_type = ty + , ded_decl = DataDecl _ _ 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 @@ -15,8 +15,13 @@ import Data.Singletons.Promote.Type import Data.Singletons.Names import Language.Haskell.TH.Syntax +import Data.Singletons.Syntax import Data.Singletons.Util import Control.Monad +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import Data.Maybe +import qualified Data.Set as Set defunInfo :: DInfo -> PrM [DDec] defunInfo (DTyConI dec _instances) = buildDefunSyms dec @@ -30,39 +35,78 @@ defunInfo (DPatSynI {}) = fail "Building defunctionalization symbols of pattern synonyms not supported" +defunTypeDecls :: [TySynDecl] + -> [ClosedTypeFamilyDecl] + -> [OpenTypeFamilyDecl] + -> PrM () +defunTypeDecls ty_syns c_tyfams o_tyfams = do + defun_ty_syns <- + concatMapM (\(TySynDecl name tvbs) -> buildDefunSymsTySynD name tvbs) ty_syns + defun_c_tyfams <- + concatMapM (buildDefunSymsClosedTypeFamilyD . getTypeFamilyDecl) c_tyfams + defun_o_tyfams <- + concatMapM (buildDefunSymsOpenTypeFamilyD . getTypeFamilyDecl) o_tyfams + emitDecs $ defun_ty_syns ++ defun_c_tyfams ++ defun_o_tyfams + buildDefunSyms :: DDec -> PrM [DDec] -buildDefunSyms (DDataD _new_or_data _cxt tyName tvbs ctors _derivings) = - buildDefunSymsDataD tyName tvbs ctors -buildDefunSyms (DClosedTypeFamilyD (DTypeFamilyHead name tvbs result_sig _) _) = do - let arg_m_kinds = map extractTvbKind tvbs - defunctionalize name arg_m_kinds (resultSigToMaybeKind result_sig) -buildDefunSyms (DOpenTypeFamilyD (DTypeFamilyHead name tvbs result_sig _)) = do - let arg_kinds = map (default_to_star . extractTvbKind) tvbs - res_kind = default_to_star (resultSigToMaybeKind result_sig) - default_to_star Nothing = Just DStarT - default_to_star (Just k) = Just k - defunctionalize name arg_kinds res_kind -buildDefunSyms (DTySynD name tvbs _type) = do - let arg_m_kinds = map extractTvbKind tvbs - defunctionalize name arg_m_kinds Nothing +buildDefunSyms (DDataD _new_or_data _cxt _tyName _tvbs _k ctors _derivings) = + buildDefunSymsDataD ctors +buildDefunSyms (DClosedTypeFamilyD tf_head _) = + buildDefunSymsClosedTypeFamilyD tf_head +buildDefunSyms (DOpenTypeFamilyD tf_head) = + buildDefunSymsOpenTypeFamilyD tf_head +buildDefunSyms (DTySynD name tvbs _type) = + buildDefunSymsTySynD name tvbs buildDefunSyms (DClassD _cxt name tvbs _fundeps _members) = do - let arg_m_kinds = map extractTvbKind tvbs - defunctionalize name arg_m_kinds (Just (DConT constraintName)) + defunReifyFixity name tvbs (Just (DConT constraintName)) buildDefunSyms _ = fail $ "Defunctionalization symbols can only be built for " ++ "type families and data declarations" -buildDefunSymsDataD :: Name -> [DTyVarBndr] -> [DCon] -> PrM [DDec] -buildDefunSymsDataD tyName tvbs ctors = do - let res_ty = foldType (DConT tyName) (map tvbToType tvbs) - res_ki <- promoteType res_ty - concatMapM (promoteCtor res_ki) ctors +buildDefunSymsClosedTypeFamilyD :: DTypeFamilyHead -> PrM [DDec] +buildDefunSymsClosedTypeFamilyD = buildDefunSymsTypeFamilyHead id id + +buildDefunSymsOpenTypeFamilyD :: DTypeFamilyHead -> PrM [DDec] +buildDefunSymsOpenTypeFamilyD = buildDefunSymsTypeFamilyHead cuskify default_to_star where - promoteCtor :: DKind -> DCon -> PrM [DDec] - promoteCtor promotedKind ctor = do + default_to_star :: Maybe DKind -> Maybe DKind + default_to_star Nothing = Just $ DConT typeKindName + default_to_star (Just k) = Just k + +buildDefunSymsTypeFamilyHead + :: (DTyVarBndr -> DTyVarBndr) + -> (Maybe DKind -> Maybe DKind) + -> DTypeFamilyHead -> PrM [DDec] +buildDefunSymsTypeFamilyHead default_tvb default_kind + (DTypeFamilyHead name tvbs result_sig _) = do + let arg_tvbs = map default_tvb tvbs + res_kind = default_kind (resultSigToMaybeKind result_sig) + defunReifyFixity name arg_tvbs res_kind + +buildDefunSymsTySynD :: Name -> [DTyVarBndr] -> PrM [DDec] +buildDefunSymsTySynD name tvbs = + defunReifyFixity name tvbs Nothing + +buildDefunSymsDataD :: [DCon] -> PrM [DDec] +buildDefunSymsDataD ctors = + concatMapM promoteCtor ctors + where + promoteCtor :: DCon -> PrM [DDec] + promoteCtor ctor@(DCon _ _ _ _ res_ty) = do let (name, arg_tys) = extractNameTypes ctor + tvb_names <- replicateM (length arg_tys) $ qNewName "t" arg_kis <- mapM promoteType arg_tys - defunctionalize name (map Just arg_kis) (Just promotedKind) + let arg_tvbs = zipWith DKindedTV tvb_names arg_kis + res_ki <- promoteType res_ty + defunReifyFixity name arg_tvbs (Just res_ki) +-- Generate defunctionalization symbols for a name, using reifyFixityWithLocals +-- to determine what the fixity of each symbol should be. +-- See Note [Fixity declarations for defunctionalization symbols] +defunReifyFixity :: Name -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec] +defunReifyFixity name tvbs m_res_kind = do + m_fixity <- reifyFixityWithLocals name + defunctionalize name m_fixity tvbs m_res_kind + -- Generate data declarations and apply instances -- required for defunctionalization. -- For a type family: @@ -96,99 +140,393 @@ -- -- The defunctionalize function takes Maybe DKinds so that the caller can -- indicate which kinds are known and which need to be inferred. -defunctionalize :: Name -> [Maybe DKind] -> Maybe DKind -> PrM [DDec] -defunctionalize name m_arg_kinds' m_res_kind' = do - let (m_arg_kinds, m_res_kind) = eta_expand (noExactTyVars m_arg_kinds') - (noExactTyVars m_res_kind') - num_args = length m_arg_kinds +-- +-- See also Note [Defunctionalization and dependent quantification] +defunctionalize :: Name + -> Maybe Fixity -- The name's fixity, if one was declared. + -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec] +defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do + (m_arg_tvbs, m_res_kind) <- eta_expand (noExactTyVars m_arg_tvbs') + (noExactTyVars m_res_kind') + + let -- Implements part (2)(i) from Note [Defunctionalization and dependent quantification] + tvb_to_type_map :: Map Name DType + tvb_to_type_map = Map.fromList $ -- (2)(i)(c) + map (\tvb -> (extractTvbName tvb, dTyVarBndrToDType tvb)) $ + toposortTyVarsOf $ -- (2)(i)(b) + map dTyVarBndrToDType m_arg_tvbs + ++ maybeToList m_res_kind -- (2)(i)(a) + + go :: Int -> [DTyVarBndr] -> Maybe DKind + -> ([DTyVarBndr] -> DType) -- given the argument tyvar binders, + -- produce the RHS of the Apply instance + -> PrM [DDec] + go _ [] _ _ = return [] + go n (m_arg : m_args) m_result mk_rhs = do + extra_name <- qNewName "arg" + let tyfun_name = extractTvbName m_arg + data_name = promoteTySym name n + next_name = promoteTySym name (n+1) + con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name + m_tyfun = buildTyFunArrow_maybe (extractTvbKind m_arg) m_result + arg_params = -- Implements part (2)(ii) from + -- Note [Defunctionalization and dependent quantification] + map (map_tvb_kind (substType tvb_to_type_map)) $ + reverse m_args + tyfun_param = mk_tvb tyfun_name m_tyfun + arg_names = map extractTvbName arg_params + params = arg_params ++ [tyfun_param] + con_eq_ct = DConPr sameKindName `DAppPr` lhs `DAppPr` rhs + where + lhs = foldType (DConT data_name) (map DVarT arg_names) `apply` (DVarT extra_name) + rhs = foldType (DConT next_name) (map DVarT (arg_names ++ [extra_name])) + con_decl = DCon (map dropTvbKind params ++ [DPlainTV extra_name]) + [con_eq_ct] + con_name + (DNormalC False []) + (foldTypeTvbs (DConT data_name) params) + data_decl = DDataD Data [] data_name args res_ki [con_decl] [] + where + (args, res_ki) + = case m_tyfun of + Nothing -> (params, Nothing) + -- If we cannot infer the return type, don't bother + -- trying to construct an explicit return kind. + Just tyfun -> + let bound_tvs = Set.fromList (map extractTvbName arg_params) `Set.union` + foldMap (foldMap fvDType) (map extractTvbKind arg_params) + not_bound tvb = not (extractTvbName tvb `Set.member` bound_tvs) + tvb_to_type tvb_name = fromMaybe (DVarT tvb_name) $ + Map.lookup tvb_name tvb_to_type_map + -- Implements part (2)(iii) from + -- Note [Defunctionalization and dependent quantification] + tyfun_tvbs = filter not_bound $ -- (2)(iii)(d) + toposortTyVarsOf $ -- (2)(iii)(c) + map tvb_to_type $ -- (2)(iii)(b) + Set.toList $ fvDType tyfun -- (2)(iii)(a) + in (arg_params, Just (DForallT tyfun_tvbs [] tyfun)) + app_data_ty = foldTypeTvbs (DConT data_name) m_args + app_eqn = DTySynEqn [app_data_ty, DVarT tyfun_name] + (mk_rhs (m_args ++ [DPlainTV tyfun_name])) + app_decl = DTySynInstD applyName app_eqn + suppress = DInstanceD Nothing [] + (DConT suppressClassName `DAppT` app_data_ty) + [DLetDec $ DFunD suppressMethodName + [DClause [] + ((DVarE 'snd) `DAppE` + mkTupleDExp [DConE con_name, + mkTupleDExp []])]] + + mk_rhs' = foldTypeTvbs (DConT data_name) + + -- See Note [Fixity declarations for defunctionalization symbols] + mk_fix_decl f = DLetDec $ DInfixD f data_name + fixity_decl = maybeToList $ fmap mk_fix_decl m_fixity + + decls <- go (n - 1) m_args m_tyfun mk_rhs' + return $ suppress : data_decl : app_decl : fixity_decl ++ decls + + let num_args = length m_arg_tvbs sat_name = promoteTySym name num_args - tvbNames <- replicateM num_args $ qNewName "t" - let mk_rhs ns = foldType (DConT name) (map DVarT ns) - sat_dec = DTySynD sat_name (zipWith mk_tvb tvbNames m_arg_kinds) (mk_rhs tvbNames) - other_decs <- go (num_args - 1) (reverse m_arg_kinds) m_res_kind mk_rhs + mk_rhs = foldTypeTvbs (DConT name) + sat_dec = DTySynD sat_name m_arg_tvbs (mk_rhs m_arg_tvbs) + + other_decs <- go (num_args - 1) (reverse m_arg_tvbs) m_res_kind mk_rhs return $ sat_dec : other_decs where mk_tvb :: Name -> Maybe DKind -> DTyVarBndr mk_tvb tvb_name Nothing = DPlainTV tvb_name mk_tvb tvb_name (Just k) = DKindedTV tvb_name k - eta_expand :: [Maybe DKind] -> Maybe DKind -> ([Maybe DKind], Maybe DKind) - eta_expand m_arg_kinds Nothing = (m_arg_kinds, Nothing) - eta_expand m_arg_kinds (Just res_kind) = + eta_expand :: [DTyVarBndr] -> Maybe DKind -> PrM ([DTyVarBndr], Maybe DKind) + eta_expand m_arg_tvbs Nothing = pure (m_arg_tvbs, Nothing) + eta_expand m_arg_tvbs (Just res_kind) = do let (_, _, argKs, resultK) = unravel res_kind - in (m_arg_kinds ++ (map Just argKs), Just resultK) + tvb_names <- replicateM (length argKs) $ qNewName "e" + let res_kind_arg_tvbs = zipWith DKindedTV tvb_names argKs + pure (m_arg_tvbs ++ res_kind_arg_tvbs, Just resultK) - go :: Int -> [Maybe DKind] -> Maybe DKind - -> ([Name] -> DType) -- given the argument names, the RHS of the Apply instance - -> PrM [DDec] - go _ [] _ _ = return [] - go n (m_arg : m_args) m_result mk_rhs = do - fst_name : rest_names <- replicateM (n + 1) (qNewName "l") - extra_name <- qNewName "arg" - let data_name = promoteTySym name n - next_name = promoteTySym name (n+1) - con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name - m_tyfun = buildTyFun_maybe m_arg m_result - arg_params = zipWith mk_tvb rest_names (reverse m_args) - tyfun_param = mk_tvb fst_name m_tyfun - arg_names = map extractTvbName arg_params - params = arg_params ++ [tyfun_param] - con_eq_ct = DConPr sameKindName `DAppPr` lhs `DAppPr` rhs - where - lhs = foldType (DConT data_name) (map DVarT arg_names) `apply` (DVarT extra_name) - rhs = foldType (DConT next_name) (map DVarT (arg_names ++ [extra_name])) - con_decl = DCon [DPlainTV extra_name] - [con_eq_ct] - con_name - (DNormalC False []) - Nothing - data_decl = DDataD Data [] data_name params [con_decl] [] - app_eqn = DTySynEqn [ foldType (DConT data_name) - (map DVarT rest_names) - , DVarT fst_name ] - (mk_rhs (rest_names ++ [fst_name])) - app_decl = DTySynInstD applyName app_eqn - suppress = DInstanceD Nothing [] - (DConT suppressClassName `DAppT` DConT data_name) - [DLetDec $ DFunD suppressMethodName - [DClause [] - ((DVarE 'snd) `DAppE` - mkTupleDExp [DConE con_name, - mkTupleDExp []])]] + map_tvb_kind :: (DKind -> DKind) -> DTyVarBndr -> DTyVarBndr + map_tvb_kind _ tvb@DPlainTV{} = tvb + map_tvb_kind f (DKindedTV n k) = DKindedTV n (f k) - mk_rhs' ns = foldType (DConT data_name) (map DVarT ns) +{- +Note [Defunctionalization and dependent quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The machinery in this module supports defunctionalizing types that use +dependent quantification, such as in the following example: - decls <- go (n - 1) m_args (addStar_maybe (buildTyFun_maybe m_arg m_result)) mk_rhs' - return $ suppress : data_decl : app_decl : decls + type family Symmetry (a :: Proxy t) (y :: Proxy t) + (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where + Symmetry a y _ = y :~: a -buildTyFun :: DKind -> DKind -> DKind -buildTyFun k1 k2 = DConT tyFunName `DAppT` k1 `DAppT` k2 +Here is what is involved in making this happen: -buildTyFun_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind -buildTyFun_maybe m_k1 m_k2 = do - k1 <- m_k1 - k2 <- m_k2 - return $ DConT tyFunName `DAppT` k1 `DAppT` k2 +1. When defunctionalizing, we must not only know the argument kinds, but rather + the argument *kind variable binders*. This is essential since, for instance, + Symmetry dependently quantifies `a` and `y` and uses them in the kind of + `e`. If we did not track the original kind variable names, then instead of + generating this defunctionalization symbol for Symmetry: --- Counts the arity of type level function represented with TyFun constructors -tyFunArity :: DKind -> Int -tyFunArity (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` b) `DAppT` DStarT) - | tyFunName == tyFunNm - = 1 + tyFunArity b -tyFunArity _ = 0 + data SymmetrySym2 (a :: Proxy t) (y :: Proxy t) :: (a :~: y) ~> Type --- Checks if type is (TyFun a b -> *) -isTyFun :: DKind -> Bool -isTyFun (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` _) `DAppT` DStarT) - | tyFunName == tyFunNm - = True -isTyFun _ = False + We would generate something more general, like this: --- Build TyFun kind from the list of kinds + data SymmetrySym2 (abc1 :: Proxy t) (abc2 :: Proxy t) :: (a :~: y) ~> Type + + Alas, there are times where will have no choice but to write a slightly + more general kind than we should. For instance, consider this: + + data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type + + This defunctionalization symbol doesn't capture the dependent quantification + in the first and second argument kinds. But in order to do that properly, + you'd need the ability to write something like: + + data SymmetrySym0 :: forall (a :: Proxy t) ~> forall (y :: Proxy t) + ~> (a :~: y) ~> Type + + It is my (RGS's) belief that it is not possible to achieve something like + this in today's GHC (see #304), so we'll just have to live with SymmetrySym0 + being slightly more general than it ought to be. In practice, this is + unlikely to bite unless you're writing code that specifically exploits this + dependency in just the right way. + +2. I pulled a fast one earlier by writing: + + data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type + + GHC will actually reject this, because it does not have a CUSK. There are + two glaring problems here: + + (a) The kind of `t` is underdetermined. + (b) `a` and `y` should have kind `Proxy t`, but this is not currently the case. + + Ultimately, the fix is to use explicit kind signatures. A naïve attempt + would be something like this: + + data SymmetrySym0 :: Proxy (t :: (k :: Type)) ~> Proxy (t :: (k :: Type)) + ~> ((a :: Proxy (t :: (k :: Type))) :~: (y :: Proxy (t :: (k :: Type)))) + ~> Type + + While that works, it adds a nontrivial amount of clutter. Plus, it requires + figuring out (in Template Haskell) which variables have underdetermined + kinds and substituting for them. Blegh. A much cleaner approach is: + + data SymmetrySym0 :: forall (k :: Type) (t :: k) (a :: Proxy t) (y :: Proxy t). + Proxy t ~> Proxy t ~> (a :~: y) ~> Type + + This time, all we have to do is put an explicit `forall` in front, and we + achieve a CUSK without having to muck up the body of return kind. It also + has the benefit of looking much nicer in generated code. + + Let's talk about how to achieve this feat, using SymmetrySym1 as the + guiding example: + + (i) Before we begin defunctionalizing a type, we construct a mapping from + variable names to their corresponding types, complete with kinds. + For instance, in Symmetry, we would have the following map: + + { k :-> DVarT k -- k + , t :-> DSigT (DVarT t) (DVarT k) -- (t :: k) + , a :-> DSigT (DVarT a) (DConT ''Proxy `DAppT` DVarT t) -- (a :: Proxy t) + , y :-> DSigT (DVarT y) (DConT ''Proxy `DAppT` DVarT y) -- (y :: Proxy t) + , e :-> DSigT (DVarT e) (DConT ''(:~:) + `DAppT` DSigT (DVarT a) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k)) + `DAppT` DSigT (DVarT y) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k))) + -- (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + } + + Why do this? Because when constructing the `forall` in the return kind + of a defunctionalization symbol, it's convenient to be able to know + the kinds of everything being bound at a glance. It's not always + possible to recover the kinds of every variable (for instance, if + we're just given `Proxy t ~> Proxy t ~> (a :~: y) ~> Type`), so having + this information is handy. + + To construct this map, we: + + (a) Grab the list of type variable binders (this is given as an input + to defunctionalize, as discussed in part (1)) and turn it into a list + of types. Also include the return kind (if there is one) in this + list, as it may also mention type variables with explicit kinds. + (b) Construct a flat list of all type variables mentioned in this list. + This may involve looking in the kinds of type variables binders. + (Note that this part is crucial—the the Singletons/PolyKinds test + will fail to compile without it!) + (c) Take the flat list and insert each variable into the map by + mapping its name to its type (as demonstrated above). + + To continue the Symmetry example: + + (a) We grab the list of type variable binders + + [ (a :: Proxy t) + , (y :: Proxy t) + , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + ] + + from the Symmetry declaration. Including the return kind (Type), + we get: + + [ (a :: Proxy t) + , (y :: Proxy t) + , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + , Type + ] + + (b) We flatten this into a list of well scoped type variables: + + [ k + , (t :: k) + , (a :: Proxy t) + , (y :: Proxy t) + , (e :: (a :: Proxy (t :: k)) :~: (y :~: Proxy (t :: k))) + ] + + (c) From this, we construct the map shown at the beginning of (i). + + (ii) Using the map, we will annotate any kind variables in the LHS of the + declaration with their respective kinds. In this example, the LHS is: + + data SymmetrySym1 (a :: Proxy t) :: ... + + Since `t` maps to simply `(t :: k)` in the map, the LHS becomes: + + data SymmetrySym1 (a :: Proxy (t :: k)) :: ... + + Why do this? Because we need to make it apparent that `k` is bound on + the LHS. If we don't, we might end up trying to quantify `k` in the + return kind (see #353 for an example of what goes wrong if you try to + do this). + + Having to explicitly annotate each occurrence of every kind variable on + the LHS like this is a bit tiresome, especially since we don't have to + do this in the return kind. If GHC had syntax for visible dependent + quantification, we could avoid this step entirely and simply write: + + data SymmetrySym1 :: forall k (t :: k). forall (a :: Proxy t) -> ... + + Until GHC gains this syntax, this is the best alternative. + + (iii) When constructing each defunctionalization symbol, we will end up with + some remaining type variable binders and a return kind. For instance: + + data SymmetrySym1 (a :: Proxy (t :: k)) + :: forall ???. Proxy t + ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + ~> Type + + We must fill in the ??? part. Here is how we do so: + + (a) Collect all of the type variables mentioned in the return kind. + (b) Look up each type variable's corresponding type in the map (from + part (i)) to learn as much kind information as possible. + (c) Perform a reverse topological sort on these types to put the + types (and kind) variables in proper dependency order. + (d) Filter out any variables that are already bound by the type + variable binders that precede the return kind. + + After doing these steps, what remains goes in place of ???. Let's + explain this with the example above: + + data SymmetrySym1 (a :: Proxy (t :: k)) + :: forall ???. Proxy t + ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + ~> Type + + (a) [t, a, k, y] + (b) [(t :: k), (a :: Proxy t), k, (y :: Proxy t)] + (c) [k, (t :: k), (a :: Proxy t), (y :: Proxy t)] + (d) [(y :: Proxy t)] (`k`, `t` and `a` were already bound) + + Therefore, we end up with: + + data SymmetrySym1 (a :: Proxy (t :: k)) + :: forall (y :: Proxy t). + Proxy t + ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) + ~> Type +-} + +-- This is a small function with large importance. When generating +-- defunctionalization data types, we often need to fill in the blank in the +-- sort of code exemplified below: +-- +-- @ +-- data FooSym2 a (b :: x) (c :: TyFun y z) where +-- FooSym2KindInference :: _ +-- @ +-- +-- Where the kind of @a@ is not known. It's extremely tempting to just +-- copy-and-paste the type variable binders from the data type itself to the +-- constructor, like so: +-- +-- @ +-- data FooSym2 a (b :: x) (c :: TyFun y z) where +-- FooSym2KindInference :: forall a (b :: x) (c :: TyFun y z). +-- SameKind (...) (...). +-- FooSym2KindInference a b c +-- @ +-- +-- But this ends up being an untenable approach. Because @a@ lacks a kind +-- signature, @FooSym2@ does not have a complete, user-specified kind signature +-- (or CUSK), so GHC will fail to typecheck @FooSym2KindInference@. +-- +-- Thankfully, there's a workaround—just don't give any of the constructor's +-- type variable binders any kinds: +-- +-- @ +-- data FooSym2 a (b :: x) (c :: TyFun y z) where +-- FooSym2KindInference :: forall a b c +-- SameKind (...) (...). +-- FooSym2KindInference a b c +-- @ +-- +-- GHC may be moody when it comes to CUSKs, but it's at least understanding +-- enough to typecheck this without issue. The 'dropTvbKind' function is +-- what removes the kinds used in the kind inference constructor. +dropTvbKind :: DTyVarBndr -> DTyVarBndr +dropTvbKind tvb@(DPlainTV {}) = tvb +dropTvbKind (DKindedTV n _) = DPlainTV n + +-- Shorthand for building (k1 ~> k2) +buildTyFunArrow :: DKind -> DKind -> DKind +buildTyFunArrow k1 k2 = DConT tyFunArrowName `DAppT` k1 `DAppT` k2 + +buildTyFunArrow_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind +buildTyFunArrow_maybe m_k1 m_k2 = do + k1 <- m_k1 + k2 <- m_k2 + return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2 + +-- Build (~>) kind from the list of kinds ravelTyFun :: [DKind] -> DKind ravelTyFun [] = error "Internal error: TyFun raveling nil" ravelTyFun [k] = k -ravelTyFun kinds = go tailK (buildTyFun k2 k1) +ravelTyFun kinds = go tailK (buildTyFunArrow k2 k1) where (k1 : k2 : tailK) = reverse kinds - go [] acc = addStar acc - go (k:ks) acc = go ks (buildTyFun k (addStar acc)) + go [] acc = acc + go (k:ks) acc = go ks (buildTyFunArrow k acc) + +{- +Note [Fixity declarations for defunctionalization symbols] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Just like we promote fixity declarations, we should also generate fixity +declarations for defunctionaliztion symbols. A primary use case is the +following scenario: + + (.) :: (b -> c) -> (a -> b) -> (a -> c) + (f . g) x = f (g x) + infixr 9 . + +One often writes (f . g . h) at the value level, but because (.) is promoted +to a type family with three arguments, this doesn't directly translate to the +type level. Instead, one must write this: + + f .@#@$$$ g .@#@$$$ h + +But in order to ensure that this associates to the right as expected, one must +generate an `infixr 9 .@#@#$$$` declaration. This is why defunctionalize accepts +a Maybe Fixity argument. +-} 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 @@ -15,13 +15,15 @@ module Data.Singletons.Promote.Monad ( PrM, promoteM, promoteM_, promoteMDecs, VarPromotions, allLocals, emitDecs, emitDecsM, - lambdaBind, LetBind, letBind, lookupVarE + lambdaBind, LetBind, letBind, lookupVarE, forallBind, allBoundKindVars ) where import Control.Monad.Reader import Control.Monad.Writer import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) +import qualified Data.Set as Set +import Data.Set ( Set ) import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar import Data.Singletons.Names @@ -34,12 +36,14 @@ data PrEnv = PrEnv { pr_lambda_bound :: Map Name Name , pr_let_bound :: LetExpansions + , pr_forall_bound :: Set Name -- See Note [Explicitly quantifying kinds variables] , pr_local_decls :: [Dec] } emptyPrEnv :: PrEnv emptyPrEnv = PrEnv { pr_lambda_bound = Map.empty , pr_let_bound = Map.empty + , pr_forall_bound = Set.empty , pr_local_decls = [] } -- the promotion monad @@ -94,6 +98,18 @@ Just ty -> return ty Nothing -> return $ promoteValRhs n +-- Add to the set of bound kind variables currently in scope. +-- See Note [Explicitly binding kind variables] +forallBind :: Set Name -> PrM a -> PrM a +forallBind kvs1 = + local (\env@(PrEnv { pr_forall_bound = kvs2 }) -> + env { pr_forall_bound = kvs1 `Set.union` kvs2 }) + +-- Look up the set of bound kind variables currently in scope. +-- See Note [Explicitly binding kind variables] +allBoundKindVars :: PrM (Set Name) +allBoundKindVars = asks pr_forall_bound + promoteM :: DsMonad q => [Dec] -> PrM a -> q (a, [DDec]) promoteM locals (PrM rdr) = do other_locals <- localDeclarations @@ -111,3 +127,62 @@ promoteMDecs locals thing = do (decs1, decs2) <- promoteM locals thing return $ decs1 ++ decs2 + +{- +Note [Explicitly binding kind variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want to ensure that when we single type signatures for functions, we should +explicitly quantify every kind variable bound by a forall. For example, if we +were to single the identity function: + + identity :: forall a. a -> a + identity x = x + +We want the final result to be: + + sIdentity :: forall a (x :: a). Sing x -> Sing (Identity x) + sIdentity sX = sX + +Accomplishing this takes a bit of care during promotion. When promoting a +function, we determine what set of kind variables are currently bound at that +point and store them in an ALetDecEnv (as lde_bound_kvs), which in turn is +singled. Then, during singling, we extract every kind variable in a singled +type signature, subtract the lde_bound_kvs, and explicitly bind the variables +that remain. + +For a top-level function like identity, lde_bound_kvs is the empty set. But +consider this more complicated example: + + f :: forall a. a -> a + f = g + where + g :: a -> a + g x = x + +When singling, we would eventually end up in this spot: + + sF :: forall a (x :: a). Sing a -> Sing (F a) + sF = sG + where + sG :: _ + sG x = x + +We must make sure /not/ to fill in the following type for _: + + sF :: forall a (x :: a). Sing a -> Sing (F a) + sF = sG + where + sG :: forall a (y :: a). Sing a -> Sing (G a) + sG x = x + +This would be incorrect, as the `a` bound by sF /must/ be the same one used in +sG, as per the scoping of the original `f` function. Thus, we ensure that the +bound variables from `f` are put into lde_bound_kvs when promoting `g` so +that we subtract out `a` and are left with the correct result: + + sF :: forall a (x :: a). Sing a -> Sing (F a) + sF = sG + where + sG :: forall (y :: a). Sing a -> Sing (G a) + sG x = x +-} diff --git a/src/Data/Singletons/Promote/Type.hs b/src/Data/Singletons/Promote/Type.hs --- a/src/Data/Singletons/Promote/Type.hs +++ b/src/Data/Singletons/Promote/Type.hs @@ -41,16 +41,15 @@ return $ foldType (DSigT ty' ki) args go args (DVarT name) = return $ foldType (DVarT name) args go [] (DConT name) - | name == typeRepName = return DStarT - | name == stringName = return $ DConT symbolName - | nameBase name == nameBase repName = return DStarT + | name == typeRepName = return $ DConT typeKindName + | nameBase name == nameBase repName = return $ DConT typeKindName go args (DConT name) | Just n <- unboxedTupleNameDegree_maybe name = return $ foldType (DConT (tupleTypeName n)) args | otherwise = return $ foldType (DConT name) args - go [k1, k2] DArrowT = return $ addStar (DConT tyFunName `DAppT` k1 `DAppT` k2) - go _ (DLitT _) = fail "Cannot promote a type-level literal" + go [k1, k2] DArrowT = return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2 + go _ ty@DLitT{} = pure ty go args hd = fail $ "Illegal Haskell construct encountered:\n" ++ "headed by: " ++ show hd ++ "\n" ++ diff --git a/src/Data/Singletons/ShowSing.hs b/src/Data/Singletons/ShowSing.hs --- a/src/Data/Singletons/ShowSing.hs +++ b/src/Data/Singletons/ShowSing.hs @@ -1,9 +1,12 @@ -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -12,75 +15,79 @@ -- Module : Data.Singletons.ShowSing -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- --- Defines the class 'ShowSing', allowing for conversion of 'Sing' values to --- readable 'String's. +-- Defines the class 'ShowSing' type synonym, which is useful for defining +-- 'Show' instances for singleton types. -- ---------------------------------------------------------------------------- module Data.Singletons.ShowSing ( - -- * The 'ShowSing' class - ShowSing(..), + -- * The 'ShowSing' type + ShowSing ) where +import Data.Kind 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 -------------------------------------------------------- ----------------------------------------------------------------------- +import qualified GHC.TypeNats as TN --- | Members of the 'ShowSing' kind class can have their 'Sing' values --- converted to 'String's in a fashion similar to that of the 'Show' class. --- (In fact, this class only exists because one cannot write 'Show' instances --- for 'Sing's of the form --- @instance (forall z. Show (Sing (z :: k))) => Show (Sing (x :: [k]))@.) +-- | In addition to the promoted and singled versions of the 'Show' class that +-- @singletons@ provides, it is also useful to be able to directly define +-- 'Show' instances for singleton types themselves. Doing so is almost entirely +-- straightforward, as a derived 'Show' instance does 90 percent of the work. +-- The last 10 percent—getting the right instance context—is a bit tricky, and +-- that's where 'ShowSing' comes into play. -- --- This class should not be confused with the promoted or singled versions of --- 'Show' from "Data.Singletons.Prelude.Show" (@PShow@ and @SShow@, respectively). --- The output of 'ShowSing' is intended to reflect the singleton type, whereas --- the output of @PShow@ and @SShow@ reflects the original type. That is, showing --- @SFalse@ with 'ShowSing' would yield @\"SFalse\"@, whereas @PShow@ and @SShow@ --- would yield @\"False\"@. +-- As an example, let's consider the singleton type for lists. We want to write +-- an instance with the following shape: -- --- Instances of this class are generated alongside singleton definitions for --- datatypes that derive a 'Show' instance. Moreover, having a 'ShowSing' --- instances makes it simple to define a 'Show' instance. For instance: +-- @ +-- deriving instance ??? => Show (Sing (x :: [k])) +-- @ -- +-- To figure out what should go in place of @???@, observe that we require the +-- type of each field to also be 'Show' instances. In other words, we need +-- something like @(Show (Sing (a :: k)))@. But this isn't quite right, as the +-- type variable @a@ doesn't appear in the instance head. In fact, this @a@ +-- type is really referring to an existentially quantified type variable in the +-- 'SCons' constructor, so it doesn't make sense to try and use it like this. +-- +-- Luckily, the @QuantifiedConstraints@ language extension provides a solution +-- to this problem. This lets you write a context of the form +-- @(forall a. Show (Sing (a :: k)))@, which demands that there be an instance +-- for @Show (Sing (a :: k))@ that is parametric in the use of @a@. Thus, our +-- final instance looks like: +-- -- @ --- instance 'ShowSing' a => 'ShowSing' [a] where --- 'showsSingPrec' = ... --- instance 'ShowSing' a => 'Show' ('Sing' (x :: [a])) where --- 'showsPrec' = 'showsSingPrec' +-- deriving instance (forall a. Show (Sing (a :: k))) => Show (Sing (x :: [k])) -- @ -- --- 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). +-- Because that quantified constraint is somewhat lengthy, we provide the +-- 'ShowSing' type synonym as a convenient shorthand. Thus, the above instance +-- is equivalent to: -- --- To recap: 'singletons' will give you all of these for a datatype that derives --- a 'Show' instance: +-- @ +-- deriving instance ShowSing k => Show (Sing (x :: [k])) +-- @ -- +-- When singling a derived 'Show' instance, @singletons@ will also derive +-- a 'Show' instance for the corresponding singleton type using 'ShowSing'. +-- In other words, if you give @singletons@ a derived 'Show' instance, then +-- you'll receive the following in return: +-- -- * A promoted (@PShow@) instance -- * A singled (@SShow@) instance --- * A '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 +type ShowSing k = (forall z. Show (Sing (z :: k)) :: Constraint) ------------------------------------------------------------ -- TypeLits instances @@ -92,23 +99,19 @@ -- 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 +instance Show (SNat n) where + showsPrec 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 +instance Show (SSymbol s) where + showsPrec p s@SSym = showParen (p > appPrec) ( showString "SSym @" . showsPrec appPrec1 (symbolVal s) ) -instance Show (SSymbol s) where - showsPrec = showsSingPrec ------------------------------------------------------------ -- Template Haskell-generated instances diff --git a/src/Data/Singletons/Sigma.hs b/src/Data/Singletons/Sigma.hs --- a/src/Data/Singletons/Sigma.hs +++ b/src/Data/Singletons/Sigma.hs @@ -1,17 +1,20 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# 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) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -23,10 +26,14 @@ ( Sigma(..), Σ , projSigma1, projSigma2 , mapSigma, zipSigma + + -- * Defunctionalization symbols + , ΣSym0, ΣSym1, ΣSym2 ) where -import Data.Kind +import Data.Kind (Type) import Data.Singletons.Internal +import Data.Singletons.Promote -- | A dependent pair. data Sigma (s :: Type) :: (s ~> Type) -> Type where @@ -35,8 +42,6 @@ -- | 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 @@ -66,3 +71,5 @@ -> Sigma a p -> Sigma b q -> Sigma c r zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) = (f @@ a @@ b) :&: (g @fstA @fstB p q) + +$(genDefunSymbols [''Σ]) 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 @@ -12,20 +12,23 @@ 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.Deriving.Infer import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum import Data.Singletons.Deriving.Show +import Data.Singletons.Deriving.Util import Data.Singletons.Util import Data.Singletons.Promote +import Data.Singletons.Promote.Defun import Data.Singletons.Promote.Monad ( promoteM ) import Data.Singletons.Promote.Type import Data.Singletons.Names import Data.Singletons.Single.Monad import Data.Singletons.Single.Type import Data.Singletons.Single.Data +import Data.Singletons.Single.Defun import Data.Singletons.Single.Fixity import Data.Singletons.Single.Eq import Data.Singletons.Syntax @@ -34,6 +37,8 @@ import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import Data.Maybe +import qualified Data.Set as Set +import Data.Set ( Set ) import Control.Monad import Data.List import qualified GHC.LanguageExtensions.Type as LangExt @@ -81,7 +86,7 @@ genSingletons :: DsMonad q => [Name] -> q [Dec] genSingletons names = do checkForRep names - ddecs <- concatMapM (singInfo <=< dsInfo <=< reifyWithWarning) names + ddecs <- concatMapM (singInfo <=< dsInfo <=< reifyWithLocals) names return $ decsToTH ddecs -- | Make promoted and singleton versions of all declarations given, retaining @@ -91,8 +96,9 @@ singletons :: DsMonad q => q [Dec] -> q [Dec] singletons qdecs = do decs <- qdecs - singDecs <- wrapDesugar singTopLevelDecs decs - return (decs ++ singDecs) + ddecs <- withLocalDeclarations decs $ dsDecs decs + singDecs <- singTopLevelDecs decs ddecs + return (decs ++ decsToTH singDecs) -- | Make promoted and singleton versions of all declarations given, discarding -- the original declarations. Note that a singleton based on a datatype needs @@ -136,7 +142,8 @@ (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ show className ++ " for it.") name dtvbs <- mapM dsTvb tvbs - dcons <- concatMapM dsCon cons + let data_ty = foldTypeTvbs (DConT name) dtvbs + dcons <- concatMapM (dsCon dtvbs data_ty) cons let tyvars = map (DVarT . extractTvbName) dtvbs kind = foldType (DConT name) tyvars (scons, _) <- singM [] $ mapM singCtor dcons @@ -171,7 +178,7 @@ -- -- (Not to be confused with 'showShowInstance'.) singShowInstance :: DsMonad q => Name -> q [Dec] -singShowInstance = singInstance (mkShowInstance ForPromotion) "Show" +singShowInstance = singInstance mkShowInstance "Show" -- | Create instances of 'SShow' for the given types -- @@ -179,40 +186,39 @@ singShowInstances :: DsMonad q => [Name] -> q [Dec] singShowInstances = concatMapM singShowInstance --- | Create instance of 'ShowSing' for the given type +-- | Create instance of 'Show' for the given singleton 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 + (tvbs, cons) <- getDataD ("I cannot make an instance of Show for it.") name dtvbs <- mapM dsTvb tvbs - dcons <- concatMapM dsCon cons - let tyvars = map (DVarT . extractTvbName) dtvbs - kind = foldType (DConT name) tyvars + let data_ty = foldTypeTvbs (DConT name) dtvbs + dcons <- concatMapM (dsCon dtvbs data_ty) cons + let tyvars = map (DVarT . extractTvbName) dtvbs + kind = foldType (DConT name) tyvars + data_decl = DataDecl name dtvbs dcons deriv_show_decl = DerivedDecl { ded_mb_cxt = Nothing , ded_type = kind - , ded_cons = dcons } + , ded_decl = data_decl } (show_insts, _) <- singM [] $ singDerivedShowDecs deriv_show_decl pure $ decsToTH show_insts --- | Create instances of 'ShowSing' for the given types +-- | Create instances of 'Show' for the given singleton types -- -- (Not to be confused with 'singShowInstances'.) showSingInstances :: DsMonad q => [Name] -> q [Dec] showSingInstances = concatMapM showSingInstance -singInstance :: DsMonad q - => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl) - -> String -> Name -> q [Dec] +singInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec] singInstance mk_inst inst_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ inst_name ++ " for it.") name dtvbs <- mapM dsTvb tvbs - dcons <- concatMapM dsCon cons - raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType dtvbs)) dcons + let data_ty = foldTypeTvbs (DConT name) dtvbs + dcons <- concatMapM (dsCon dtvbs data_ty) cons + let data_decl = DataDecl name dtvbs dcons + raw_inst <- mk_inst Nothing data_ty data_decl (a_inst, decs) <- promoteM [] $ promoteInstanceDec Map.empty raw_inst decs' <- singDecsM [] $ (:[]) <$> singInstD a_inst @@ -233,14 +239,18 @@ singTopLevelDecs :: DsMonad q => [Dec] -> [DDec] -> q [DDec] singTopLevelDecs locals raw_decls = withLocalDeclarations locals $ do decls <- expand raw_decls -- expand type synonyms - PDecs { pd_let_decs = letDecls - , pd_class_decs = classes - , pd_instance_decs = insts - , pd_data_decs = datas - , pd_derived_eq_decs = derivedEqDecs - , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls + PDecs { pd_let_decs = letDecls + , pd_class_decs = classes + , pd_instance_decs = insts + , pd_data_decs = datas + , pd_ty_syn_decs = ty_syns + , pd_open_type_family_decs = o_tyfams + , pd_closed_type_family_decs = c_tyfams + , pd_derived_eq_decs = derivedEqDecs + , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls ((letDecEnv, classes', insts'), promDecls) <- promoteM locals $ do + defunTypeDecls ty_syns c_tyfams o_tyfams promoteDataDecs datas (_, letDecEnv) <- promoteLetDecs noPrefix letDecls classes' <- mapM promoteClassDec classes @@ -252,7 +262,8 @@ singDecsM locals $ do let letBinds = concatMap buildDataLets datas ++ concatMap buildMethLets classes - (newLetDecls, newDecls) <- bindLets letBinds $ + (newLetDecls, singIDefunDecls, newDecls) + <- bindLets letBinds $ singLetDecEnv letDecEnv $ do newDataDecls <- concatMapM singDataD datas newClassDecls <- mapM singClassD classes' @@ -263,11 +274,11 @@ ++ newInstDecls ++ newDerivedEqDecs ++ newDerivedShowDecs - return $ promDecls ++ (map DLetDec newLetDecls) ++ newDecls + return $ promDecls ++ (map DLetDec newLetDecls) ++ singIDefunDecls ++ newDecls -- see comment at top of file buildDataLets :: DataDecl -> [(Name, DExp)] -buildDataLets (DataDecl _nd _name _tvbs cons _derivings) = +buildDataLets (DataDecl _name _tvbs cons) = concatMap con_num_args cons where con_num_args :: DCon -> [(Name, DExp)] @@ -298,38 +309,43 @@ , cd_name = cls_name , cd_tvbs = cls_tvbs , cd_fds = cls_fundeps - , cd_lde = LetDecEnv { lde_defns = default_defns - , lde_types = meth_sigs - , lde_infix = fixities - , lde_proms = promoted_defaults } }) = do - (sing_sigs, _, tyvar_names, res_kis) - <- unzip4 <$> zipWithM (singTySig no_meth_defns meth_sigs) - meth_names (map promoteValRhs meth_names) - let default_sigs = catMaybes $ zipWith3 mk_default_sig meth_names sing_sigs res_kis - res_ki_map = Map.fromList (zip meth_names - (map (fromMaybe always_sig) res_kis)) - sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names) - res_ki_map)) - (Map.toList default_defns) - fixities' <- traverse (uncurry singInfixDecl) fixities - cls_cxt' <- mapM singPred cls_cxt - return $ DClassD cls_cxt' - (singClassName cls_name) - cls_tvbs - cls_fundeps -- they are fine without modification - (map DLetDec (sing_sigs ++ sing_meths ++ fixities') ++ default_sigs) + , cd_lde = LetDecEnv { lde_defns = default_defns + , lde_types = meth_sigs + , lde_infix = fixities + , lde_proms = promoted_defaults + , lde_bound_kvs = meth_bound_kvs } }) = + bindContext [foldPredTvbs (DConPr cls_name) cls_tvbs] $ do + (sing_sigs, _, tyvar_names, cxts, res_kis, singIDefunss) + <- unzip6 <$> zipWithM (singTySig no_meth_defns meth_sigs meth_bound_kvs) + meth_names (map promoteValRhs meth_names) + emitDecs $ concat singIDefunss + let default_sigs = catMaybes $ + zipWith4 mk_default_sig meth_names sing_sigs tyvar_names res_kis + res_ki_map = Map.fromList (zip meth_names + (map (fromMaybe always_sig) res_kis)) + sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names) + (Map.fromList cxts) + res_ki_map)) + (Map.toList default_defns) + fixities' <- traverse (uncurry singInfixDecl) $ Map.toList fixities + cls_cxt' <- mapM singPred cls_cxt + return $ DClassD cls_cxt' + (singClassName cls_name) + cls_tvbs + cls_fundeps -- they are fine without modification + (map DLetDec (sing_sigs ++ sing_meths ++ fixities') ++ default_sigs) where no_meth_defns = error "Internal error: can't find declared method type" always_sig = error "Internal error: no signature for default method" meth_names = Map.keys meth_sigs - mk_default_sig meth_name (DSigD s_name sty) (Just res_ki) = - DDefaultSigD s_name <$> add_constraints meth_name sty res_ki - mk_default_sig _ _ _ = error "Internal error: a singled signature isn't a signature." + mk_default_sig meth_name (DSigD s_name sty) bound_kvs (Just res_ki) = + DDefaultSigD s_name <$> add_constraints meth_name sty bound_kvs res_ki + mk_default_sig _ _ _ _ = error "Internal error: a singled signature isn't a signature." - add_constraints meth_name sty res_ki = do -- Maybe monad + add_constraints meth_name sty (_, bound_kvs) res_ki = do -- Maybe monad prom_dflt <- Map.lookup meth_name promoted_defaults - let default_pred = foldl DAppPr (DConPr equalityName) + let default_pred = foldPred (DConPr equalityName) -- NB: Need the res_ki here to prevent ambiguous -- kinds in result-inferred default methods. -- See #175 @@ -338,19 +354,37 @@ return $ DForallT tvbs (default_pred : cxt) (ravel args res) where (tvbs, cxt, args, res) = unravel sty - tvs = map tvbToType tvbs + bound_kv_set = Set.fromList bound_kvs + -- Filter out explicitly bound kind variables. Otherwise, if you had + -- the following class (#312): + -- + -- class Foo a where + -- bar :: a -> b -> b + -- bar _ x = x + -- + -- Then it would be singled to: + -- + -- class SFoo a where + -- sBar :: forall b (x :: a) (y :: b). Sing x -> Sing y -> Sing (sBar x y) + -- default :: forall b (x :: a) (y :: b). + -- (Bar b x y) ~ (BarDefault b x y) => ... + -- + -- Which applies Bar/BarDefault to b, which shouldn't happen. + tvs = map tvbToType $ + filter (\tvb -> extractTvbName tvb `Set.member` bound_kv_set) tvbs singInstD :: AInstDecl -> SgM DDec -singInstD (InstDecl { id_cxt = cxt, id_name = inst_name - , id_arg_tys = inst_tys, id_meths = ann_meths }) = do - cxt' <- mapM singPred cxt - inst_kis <- mapM promoteType inst_tys - meths <- concatMapM (uncurry sing_meth) ann_meths - return (DInstanceD Nothing - cxt' - (foldl DAppT (DConT s_inst_name) inst_kis) - meths) +singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys + , id_sigs = inst_sigs, id_meths = ann_meths }) = do + bindContext cxt $ do + cxt' <- mapM singPred cxt + inst_kis <- mapM promoteType inst_tys + meths <- concatMapM (uncurry sing_meth) ann_meths + return (DInstanceD Nothing + cxt' + (foldl DAppT (DConT s_inst_name) inst_kis) + meths) where s_inst_name = singClassName inst_name @@ -358,78 +392,139 @@ sing_meth :: Name -> ALetDecRHS -> SgM [DDec] sing_meth name rhs = do mb_s_info <- dsReify (singValName name) - (s_ty, tyvar_names, m_res_ki) <- case mb_s_info of - Just (DVarI _ (DForallT cls_tvbs _cls_pred s_ty) _) -> do - let (sing_tvbs, _pred, _args, res_ty) = unravel s_ty - inst_kis <- mapM promoteType inst_tys - let subst = Map.fromList (zip (map extractTvbName cls_tvbs) - inst_kis) - m_res_ki = case res_ty of - _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki) - _ -> Nothing + inst_kis <- mapM promoteType inst_tys + let mk_subst cls_tvbs = Map.fromList $ zip (map extractTvbName vis_cls_tvbs) inst_kis + where + -- This is a half-hearted attempt to address the underlying problem + -- in #358, where we can sometimes have more class type variables + -- (due to implicit kind arguments) than class arguments. This just + -- ensures that the explicit type variables are properly mapped + -- to the class arguments, leaving the implicit kind variables + -- unmapped. That could potentially cause *other* problems, but + -- those are perhaps best avoided by using InstanceSigs. At the + -- very least, this workaround will make error messages slightly + -- less confusing. + vis_cls_tvbs = drop (length cls_tvbs - length inst_kis) cls_tvbs - return (substType subst s_ty, map extractTvbName sing_tvbs, m_res_ki) - _ -> do - mb_info <- dsReify name - case mb_info of - Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do - let subst = Map.fromList (zip (map extractTvbName cls_tvbs) - inst_tys) - -- Make sure to expand through type synonyms here! Not doing so - -- resulted in #167. - raw_ty <- expand inner_ty - (s_ty, _num_args, tyvar_names, res_ki) <- singType (promoteValRhs name) - (substType subst raw_ty) - return (s_ty, tyvar_names, Just res_ki) - _ -> fail $ "Cannot find type of method " ++ show name + sing_meth_ty :: Set Name -> DType + -> SgM (DType, [Name], DCxt, DKind) + sing_meth_ty bound_kvs inner_ty = do + -- Make sure to expand through type synonyms here! Not doing so + -- resulted in #167. + raw_ty <- expand inner_ty + (s_ty, _num_args, tyvar_names, ctxt, _arg_kis, res_ki) + <- singType bound_kvs (promoteValRhs name) raw_ty + pure (s_ty, tyvar_names, ctxt, res_ki) + (s_ty, tyvar_names, ctxt, m_res_ki) <- case Map.lookup name inst_sigs of + Just inst_sig -> do + -- We have an InstanceSig, so just single that type. Take care to + -- avoid binding the variables bound by the instance head as well. + let inst_bound = foldMap (fvDType . predToType) cxt <> foldMap fvDType inst_kis + (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty inst_bound inst_sig + pure (s_ty, tyvar_names, ctxt, Just res_ki) + Nothing -> case mb_s_info of + -- We don't have an InstanceSig, so we must compute the type to use + -- in the singled instance ourselves through reification. + Just (DVarI _ (DForallT cls_tvbs _cls_pred s_ty) _) -> do + let subst = mk_subst cls_tvbs + (sing_tvbs, ctxt, _args, res_ty) = unravel s_ty + m_res_ki = case res_ty of + _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki) + _ -> Nothing + + pure ( substType subst s_ty + , map extractTvbName sing_tvbs + , map (substPred subst) ctxt + , m_res_ki ) + _ -> do + mb_info <- dsReify name + case mb_info of + Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do + let subst = mk_subst cls_tvbs + cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) cls_tvbs + cls_tvb_names = Set.fromList $ map extractTvbName cls_tvbs + cls_bound = cls_kvb_names `Set.union` cls_tvb_names + (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty cls_bound inner_ty + pure ( substType subst s_ty + , tyvar_names + , ctxt + , Just (substKind subst res_ki) ) + _ -> fail $ "Cannot find type of method " ++ show name + let kind_map = maybe Map.empty (Map.singleton name) m_res_ki meth' <- singLetDecRHS (Map.singleton name tyvar_names) + (Map.singleton name ctxt) kind_map name rhs return $ map DLetDec [DSigD (singValName name) s_ty, meth'] -singLetDecEnv :: ALetDecEnv -> SgM a -> SgM ([DLetDec], a) -singLetDecEnv (LetDecEnv { lde_defns = defns - , lde_types = types - , lde_infix = infix_decls - , lde_proms = proms }) +singLetDecEnv :: ALetDecEnv + -> SgM a + -> SgM ([DLetDec], [DDec], a) + -- Return: + -- + -- 1. The singled let-decs + -- 2. SingI instances for any defunctionalization symbols + -- (see Data.Singletons.Single.Defun) + -- 3. The result of running the `SgM a` action +singLetDecEnv (LetDecEnv { lde_defns = defns + , lde_types = types + , lde_infix = infix_decls + , lde_proms = proms + , lde_bound_kvs = bound_kvs }) thing_inside = do let prom_list = Map.toList proms - (typeSigs, letBinds, tyvarNames, res_kis) - <- unzip4 <$> mapM (uncurry (singTySig defns types)) prom_list - infix_decls' <- traverse (uncurry singInfixDecl) infix_decls + (typeSigs, letBinds, tyvarNames, cxts, res_kis, singIDefunss) + <- unzip6 <$> mapM (uncurry (singTySig defns types bound_kvs)) prom_list + infix_decls' <- traverse (uncurry singInfixDecl) $ Map.toList infix_decls let res_ki_map = Map.fromList [ (name, res_ki) | ((name, _), Just res_ki) <- zip prom_list res_kis ] bindLets letBinds $ do - let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames) res_ki_map)) + let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames) + (Map.fromList cxts) + res_ki_map)) (Map.toList defns) thing <- thing_inside - return (infix_decls' ++ typeSigs ++ let_decs, thing) + return (infix_decls' ++ typeSigs ++ let_decs, concat singIDefunss, thing) singTySig :: Map Name ALetDecRHS -- definitions -> Map Name DType -- type signatures + -> Map Name (Set Name) -- bound kind variables -> Name -> DType -- the type is the promoted type, not the type sig! -> SgM ( DLetDec -- the new type signature , (Name, DExp) -- the let-bind entry , (Name, [Name]) -- the scoped tyvar names in the tysig + , (Name, DCxt) -- the context of the type signature , Maybe DKind -- the result kind in the tysig + , [DDec] -- SingI instances for defun symbols ) -singTySig defns types name prom_ty = +singTySig defns types bound_kvs name prom_ty = let sName = singValName name in case Map.lookup name types of Nothing -> do num_args <- guess_num_args (sty, tyvar_names) <- mk_sing_ty num_args + singIDefuns <- singDefuns name VarName [] + (map (const Nothing) tyvar_names) Nothing return ( DSigD sName sty , (name, wrapSingFun num_args prom_ty (DVarE sName)) , (name, tyvar_names) - , Nothing ) + , (name, []) + , Nothing + , singIDefuns ) Just ty -> do - (sty, num_args, tyvar_names, res_ki) <- singType prom_ty ty + all_bound_kvs <- lookup_bound_kvs + (sty, num_args, tyvar_names, ctxt, arg_kis, res_ki) + <- singType all_bound_kvs prom_ty ty + bound_cxt <- askContext + singIDefuns <- singDefuns name VarName (bound_cxt ++ ctxt) + (map Just arg_kis) (Just res_ki) return ( DSigD sName sty , (name, wrapSingFun num_args prom_ty (DVarE sName)) , (name, tyvar_names) - , Just res_ki ) + , (name, ctxt) + , Just res_ki + , singIDefuns ) where guess_num_args :: SgM Int guess_num_args = @@ -438,6 +533,13 @@ Just (AValue _ n _) -> return n Just (AFunction _ n _) -> return n + lookup_bound_kvs :: SgM (Set Name) + lookup_bound_kvs = + case Map.lookup name bound_kvs of + Nothing -> fail $ "Internal error: " ++ nameBase name ++ " has no type variable " + ++ "bindings, despite having a type signature" + Just kvs -> pure kvs + -- create a Sing t1 -> Sing t2 -> ... type of a given arity and result type mk_sing_ty :: Int -> SgM (DType, [Name]) mk_sing_ty n = do @@ -449,19 +551,24 @@ , arg_names ) singLetDecRHS :: Map Name [Name] + -> Map Name DCxt -- the context of the type signature + -- (might not be known) -> Map Name DKind -- result kind (might not be known) -> Name -> ALetDecRHS -> SgM DLetDec -singLetDecRHS _bound_names res_kis name (AValue prom num_arrows exp) = - DValD (DVarPa (singValName name)) <$> - (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis)) -singLetDecRHS bound_names res_kis name (AFunction prom_fun num_arrows clauses) = - let tyvar_names = case Map.lookup name bound_names of - Nothing -> [] - Just ns -> ns - res_ki = Map.lookup name res_kis - in - DFunD (singValName name) <$> - mapM (singClause prom_fun num_arrows tyvar_names res_ki) clauses +singLetDecRHS bound_names cxts res_kis name ld_rhs = + bindContext (Map.findWithDefault [] name cxts) $ + case ld_rhs of + AValue prom num_arrows exp -> + DValD (DVarPa (singValName name)) <$> + (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis)) + AFunction prom_fun num_arrows clauses -> + let tyvar_names = case Map.lookup name bound_names of + Nothing -> [] + Just ns -> ns + res_ki = Map.lookup name res_kis + in + DFunD (singValName name) <$> + mapM (singClause prom_fun num_arrows tyvar_names res_ki) clauses singClause :: DType -- the promoted function -> Int -- the number of arrows in the type. If this is more @@ -480,7 +587,7 @@ fail $ "Function being promoted to " ++ (pprint (typeToTH prom_fun)) ++ " has too many arguments." - sPats <- mapM (singPat (Map.fromList var_proms)) pats + (sPats, sigPaExpsSigs) <- evalForPair $ mapM (singPat (Map.fromList var_proms)) pats sBody <- singExp exp res_ki -- when calling unSingFun, the promoted pats aren't in scope, so we use the -- bound_names instead @@ -488,32 +595,51 @@ -- this does eta-expansion. See comment at top of file. sBody' = wrapUnSingFun (num_arrows - length pats) (foldl apply prom_fun (map DVarT pattern_bound_names)) sBody - return $ DClause sPats sBody' + return $ DClause sPats $ mkSigPaCaseE sigPaExpsSigs sBody' singPat :: Map Name Name -- from term-level names to type-level names - -> DPat - -> SgM DPat -singPat _var_proms (DLitPa _lit) = - fail "Singling of literal patterns not yet supported" -singPat var_proms (DVarPa name) = do - tyname <- case Map.lookup name var_proms of - Nothing -> - fail "Internal error: unknown variable when singling pattern" - Just tyname -> return tyname - return $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname) -singPat var_proms (DConPa name pats) = do - pats' <- mapM (singPat var_proms) pats - return $ DConPa (singDataConName name) pats' -singPat var_proms (DTildePa pat) = do - qReportWarning - "Lazy pattern converted into regular pattern during singleton generation." - singPat var_proms pat -singPat var_proms (DBangPa pat) = do - pat' <- singPat var_proms pat - return $ DBangPa pat' -singPat _var_proms (DSigPa _pat _ty) = error "TODO: Handle SigPa. See Issue #183." -singPat _var_proms DWildPa = return DWildPa + -> ADPat + -> QWithAux SingDSigPaInfos SgM DPat +singPat var_proms = go + where + go :: ADPat -> QWithAux SingDSigPaInfos SgM DPat + go (ADLitPa _lit) = + fail "Singling of literal patterns not yet supported" + go (ADVarPa name) = do + tyname <- case Map.lookup name var_proms of + Nothing -> + fail "Internal error: unknown variable when singling pattern" + Just tyname -> return tyname + pure $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname) + go (ADConPa name pats) = DConPa (singDataConName name) <$> mapM go pats + go (ADTildePa pat) = do + qReportWarning + "Lazy pattern converted into regular pattern during singleton generation." + go pat + go (ADBangPa pat) = DBangPa <$> go pat + go (ADSigPa prom_pat pat ty) = do + pat' <- go pat + -- Normally, calling dPatToDExp would be dangerous, since it fails if the + -- supplied pattern contains any wildcard patterns. However, promotePat + -- (which produced the pattern we're passing into dPatToDExp) maintains + -- an invariant that any promoted pattern signatures will be free of + -- wildcard patterns in the underlying pattern. + -- See Note [Singling pattern signatures]. + addElement (dPatToDExp pat', DSigT prom_pat ty) + pure pat' + go ADWildPa = pure DWildPa +-- | If given a non-empty list of 'SingDSigPaInfos', construct a case expression +-- that brings singleton equality constraints into scope via pattern-matching. +-- See @Note [Singling pattern signatures]@. +mkSigPaCaseE :: SingDSigPaInfos -> DExp -> DExp +mkSigPaCaseE exps_with_sigs exp + | null exps_with_sigs = exp + | otherwise = + let (exps, sigs) = unzip exps_with_sigs + scrutinee = mkTupleDExp exps + pats = map (DSigPa DWildPa . DAppT (DConT singFamilyName)) sigs + in DCaseE scrutinee [DMatch (mkTupleDPat pats) exp] -- Note [Annotate case return type] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -539,6 +665,82 @@ -- calls. Specifically, DON'T do the applySing stuff. Just use sError, which -- has a custom type (Sing x -> a) anyway. +-- Note [Singling pattern signatures] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We want to single a pattern signature, like so: +-- +-- f :: Maybe a -> a +-- f (Just x :: Maybe a) = x +-- +-- Naïvely, one might expect this to single straightfowardly as: +-- +-- sF :: forall (z :: Maybe a). Sing z -> Sing (F z) +-- sF (SJust sX :: Sing (Just x :: Maybe a)) = sX +-- +-- But the way GHC typechecks patterns prevents this from working, as GHC won't +-- know that the type `z` is actually `Just x` until /after/ the entirety of +-- the `SJust sX` pattern has been typechecked. (See Trac #12018 for an +-- extended discussion on this topic.) +-- +-- To work around this design, we resort to a somewhat unsightly trick: +-- immediately after matching on all the patterns, we perform a case on every +-- pattern with a pattern signature, like so: +-- +-- sF :: forall (z :: Maybe a). Sing z -> Sing (F z) +-- sF (SJust sX :: Sing z) +-- = case (SJust sX :: Sing z) of +-- (_ :: Sing (Just x :: Maybe a)) -> sX +-- +-- Now GHC accepts the fact that `z` is `Just x`, and all is well. In order +-- to support this construction, the type of singPat is augmented with some +-- extra information in the form of SingDSigPaInfos: +-- +-- type SingDSigPaInfos = [(DExp, DType)] +-- +-- Where the DExps corresponds to the expressions we case on just after the +-- patterns (`SJust sX :: Sing x`, in the example above), and the DTypes +-- correspond to the singled pattern signatures to use in the case alternative +-- (`Sing (Just x :: Maybe a)` in the example above). singPat appends to the +-- list of SingDSigPaInfos whenever it processes a DSigPa (pattern signature), +-- and call sites can pass these SingDSigPaInfos to mkSigPaCaseE to construct a +-- case expression like the one featured above. +-- +-- Some interesting consequences of this design: +-- +-- 1. We must promote DPats to ADPats, a variation of DPat where the annotated +-- DSigPa counterpart, ADSigPa, stores the type that the original DPat was +-- promoted to. This is necessary since promoting the type might have +-- generated fresh variable names, so we need to be able to use the same +-- names when singling. +-- +-- 2. Also when promoting a DSigPa to an ADSigPa, we remove any wildcards from +-- the underlying pattern. To see why this is necessary, consider singling +-- this example: +-- +-- g (Just _ :: Maybe a) = "hi" +-- +-- This must single to something like this: +-- +-- sG (SJust _ :: Sing z) +-- = case (SJust _ :: Sing z) of +-- (_ :: Sing (Just _ :: Maybe a)) -> "hi" +-- +-- But `SJust _` is not a valid expression, and since the minimal th-desugar +-- AST lacks as-patterns, we can't replace it with something like +-- `sG x@(SJust _ :: Sing z) = case x of ...`. But even if the th-desugar +-- AST /did/ have as-patterns, we'd still be in trouble, as `Just _` isn't +-- a valid type without the use of -XPartialTypeSignatures, which isn't a +-- design we want to force upon others. +-- +-- We work around both issues by simply converting all wildcard patterns +-- from the pattern that has a signature. That means our example becomes: +-- +-- sG (SJust sWild :: Sing z) +-- = case (SJust sWild :: Sing z) of +-- (_ :: Sing (Just wild :: Maybe a)) -> "hi" +-- +-- And now everything is hunky-dory. + singExp :: ADExp -> Maybe DKind -- the kind of the expression, if known -> SgM DExp -- See Note [Why error is so special] @@ -571,16 +773,21 @@ -- See Note [Annotate case return type] DSigE <$> (DCaseE <$> singExp exp Nothing <*> mapM (singMatch res_ki) matches) <*> pure (singFamily `DAppT` (ret_ty `maybeSigT` res_ki)) -singExp (ADLetE env exp) res_ki = - uncurry DLetE <$> singLetDecEnv env (singExp exp res_ki) -singExp (ADSigE {}) _ = - fail "Singling of explicit type annotations not yet supported." +singExp (ADLetE env exp) res_ki = do + -- We intentionally discard the SingI instances for exp's defunctionalization + -- symbols, as we also do not generate the declarations for the + -- defunctionalization symbols in the first place during promotion. + (let_decs, _, exp') <- singLetDecEnv env $ singExp exp res_ki + pure $ DLetE let_decs exp' +singExp (ADSigE prom_exp exp ty) _ = do + exp' <- singExp exp (Just ty) + pure $ DSigE exp' $ DConT singFamilyName `DAppT` DSigT prom_exp ty -- See Note [DerivedDecl] singDerivedEqDecs :: DerivedEqDecl -> SgM [DDec] singDerivedEqDecs (DerivedDecl { ded_mb_cxt = mb_ctxt , ded_type = ty - , ded_cons = cons }) = do + , ded_decl = DataDecl _ _ cons }) = do (scons, _) <- singM [] $ mapM singCtor cons mb_sctxt <- mapM (mapM singPred) mb_ctxt kind <- promoteType ty @@ -609,35 +816,20 @@ 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 + , ded_decl = DataDecl _ _ cons }) = do z <- qNewName "z" - -- Next, the Show instance for the singleton type, like this: + -- Derive the Show instance for the singleton type, like this: -- - -- instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b)) where - -- showsPrec = showsSingPrec + -- deriving instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b)) -- -- Be careful: we want to generate an instance context that uses ShowSing, - -- not Show, because we are reusing the ShowSing instance. - show_cxt <- inferConstraintsDef (fmap (mkShowContext ForShowSing) mb_cxt) + -- not SShow. + show_cxt <- inferConstraintsDef (fmap mkShowSingContext 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 + let show_inst = DStandaloneDerivD Nothing show_cxt + (DConT showName `DAppT` (singFamily `DAppT` DSigT (DVarT z) ty)) + pure [show_inst] isException :: DExp -> Bool isException (DVarE n) = nameBase n == "sUndefined" @@ -655,9 +847,9 @@ singMatch :: Maybe DKind -- ^ the result kind, if known -> ADMatch -> SgM DMatch singMatch res_ki (ADMatch var_proms pat exp) = do - sPat <- singPat (Map.fromList var_proms) pat + (sPat, sigPaExpsSigs) <- evalForPair $ singPat (Map.fromList var_proms) pat sExp <- singExp exp res_ki - return $ DMatch sPat sExp + return $ DMatch sPat $ mkSigPaCaseE sigPaExpsSigs sExp singLit :: Lit -> SgM DExp singLit (IntegerL n) 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 @@ -12,6 +12,7 @@ import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax +import Data.Singletons.Single.Defun import Data.Singletons.Single.Monad import Data.Singletons.Single.Type import Data.Singletons.Single.Fixity @@ -20,12 +21,13 @@ import Data.Singletons.Names import Data.Singletons.Syntax import Control.Monad +import qualified Data.Set as Set +import Data.Set (Set) -- We wish to consider the promotion of "Rep" to be * -- not a promoted data constructor. singDataD :: DataDecl -> SgM [DDec] -singDataD (DataDecl _nd name tvbs ctors _derivings) = do - aName <- qNewName "z" +singDataD (DataDecl name tvbs ctors) = do let tvbNames = map extractTvbName tvbs k <- promoteType (foldType (DConT name) (map DVarT tvbNames)) ctors' <- mapM singCtor ctors @@ -58,13 +60,14 @@ , DLetDec $ DFunD toSingName (toSingClauses `orIfEmpty` [emptyToSingClause]) ] - -- e.g. type SNat = Sing :: Nat -> * - let kindedSynInst = + -- e.g. type SNat = (Sing :: Nat -> Type) + let kindedSingTy = DArrowT `DAppT` k `DAppT` DConT typeKindName + kindedSynInst = DTySynD (singTyConName name) [] - (singFamily `DSigT` (DArrowT `DAppT` k `DAppT` DStarT)) + (singFamily `DSigT` kindedSingTy) - return $ (DDataInstD Data [] singFamilyName [DSigT (DVarT aName) k] ctors' []) : + return $ (DDataInstD Data [] singFamilyName [] (Just kindedSingTy) ctors' []) : kindedSynInst : singKindInst : ctorFixities @@ -129,8 +132,8 @@ -- polymorphic constructors are handled just -- like monomorphic ones -- the polymorphism in -- the kind is automatic -singCtor (DCon _tvbs cxt name fields _rty) - | not (null (filter (not . isEqPred) cxt)) +singCtor (DCon _tvbs cxt name fields rty) + | not (null cxt) = fail "Singling of constrained constructors not yet supported" | otherwise = do @@ -141,11 +144,13 @@ indexNames <- mapM (const $ qNewName "n") types let indices = map DVarT indexNames kinds <- mapM promoteType types - args <- zipWithM buildArgType types indices - let tvbs = zipWith DKindedTV indexNames kinds + let bound_kvs = foldMap fvDType kinds + args <- zipWithM (buildArgType bound_kvs) types indices + rty' <- promoteType rty + let tvbs = map DPlainTV (Set.toList bound_kvs) ++ zipWith DKindedTV indexNames kinds kindedIndices = zipWith DSigT indices kinds - -- SingI instance + -- SingI instance for data constructor emitDecs [DInstanceD Nothing (map (DAppPr (DConPr singIName)) indices) @@ -153,6 +158,10 @@ (foldType pCon kindedIndices)) [DLetDec $ DValD (DVarPa singMethName) (foldExp sCon (map (const $ DVarE singMethName) types))]] + -- SingI instances for defunctionalization symbols. Note that we don't + -- support contexts in constructors at the moment, so it's fine for now to + -- just assume that the context is always (). + emitDecs =<< singDefuns name DataName [] (map Just kinds) (Just rty') let noBang = Bang NoSourceUnpackedness NoSourceStrictness conFields = case fields of @@ -165,15 +174,8 @@ [] sName conFields - (Just (DConT singFamilyName `DAppT` foldType pCon indices)) - where buildArgType :: DType -> DType -> SgM DType - buildArgType ty index = do - (ty', _, _, _) <- singType index ty + (DConT singFamilyName `DAppT` foldType pCon indices) + where buildArgType :: Set Name -> DType -> DType -> SgM DType + buildArgType bound_kvs ty index = do + (ty', _, _, _, _, _) <- singType bound_kvs index ty return ty' - - isEqPred :: DPred -> Bool - isEqPred (DAppPr f _) = isEqPred f - isEqPred (DSigPr p _) = isEqPred p - isEqPred (DVarPr _) = False - isEqPred (DConPr n) = n == equalityName - isEqPred DWildCardPr = False diff --git a/src/Data/Singletons/Single/Defun.hs b/src/Data/Singletons/Single/Defun.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/Single/Defun.hs @@ -0,0 +1,213 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Single.Defun +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Creates 'SingI' instances for promoted types' defunctionalization symbols. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Single.Defun (singDefuns) where + +import Data.List +import Data.Singletons.Names +import Data.Singletons.Promote.Defun +import Data.Singletons.Single.Monad +import Data.Singletons.Single.Type +import Data.Singletons.Util +import Language.Haskell.TH.Desugar +import Language.Haskell.TH.Syntax + +-- Given the Name of something, take the defunctionalization symbols for its +-- promoted counterpart and create SingI instances for them. As a concrete +-- example, if you have: +-- +-- foo :: Eq a => a -> a -> Bool +-- +-- Then foo's promoted counterpart, Foo, will have two defunctionalization +-- symbols: +-- +-- FooSym0 :: a ~> a ~> Bool +-- FooSym1 :: a -> a ~> Bool +-- +-- We can declare SingI instances for these two symbols like so: +-- +-- instance SEq a => SingI (FooSym0 :: a ~> a ~> Bool) where +-- sing = singFun2 sFoo +-- +-- instance (SEq a, SingI x) => SingI (FooSym1 x :: a ~> Bool) where +-- sing = singFun1 (sFoo (sing @_ @x)) +-- +-- Note that singDefuns takes Maybe DKinds for the promoted argument and result +-- types, in case we have an entity whose type needs to be inferred. +-- See Note [singDefuns and type inference]. +-- +-- Note that in the particular case of a data constructor, we actually generate +-- /two/ SingI instances partial application—one for the defunctionalization +-- symbol, and one for the data constructor placed inside TyCon{N}. +-- See Note [SingI instances for partially applied constructors]. +singDefuns :: Name -- The Name of the thing to promote. + -> NameSpace -- Whether the above Name is a value, data constructor, + -- or a type constructor. + -- See Note [SingI instances for partially applied constructors] + -> DCxt -- The type's context. + -> [Maybe DKind] -- The promoted argument types (if known). + -> Maybe DKind -- The promoted result type (if known). + -> SgM [DDec] +singDefuns n ns ty_ctxt mb_ty_args mb_ty_res = + case mb_ty_args of + [] -> pure [] -- If a function has no arguments, then it has no + -- defunctionalization symbols, so there's nothing to be done. + _ -> do sty_ctxt <- mapM singPred ty_ctxt + go 0 sty_ctxt [] mb_ty_args + where + num_ty_args :: Int + num_ty_args = length mb_ty_args + + -- Sadly, this algorithm is quadratic, because in each iteration of the loop + -- we must: + -- + -- * Construct an arrow type of the form (a ~> ... ~> z), using a suffix of + -- the promoted argument types. + -- * Append a new type variable to the end of an ordered list. + -- + -- In practice, this is unlikely to be a bottleneck, as singletons does not + -- support functions with more than 7 or so arguments anyways. + go :: Int -> DCxt -> [DTyVarBndr] -> [Maybe DKind] -> SgM [DDec] + go sym_num sty_ctxt tvbs mb_tyss + | sym_num < num_ty_args + , mb_ty:mb_tys <- mb_tyss + = do new_tvb_name <- qNewName "d" + let new_tvb = inferMaybeKindTV new_tvb_name mb_ty + insts <- go (sym_num + 1) sty_ctxt (tvbs ++ [new_tvb]) mb_tys + pure $ new_insts ++ insts + | otherwise + = pure [] + where + sing_fun_num :: Int + sing_fun_num = num_ty_args - sym_num + + mk_sing_fun_expr :: DExp -> DExp + mk_sing_fun_expr sing_expr = + foldl' (\f tvb_n -> f `DAppE` (DVarE singMethName `DAppTypeE` DVarT tvb_n)) + sing_expr + (map extractTvbName tvbs) + + singI_ctxt :: DCxt + singI_ctxt = map (DAppPr (DConPr singIName) . tvbToType) tvbs + + mk_inst_ty :: DType -> DType + mk_inst_ty inst_head + = case mb_inst_kind of + Just inst_kind -> inst_head `DSigT` inst_kind + Nothing -> inst_head + + tvb_tys :: [DType] + tvb_tys = map dTyVarBndrToDType tvbs + + -- Construct the arrow kind used to annotate the defunctionalization + -- symbol (e.g., the `a ~> a ~> Bool` in + -- `SingI (FooSym0 :: a ~> a ~> Bool)`). + -- If any of the argument kinds or result kind isn't known (i.e., is + -- Nothing), then we opt not to construct this arrow kind altogether. + -- See Note [singDefuns and type inference] + mb_inst_kind :: Maybe DType + mb_inst_kind = foldr buildTyFunArrow_maybe mb_ty_res mb_tyss + + new_insts :: [DDec] + new_insts + | DataName <- ns + = -- See Note [SingI instances for partially applied constructors] + let s_data_con = DConE $ singDataConName n in + [ mk_inst defun_inst_ty s_data_con + , mk_inst tycon_inst_ty s_data_con ] + | otherwise + = [mk_inst defun_inst_ty $ DVarE $ singValName n] + where + mk_inst :: DType -> DExp -> DDec + mk_inst inst_head sing_exp + = DInstanceD Nothing + (sty_ctxt ++ singI_ctxt) + (DConT singIName `DAppT` mk_inst_ty inst_head) + [DLetDec $ DValD (DVarPa singMethName) + $ wrapSingFun sing_fun_num inst_head + $ mk_sing_fun_expr sing_exp ] + + defun_inst_ty, tycon_inst_ty :: DType + defun_inst_ty = foldType (DConT (promoteTySym n sym_num)) tvb_tys + tycon_inst_ty = DConT (mkTyConName sing_fun_num) `DAppT` + foldType (DConT n) tvb_tys + +{- +Note [singDefuns and type inference] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following function: + + foo :: a -> Bool + foo _ = True + +singDefuns would give the following SingI instance for FooSym0, with an +explicit kind signature: + + instance SingI (FooSym0 :: a ~> Bool) where ... + +What happens if we leave off the type signature for foo? + + foo _ = True + +Can singDefuns still do its job? Yes! It will simply generate: + + instance SingI FooSym0 where ... + +In general, if any of the promoted argument or result types given to singDefun +are Nothing, then we avoid crafting an explicit kind signature. You might worry +that this could lead to SingI instances being generated that GHC cannot infer +the type for, such as: + + bar x = x == x + ==> + instance SingI BarSym0 -- Missing an SEq constraint? + +This is true, but also not unprecedented, as the singled version of bar, sBar, +will /also/ fail to typecheck due to a missing SEq constraint. Therefore, this +design choice fits within the existing tradition of type inference in +singletons. + +Note [SingI instances for partially applied constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unlike normal functions, where we generate one SingI instance for each of its +partial applications (one per defunctionalization symbol), we generate *two* +SingI instances for each partial application of a data constructor. That is, +if we have: + + data D a where + K :: a -> D a + +K has an partial application, so we will generate the following two SingI +instances: + + instance SingI KSym0 where sing = singFun1 SK + instance SingI (TyCon1 KSym0) where sing = singFun1 SK + +The first instance is exactly the same as what we'd generate for a normal, +partially applied function's defun symbol. The second one, while functionally +equivalent, is a bit dissatisfying: in general, adopting this approach means +that we end up generating many instances of the form: + + instance SingI (TyCon1 S1) + instance SingI (TyCon1 S2) + ... + +Ideally, we'd have a single instance SingI (TyCon1 s) to rule them all. But +doing so would require writing something akin to: + + instance (forall a. SingI a => SingI (f a)) => SingI (TyCon1 f) where + sing = SLambda $ \(x :: Sing a) -> withSingI x $ sing @_ @(f a) + +But this would require quantified constraints. Until GHC gains these, we +compensate by generating out several SingI (TyCon1 s) instances. +-} 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 @@ -7,8 +7,8 @@ import Data.Singletons.Names import Language.Haskell.TH.Desugar -singInfixDecl :: DsMonad q => Fixity -> Name -> q DLetDec -singInfixDecl fixity name = do +singInfixDecl :: DsMonad q => Name -> Fixity -> q DLetDec +singInfixDecl name fixity = do mb_ns <- reifyNameSpace name pure $ DInfixD fixity $ case mb_ns of @@ -24,7 +24,7 @@ mFixity <- qReifyFixity name case mFixity of Nothing -> pure [] - Just fixity -> sequenceA [DLetDec <$> singInfixDecl fixity name] + Just fixity -> sequenceA [DLetDec <$> singInfixDecl name fixity] 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 @@ -11,7 +11,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ParallelListComp, TemplateHaskell #-} module Data.Singletons.Single.Monad ( - SgM, bindLets, lookupVarE, lookupConE, + SgM, bindLets, bindContext, askContext, lookupVarE, lookupConE, wrapSingFun, wrapUnSingFun, singM, singDecsM, emitDecs, emitDecsM @@ -34,11 +34,13 @@ -- environment during singling data SgEnv = SgEnv { sg_let_binds :: Map Name DExp -- from the *original* name + , sg_context :: DCxt -- See Note [Tracking the current type signature context] , sg_local_decls :: [Dec] } emptySgEnv :: SgEnv emptySgEnv = SgEnv { sg_let_binds = Map.empty + , sg_context = [] , sg_local_decls = [] } @@ -72,7 +74,8 @@ qReifyConStrictness = liftSgM `comp1` qReifyConStrictness qIsExtEnabled = liftSgM `comp1` qIsExtEnabled qExtsEnabled = liftSgM qExtsEnabled - qAddForeignFile = liftSgM `comp2` qAddForeignFile + qAddForeignFilePath = liftSgM `comp2` qAddForeignFilePath + qAddTempFile = liftSgM `comp1` qAddTempFile qAddCorePlugin = liftSgM `comp1` qAddCorePlugin qRecover (SgM handler) (SgM body) = do @@ -91,6 +94,18 @@ local (\env@(SgEnv { sg_let_binds = lets2 }) -> env { sg_let_binds = (Map.fromList lets1) `Map.union` lets2 }) +-- Add some constraints to the current type signature context. +-- See Note [Tracking the current type signature context] +bindContext :: DCxt -> SgM a -> SgM a +bindContext ctxt1 + = local (\env@(SgEnv { sg_context = ctxt2 }) -> + env { sg_context = ctxt1 ++ ctxt2 }) + +-- Retrieve the current type signature context. +-- See Note [Tracking the current type signature context] +askContext :: SgM DCxt +askContext = asks sg_context + lookupVarE :: Name -> SgM DExp lookupVarE = lookup_var_con singValName (DVarE . singValName) @@ -154,3 +169,49 @@ singDecsM locals thing = do (decs1, decs2) <- singM locals thing return $ decs1 ++ decs2 + +{- +Note [Tracking the current type signature context] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Much like we track the let-bound names in scope, we also track the current +context. For instance, in the following program: + + -- (1) + f :: forall a. Show a => a -> String -> Bool + f x y = g (show x) y + where + -- (2) + g :: forall b. Eq b => b -> b -> Bool + g = h + where + -- (3) + h :: b -> b -> Bool + h = (==) + +Here is the context at various points: + +(1) () +(2) (Show a) +(3) (Show a, Eq b) + +We track this informating during singling instead of during promotion, as the +promoted versions of things are often type families, which do not have +contexts. + +Why do we bother tracking this at all? Ultimately, because singDefuns (from +Data.Singletons.Single.Defun) needs to know the current context in order to +generate a correctly typed SingI instance. For instance, if you called +singDefuns on the class method bar: + + class Foo a where + bar :: Eq a => a -> Bool + +Then if you only grabbed the context of `bar` itself, then you'd end up +generating the following SingI instance for BarSym0: + + instance SEq a => SingI (FooSym0 :: a ~> Bool) where ... + +Which is incorrect—there needs to be an (SFoo a) constraint as well! If we +track the current context when singling Foo, then we will correctly propagate +this information to singDefuns. +-} diff --git a/src/Data/Singletons/Single/Type.hs b/src/Data/Singletons/Single/Type.hs --- a/src/Data/Singletons/Single/Type.hs +++ b/src/Data/Singletons/Single/Type.hs @@ -15,14 +15,21 @@ import Data.Singletons.Promote.Type import Data.Singletons.Util import Control.Monad +import qualified Data.Set as Set +import Data.Set (Set) -singType :: DType -- the promoted version of the thing classified by... +singType :: Set Name -- the set of bound kind variables in this scope + -- see Note [Explicitly binding kind variables] + -- in Data.Singletons.Promote.Monad + -> DType -- the promoted version of the thing classified by... -> DType -- ... this type -> SgM ( DType -- the singletonized type , Int -- the number of arguments , [Name] -- the names of the tyvars used in the sing'd type + , DCxt -- the context of the singletonized type + , [DKind] -- the kinds of the argument types , DKind ) -- the kind of the result type -singType prom ty = do +singType bound_kvs prom ty = do let (_, cxt, args, res) = unravel ty num_args = length args cxt' <- mapM singPred cxt @@ -32,14 +39,21 @@ let args' = map (\n -> singFamily `DAppT` (DVarT n)) arg_names res' = singFamily `DAppT` (foldl apply prom (map DVarT arg_names) `DSigT` prom_res) tau = ravel args' res' - let ty' = DForallT (zipWith DKindedTV arg_names prom_args) + -- Make sure to subtract out the bound variables currently in scope, lest we + -- accidentally shadow them in this type signature. + kv_names_to_bind = foldMap fvDType (prom_args ++ map predToType cxt' ++ [prom_res]) + Set.\\ bound_kvs + kvs_to_bind = Set.toList kv_names_to_bind + let ty' = DForallT (map DPlainTV kvs_to_bind ++ zipWith DKindedTV arg_names prom_args) cxt' tau - return (ty', num_args, arg_names, prom_res) + return (ty', num_args, arg_names, cxt, prom_args, prom_res) singPred :: DPred -> SgM DPred singPred = singPredRec [] singPredRec :: [DType] -> DPred -> SgM DPred +singPredRec _cxt (DForallPr {}) = + fail "Singling of quantified constraints not yet supported" singPredRec ctx (DAppPr pr ty) = singPredRec (ty : ctx) pr singPredRec _ctx (DSigPr _pr _ki) = fail "Singling of constraints with explicit kinds not yet supported" @@ -51,5 +65,5 @@ | otherwise = do kis <- mapM promoteType ctx let sName = singClassName n - return $ foldl DAppPr (DConPr sName) kis + return $ foldPred (DConPr sName) kis singPredRec _ctx DWildCardPr = return DWildCardPr -- it just might work 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 @@ -13,27 +13,67 @@ module Data.Singletons.Syntax where import Prelude hiding ( exp ) -import Data.Kind +import Data.Kind (Constraint, Type) import Language.Haskell.TH.Syntax hiding (Type) import Language.Haskell.TH.Desugar import Data.Map.Strict ( Map ) import qualified Data.Map.Strict as Map +import Data.Set ( Set ) import Data.Semigroup (Semigroup(..)) -type VarPromotions = [(Name, Name)] -- from term-level name to type-level name +type VarPromotions = [(Name, Name)] -- from term-level name to type-level name - -- the relevant part of declarations -data DataDecl = DataDecl NewOrData Name [DTyVarBndr] [DCon] [DPred] +-- Information that is accumulated when promoting patterns. +data PromDPatInfos = PromDPatInfos + { prom_dpat_vars :: VarPromotions + -- Maps term-level pattern variables to their promoted, type-level counterparts. + , prom_dpat_sig_kvs :: Set Name + -- Kind variables bound by DSigPas. + -- See Note [Explicitly binding kind variables] in Data.Singletons.Promote.Monad + } +instance Semigroup PromDPatInfos where + PromDPatInfos vars1 sig_kvs1 <> PromDPatInfos vars2 sig_kvs2 + = PromDPatInfos (vars1 <> vars2) (sig_kvs1 <> sig_kvs2) + +instance Monoid PromDPatInfos where + mempty = PromDPatInfos mempty mempty + +-- A list of 'SingDSigPaInfos' is produced when singling pattern signatures, as we +-- must case on the 'DExp's and match on them using the supplied 'DType's to +-- bring the necessary singleton equality constraints into scope. +-- See @Note [Singling pattern signatures]@. +type SingDSigPaInfos = [(DExp, DType)] + +-- The parts of data declarations that are relevant to singletons. +data DataDecl = DataDecl Name [DTyVarBndr] [DCon] + +-- The parts of type synonyms that are relevant to singletons. +data TySynDecl = TySynDecl Name [DTyVarBndr] + +-- The parts of open type families that are relevant to singletons. +type OpenTypeFamilyDecl = TypeFamilyDecl 'Open + +-- The parts of closed type families that are relevant to singletons. +type ClosedTypeFamilyDecl = TypeFamilyDecl 'Closed + +-- The parts of type families that are relevant to singletons. +newtype TypeFamilyDecl (info :: FamilyInfo) + = TypeFamilyDecl { getTypeFamilyDecl :: DTypeFamilyHead } +-- Whether a type family is open or closed. +data FamilyInfo = Open | Closed + data ClassDecl ann = ClassDecl { cd_cxt :: DCxt , cd_name :: Name , cd_tvbs :: [DTyVarBndr] , cd_fds :: [FunDep] - , cd_lde :: LetDecEnv ann } + , cd_lde :: LetDecEnv ann + } data InstDecl ann = InstDecl { id_cxt :: DCxt , id_name :: Name , id_arg_tys :: [DType] + , id_sigs :: Map Name DType , id_meths :: [(Name, LetDecRHS ann)] } type UClassDecl = ClassDecl Unannotated @@ -50,7 +90,8 @@ so that Single can use the right promotions. -} --- A DExp with let and lambda nodes annotated with their type-level equivalents +-- A DExp with let, lambda, and type-signature nodes annotated with their +-- type-level equivalents data ADExp = ADVarE Name | ADConE Name | ADLitE Lit @@ -61,11 +102,23 @@ | ADCaseE ADExp [ADMatch] DType -- the type is the return type | ADLetE ALetDecEnv ADExp - | ADSigE ADExp DType + | ADSigE DType -- the promoted expression + ADExp DType -data ADMatch = ADMatch VarPromotions DPat ADExp +-- A DPat with a pattern-signature node annotated with its type-level equivalent +data ADPat = ADLitPa Lit + | ADVarPa Name + | ADConPa Name [ADPat] + | ADTildePa ADPat + | ADBangPa ADPat + | ADSigPa DType -- The promoted pattern. Will not contain any wildcards, + -- as per Note [Singling pattern signatures] + ADPat DType + | ADWildPa + +data ADMatch = ADMatch VarPromotions ADPat ADExp data ADClause = ADClause VarPromotions - [DPat] ADExp + [ADPat] ADExp data AnnotationFlag = Annotated | Unannotated @@ -77,7 +130,7 @@ IfAnn Annotated yes no = yes IfAnn Unannotated yes no = no -data family LetDecRHS (ann :: AnnotationFlag) +data family LetDecRHS :: AnnotationFlag -> Type data instance LetDecRHS Annotated = AFunction DType -- promote function (unapplied) Int -- number of arrows in type @@ -94,19 +147,22 @@ data LetDecEnv ann = LetDecEnv { lde_defns :: Map Name (LetDecRHS ann) , lde_types :: Map Name DType -- type signatures - , lde_infix :: [(Fixity, Name)] -- infix declarations + , lde_infix :: Map Name Fixity -- infix declarations , lde_proms :: IfAnn ann (Map Name DType) () -- possibly, promotions + , lde_bound_kvs :: IfAnn ann (Map Name (Set Name)) () + -- The set of bound variables in scope. + -- See Note [Explicitly binding kind variables] + -- in Data.Singletons.Promote.Monad } type ALetDecEnv = LetDecEnv Annotated type ULetDecEnv = LetDecEnv Unannotated instance Semigroup ULetDecEnv where - LetDecEnv defns1 types1 infx1 _ <> LetDecEnv defns2 types2 infx2 _ = - LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () + 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 = (<>) + mempty = LetDecEnv Map.empty Map.empty Map.empty () () valueBinding :: Name -> ULetDecRHS -> ULetDecEnv valueBinding n v = emptyLetDecEnv { lde_defns = Map.singleton n v } @@ -115,7 +171,7 @@ typeBinding n t = emptyLetDecEnv { lde_types = Map.singleton n t } infixDecl :: Fixity -> Name -> ULetDecEnv -infixDecl f n = emptyLetDecEnv { lde_infix = [(f,n)] } +infixDecl f n = emptyLetDecEnv { lde_infix = Map.singleton n f } emptyLetDecEnv :: ULetDecEnv emptyLetDecEnv = mempty @@ -141,7 +197,7 @@ data DerivedDecl (cls :: Type -> Constraint) = DerivedDecl { ded_mb_cxt :: Maybe DCxt , ded_type :: DType - , ded_cons :: [DCon] + , ded_decl :: DataDecl } type DerivedEqDecl = DerivedDecl Eq @@ -163,7 +219,7 @@ 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) +3. The datatype's original information, as provided through DataDecl (ded_decl) Why are these instances handled outside of partitionDecs? @@ -173,9 +229,9 @@ 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, + also derives Show instances for singletons types. To make this work, we let partitionDecs handle the PShow/SShow instances, but we also stick the relevant info into a DerivedDecl value for later use in - Data.Singletons.Single, where we additionally generate ShowSing/Show + Data.Singletons.Single, where we additionally generate 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 @@ -5,7 +5,7 @@ -- Module : Data.Singletons.TH -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -56,13 +56,16 @@ -- so they must be in scope. PEq(..), If, sIf, type (&&), (%&&), SEq(..), - POrd(..), SOrd(..), ThenCmp, sThenCmp, Foldl, sFoldl, + POrd(..), SOrd(..), ThenCmp, sThenCmp, SDecide(..), (:~:)(..), Void, Refuted, Decision(..), PBounded(..), SBounded(..), PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum), PShow(..), SShow(..), ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace, ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace, + PFunctor(..), SFunctor(..), + PFoldable(..), SFoldable(..), PMonoid(..), SMonoid(..), + PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..), (:.), (%.), SomeSing(..), @@ -89,6 +92,16 @@ ShowSpaceSym0, ShowSpaceSym1, ShowCharSym0, ShowCharSym1, ShowCharSym2, ShowCommaSpaceSym0, ShowCommaSpaceSym1, + FmapSym0, FmapSym1, FmapSym2, + type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), + FoldMapSym0, FoldMapSym1, FoldMapSym2, + MemptySym0, + MappendSym0, MappendSym1, MappendSym2, + FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, + TraverseSym0, TraverseSym1, TraverseSym2, + PureSym0, PureSym1, + type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), + LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), (:@#@$), (:@#@$$), (:@#@$$$), @@ -99,13 +112,20 @@ import Data.Singletons import Data.Singletons.Single import Data.Singletons.Promote +import Data.Singletons.Prelude.Applicative import Data.Singletons.Prelude.Base + hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Instances + hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl) import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq +import Data.Singletons.Prelude.Foldable +import Data.Singletons.Prelude.Functor hiding (Void) +import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Show +import Data.Singletons.Prelude.Traversable import Data.Singletons.Decide import Data.Singletons.TypeLits import Data.Singletons.SuppressUnusedWarnings @@ -128,7 +148,7 @@ cases tyName expq bodyq = do dinfo <- dsReify tyName case dinfo of - Just (DTyConI (DDataD _ _ _ _ ctors _) _) -> + Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) -> expToTH <$> buildCases (map extractNameArgs ctors) expq bodyq Just _ -> fail $ "Using <> with something other than a type constructor: " @@ -150,7 +170,7 @@ sCases tyName expq bodyq = do dinfo <- dsReify tyName case dinfo of - Just (DTyConI (DDataD _ _ _ _ ctors _) _) -> + Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) -> let ctor_stuff = map (first singDataConName . extractNameArgs) ctors in expToTH <$> buildCases ctor_stuff expq bodyq Just _ -> diff --git a/src/Data/Singletons/TypeError.hs b/src/Data/Singletons/TypeError.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/TypeError.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.TypeError +-- Copyright : (C) 2018 Ryan Scott +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines a drop-in replacement for 'TL.TypeError' (from "GHC.TypeLits") +-- that can be used at the value level as well. Since this is a drop-in +-- replacement, it is not recommended to import all of "GHC.TypeLits" +-- and "Data.Singletons.TypeError" at the same time, as many of the definitons +-- in the latter deliberately clash with the former. +-- +---------------------------------------------------------------------------- +module Data.Singletons.TypeError ( + TypeError, sTypeError, typeError, + ErrorMessage'(..), ErrorMessage, PErrorMessage, + Sing(SText, SShowType, (:%<>:), (:%$$:)), SErrorMessage, + ConvertPErrorMessage, showErrorMessage, + + -- * Defunctionalization symbols + TextSym0, TextSym1, + ShowTypeSym0, ShowTypeSym1, + type (:<>:@#@$), type (:<>:@#@$$), type (:<>:@#@$$$), + type (:$$:@#@$), type (:$$:@#@$$), type (:$$:@#@$$$), + TypeErrorSym0, TypeErrorSym1 + ) where + +import Data.Kind +import Data.Singletons.TH +import qualified Data.Text as Text +import qualified GHC.TypeLits as TL (ErrorMessage(..), TypeError) +import GHC.Stack (HasCallStack) +import GHC.TypeLits hiding (ErrorMessage(..), TypeError) +import Prelude hiding ((<>)) +import Text.PrettyPrint (Doc, text, (<>), ($$)) + +-- | A description of a custom type error. +-- +-- This is a variation on 'TL.ErrorMessage' that is parameterized over what +-- text type is used in the 'Text' constructor. Instantiating it with +-- 'Text.Text' gives you 'ErrorMessage', and instantiating it with 'Symbol' +-- gives you 'PErrorMessage'. +data ErrorMessage' s + = Text s + -- ^ Show the text as is. + | forall t. ShowType t + -- ^ Pretty print the type. + -- @ShowType :: k -> ErrorMessage@ + | ErrorMessage' s :<>: ErrorMessage' s + -- ^ Put two pieces of error message next + -- to each other. + | ErrorMessage' s :$$: ErrorMessage' s + -- ^ Stack two pieces of error message on top + -- of each other. +infixl 6 :<>: +infixl 5 :$$: + +-- | A value-level `ErrorMessage'` which uses 'Text.Text' as its text type. +type ErrorMessage = ErrorMessage' Text.Text + +-- | A type-level `ErrorMessage'` which uses 'Symbol' as its text kind. +type PErrorMessage = ErrorMessage' Symbol + +data instance Sing :: PErrorMessage -> Type where + -- It would be lovely to not have to write those (:: PErrorMessage) kind + -- ascriptions in the return types of each constructor. + -- See Trac #14111. + SText :: Sing t -> Sing ('Text t :: PErrorMessage) + SShowType :: Sing ty -> Sing ('ShowType ty :: PErrorMessage) + (:%<>:) :: Sing e1 -> Sing e2 -> Sing (e1 ':<>: e2 :: PErrorMessage) + (:%$$:) :: Sing e1 -> Sing e2 -> Sing (e1 ':$$: e2 :: PErrorMessage) +infixl 6 :%<>: +infixl 5 :%$$: + +type SErrorMessage = (Sing :: PErrorMessage -> Type) + +instance SingKind PErrorMessage where + type Demote PErrorMessage = ErrorMessage + fromSing (SText t) = Text (fromSing t) + fromSing (SShowType{}) = ShowType (error "Can't single ShowType") + fromSing (e1 :%<>: e2) = fromSing e1 :<>: fromSing e2 + fromSing (e1 :%$$: e2) = fromSing e1 :$$: fromSing e2 + toSing (Text t) = withSomeSing t $ SomeSing . SText + toSing (ShowType{}) = SomeSing $ SShowType (error "Can't single ShowType") + toSing (e1 :<>: e2) = withSomeSing e1 $ \sE1 -> + withSomeSing e2 $ \sE2 -> + SomeSing (sE1 :%<>: sE2) + toSing (e1 :$$: e2) = withSomeSing e1 $ \sE1 -> + withSomeSing e2 $ \sE2 -> + SomeSing (sE1 :%$$: sE2) + +instance SingI t => SingI ('Text t :: PErrorMessage) where + sing = SText sing + +instance SingI ty => SingI ('ShowType ty :: PErrorMessage) where + sing = SShowType sing + +instance (SingI e1, SingI e2) => SingI (e1 ':<>: e2 :: PErrorMessage) where + sing = sing :%<>: sing + +instance (SingI e1, SingI e2) => SingI (e1 ':$$: e2 :: PErrorMessage) where + sing = sing :%$$: sing + +-- | Convert an 'ErrorMessage' into a human-readable 'String'. +showErrorMessage :: ErrorMessage -> String +showErrorMessage = show . go + where + go :: ErrorMessage -> Doc + go (Text t) = text (Text.unpack t) + go (ShowType _) = text "" -- Not much we can do here + go (e1 :<>: e2) = go e1 <> go e2 + go (e1 :$$: e2) = go e1 $$ go e2 + +-- | The value-level counterpart to 'TypeError'. +-- +-- Note that this is not quite as expressive as 'TypeError', as it is unable +-- to print the contents of 'ShowType' constructors (it will simply print +-- @\"\\"@ in their place). +typeError :: HasCallStack => ErrorMessage -> a +typeError = error . showErrorMessage + +-- | Convert a 'PErrorMessage' to a 'TL.ErrorMessage' from "GHC.TypeLits". +type family ConvertPErrorMessage (a :: PErrorMessage) :: TL.ErrorMessage where + ConvertPErrorMessage ('Text t) = 'TL.Text t + ConvertPErrorMessage ('ShowType ty) = 'TL.ShowType ty + ConvertPErrorMessage (e1 ':<>: e2) = ConvertPErrorMessage e1 'TL.:<>: ConvertPErrorMessage e2 + ConvertPErrorMessage (e1 ':$$: e2) = ConvertPErrorMessage e1 'TL.:$$: ConvertPErrorMessage e2 + +-- | A drop-in replacement for 'TL.TypeError'. This also exists at the +-- value-level as 'typeError'. +type family TypeError (a :: PErrorMessage) :: b where + -- We cannot define this as a type synonym due to Trac #12048. + TypeError a = TL.TypeError (ConvertPErrorMessage a) + +-- | The singleton for 'typeError'. +-- +-- Note that this is not quite as expressive as 'TypeError', as it is unable +-- to handle 'ShowType' constructors at all. +sTypeError :: HasCallStack => Sing err -> Sing (TypeError err) +sTypeError = typeError . fromSing + +$(genDefunSymbols [''ErrorMessage', ''TypeError]) + +instance SingI (TextSym0 :: Symbol ~> PErrorMessage) where + sing = singFun1 SText +instance SingI (TyCon1 'Text :: Symbol ~> PErrorMessage) where + sing = singFun1 SText + +instance SingI (ShowTypeSym0 :: t ~> PErrorMessage) where + sing = singFun1 SShowType +instance SingI (TyCon1 'ShowType :: t ~> PErrorMessage) where + sing = singFun1 SShowType + +instance SingI ((:<>:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where + sing = singFun2 (:%<>:) +instance SingI (TyCon2 '(:<>:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where + sing = singFun2 (:%<>:) +instance SingI x => SingI ((:<>:@#@$$) x :: PErrorMessage ~> PErrorMessage) where + sing = singFun1 (sing @x :%<>:) +instance SingI x => SingI (TyCon1 ('(:<>:) x) :: PErrorMessage ~> PErrorMessage) where + sing = singFun1 (sing @x :%<>:) + +instance SingI ((:$$:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where + sing = singFun2 (:%$$:) +instance SingI (TyCon2 '(:$$:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where + sing = singFun2 (:%$$:) +instance SingI x => SingI ((:$$:@#@$$) x :: PErrorMessage ~> PErrorMessage) where + sing = singFun1 (sing @x :%$$:) +instance SingI x => SingI (TyCon1 ('(:$$:) x) :: PErrorMessage ~> PErrorMessage) where + sing = singFun1 (sing @x :%$$:) + +instance SingI TypeErrorSym0 where + sing = singFun1 sTypeError 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,12 +1,13 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, ConstraintKinds, - GADTs, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, ConstraintKinds, + GADTs, TypeApplications, TypeFamilies, UndecidableInstances, + DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TypeLits -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -21,23 +22,26 @@ Sing(SNat, SSym), SNat, SSymbol, withKnownNat, withKnownSymbol, Error, sError, + ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, KnownNat, natVal, KnownSymbol, symbolVal, type (^), (%^), - type (<>), (%<>), + type (<=?), (%<=?), TN.Log2, sLog2, Div, sDiv, Mod, sMod, DivMod, sDivMod, Quot, sQuot, Rem, sRem, QuotRem, sQuotRem, -- * Defunctionalization symbols - ErrorSym0, ErrorSym1, UndefinedSym0, + ErrorSym0, ErrorSym1, + ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, + UndefinedSym0, KnownNatSym0, KnownNatSym1, KnownSymbolSym0, KnownSymbolSym1, type (^@#@$), type (^@#@$$), type (^@#@$$$), - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), + type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$), Log2Sym0, Log2Sym1, DivSym0, DivSym1, DivSym2, ModSym0, ModSym1, ModSym2, @@ -50,7 +54,7 @@ import Data.Singletons.Internal import Data.Singletons.Prelude.Tuple import Data.Singletons.Promote -import Data.Singletons.ShowSing () -- for ShowSing/Show instances +import Data.Singletons.ShowSing () -- for Show instances import Data.Singletons.TypeLits.Internal import Data.String (IsString(..)) @@ -78,6 +82,15 @@ instance Ord Nat where compare = no_term_level_nats +instance Enum Nat where + toEnum = no_term_level_nats + fromEnum = no_term_level_nats + enumFromTo = no_term_level_nats + enumFromThenTo = no_term_level_nats + +instance Show Nat where + showsPrec = no_term_level_nats + -- | This bogus instance is helpful for people who want to define -- functions over Symbols that will only be used at the type level or -- as singletons. @@ -90,6 +103,15 @@ instance IsString Symbol where fromString = no_term_level_syms +instance Semigroup Symbol where + (<>) = no_term_level_syms + +instance Monoid Symbol where + mempty = no_term_level_syms + +instance Show Symbol where + showsPrec = no_term_level_syms + no_term_level_nats :: a no_term_level_nats = error "The kind `Nat` may not be used at the term level." @@ -133,6 +155,8 @@ _ -> case TN.someNatVal (genLog2 x) of SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) $(genDefunSymbols [''TN.Log2]) +instance SingI Log2Sym0 where + sing = singFun1 sLog2 sDiv :: Sing x -> Sing y -> Sing (Div x y) sDiv sx sy = @@ -143,6 +167,10 @@ SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) infixl 7 `sDiv` $(genDefunSymbols [''Div]) +instance SingI DivSym0 where + sing = singFun2 sDiv +instance SingI x => SingI (DivSym1 x) where + sing = singFun1 $ sDiv (sing @x) sMod :: Sing x -> Sing y -> Sing (Mod x y) sMod sx sy = @@ -153,6 +181,10 @@ SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) infixl 7 `sMod` $(genDefunSymbols [''Mod]) +instance SingI ModSym0 where + sing = singFun2 sMod +instance SingI x => SingI (ModSym1 x) where + sing = singFun1 $ sMod $ sing @x $(promoteOnly [d| divMod :: Nat -> Nat -> (Nat, Nat) 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 @@ -3,7 +3,7 @@ -- Module : Data.Singletons.TypeLits.Internal -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) +-- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- @@ -16,7 +16,8 @@ {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, FlexibleInstances, UndecidableInstances, ScopedTypeVariables, RankNTypes, GADTs, FlexibleContexts, TypeOperators, ConstraintKinds, - TypeInType, TemplateHaskell, StandaloneDeriving #-} + TemplateHaskell, StandaloneDeriving, + TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.TypeLits.Internal ( @@ -25,28 +26,29 @@ Nat, Symbol, SNat, SSymbol, withKnownNat, withKnownSymbol, Error, sError, + ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, KnownNat, TN.natVal, KnownSymbol, symbolVal, type (^), (%^), - type (<>), (%<>), + type (<=?), (%<=?), -- * Defunctionalization symbols - ErrorSym0, ErrorSym1, UndefinedSym0, + ErrorSym0, ErrorSym1, + ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, + UndefinedSym0, type (^@#@$), type (^@#@$$), type (^@#@$$$), - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) + type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$) ) where import Data.Singletons.Promote import Data.Singletons.Internal import Data.Singletons.Prelude.Eq -import Data.Singletons.Prelude.Ord +import Data.Singletons.Prelude.Ord as O import Data.Singletons.Decide import Data.Singletons.Prelude.Bool +import GHC.Stack (HasCallStack) import GHC.TypeLits as TL import qualified GHC.TypeNats as TN -import Data.Monoid ((<>)) -import qualified Data.Type.Equality as DTE -import Data.Type.Equality ((:~:)(..)) import Data.Proxy ( Proxy(..) ) import Numeric.Natural (Natural) import Unsafe.Coerce @@ -83,36 +85,36 @@ -- SDecide instances: instance SDecide Nat where (SNat :: Sing n) %~ (SNat :: Sing m) - | TN.natVal (Proxy :: Proxy n) == TN.natVal (Proxy :: Proxy m) - = Proved $ unsafeCoerce Refl + | Just r <- TN.sameNat (Proxy :: Proxy n) (Proxy :: Proxy m) + = Proved r | otherwise = Disproved (\_ -> error errStr) where errStr = "Broken Nat singletons" instance SDecide Symbol where (SSym :: Sing n) %~ (SSym :: Sing m) - | symbolVal (Proxy :: Proxy n) == symbolVal (Proxy :: Proxy m) - = Proved $ unsafeCoerce Refl + | Just r <- sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m) + = Proved r | otherwise = Disproved (\_ -> error errStr) where errStr = "Broken Symbol singletons" -- PEq instances -instance PEq Nat where - type (a :: Nat) == (b :: Nat) = a DTE.== b -instance PEq Symbol where - type (a :: Symbol) == (b :: Symbol) = a DTE.== b +instance PEq Nat +instance PEq Symbol -- need SEq instances for TypeLits kinds instance SEq Nat where - a %== b - | fromSing a == fromSing b = unsafeCoerce STrue - | otherwise = unsafeCoerce SFalse + (SNat :: Sing n) %== (SNat :: Sing m) + = case sameNat (Proxy :: Proxy n) (Proxy :: Proxy m) of + Just Refl -> STrue + Nothing -> unsafeCoerce SFalse instance SEq Symbol where - a %== b - | fromSing a == fromSing b = unsafeCoerce STrue - | otherwise = unsafeCoerce SFalse + (SSym :: Sing n) %== (SSym :: Sing m) + = case sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m) of + Just Refl -> STrue + Nothing -> unsafeCoerce SFalse -- POrd instances instance POrd Nat where @@ -156,20 +158,33 @@ -- easier use. type family Error (str :: k0) :: k where {} $(genDefunSymbols [''Error]) +instance SingI (ErrorSym0 :: Symbol ~> a) where + sing = singFun1 sError -- | The singleton for 'error' -sError :: Sing (str :: Symbol) -> a +sError :: HasCallStack => Sing (str :: Symbol) -> a sError sstr = error (T.unpack (fromSing sstr)) +-- | The promotion of 'errorWithoutStackTrace'. This version is more +-- poly-kinded for easier use. +type family ErrorWithoutStackTrace (str :: k0) :: k where {} +$(genDefunSymbols [''ErrorWithoutStackTrace]) +instance SingI (ErrorWithoutStackTraceSym0 :: Symbol ~> a) where + sing = singFun1 sErrorWithoutStackTrace + +-- | The singleton for 'errorWithoutStackTrace'. +sErrorWithoutStackTrace :: Sing (str :: Symbol) -> a +sErrorWithoutStackTrace sstr = errorWithoutStackTrace (T.unpack (fromSing sstr)) + -- | The promotion of 'undefined'. type family Undefined :: k where {} $(genDefunSymbols [''Undefined]) -- | The singleton for 'undefined'. -sUndefined :: a +sUndefined :: HasCallStack => a sUndefined = undefined --- | The singleton analogue of '(TL.^)' for 'Nat's. +-- | The singleton analogue of '(TN.^)' for 'Nat's. (%^) :: Sing a -> Sing b -> Sing (a ^ b) sa %^ sb = let a = fromSing sa @@ -182,20 +197,35 @@ -- Defunctionalization symbols for type-level (^) $(genDefunSymbols [''(^)]) - --- | The promoted analogue of '(<>)' for 'Symbol's. This uses the special --- 'TL.AppendSymbol' type family from "GHC.TypeLits". -type a <> b = TL.AppendSymbol a b -infixr 6 <> +instance SingI (^@#@$) where + sing = singFun2 (%^) +instance SingI x => SingI ((^@#@$$) x) where + sing = singFun1 (sing @x %^) --- | 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 %<> +-- | The singleton analogue of 'TN.<=?' +-- +-- Note that, because of historical reasons in GHC's 'TN.Nat' API, 'TN.<=?' +-- is incompatible (unification-wise) with 'O.<=' and the 'PEq', 'SEq', +-- 'POrd', and 'SOrd' instances for 'Nat'. @(a '<=?' b) ~ 'True@ does not +-- imply anything about @a 'O.<=' b@ or any other 'PEq' / 'POrd' +-- relationships. +-- +-- (Be aware that 'O.<=' in the paragraph above refers to 'O.<=' from the +-- 'POrd' typeclass, exported from "Data.Singletons.Prelude.Ord", and /not/ +-- the 'TN.<=' from "GHC.TypeNats". The latter is simply a type alias for +-- @(a 'TN.<=?' b) ~ 'True@.) +-- +-- This is provided here for the sake of completeness and for compatibility +-- with libraries with APIs built around '<=?'. New code should use +-- 'CmpNat', exposed through this library through the 'POrd' and 'SOrd' +-- instances for 'Nat'. +(%<=?) :: Sing a -> Sing b -> Sing (a <=? b) +sa %<=? sb = unsafeCoerce (sa %<= sb) +infix 4 %<=? -$(genDefunSymbols [''(<>)]) +-- Defunctionalization symbols for (<=?) +$(genDefunSymbols [''(<=?)]) +instance SingI (<=?@#@$) where + sing = singFun2 (%<=?) +instance SingI x => SingI ((<=?@#@$$) x) where + sing = singFun1 (sing @x %<=?) diff --git a/src/Data/Singletons/TypeRepStar.hs b/src/Data/Singletons/TypeRepStar.hs deleted file mode 100644 --- a/src/Data/Singletons/TypeRepStar.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE RankNTypes, TypeFamilies, KindSignatures, FlexibleInstances, - GADTs, UndecidableInstances, ScopedTypeVariables, DataKinds, - MagicHash, TypeOperators #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.TypeRepStar --- Copyright : (C) 2013 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- This module defines singleton instances making 'TypeRep' the singleton for --- the kind @*@. The definitions don't fully line up with what is expected --- within the singletons library, so expect unusual results! --- ----------------------------------------------------------------------------- - -module Data.Singletons.TypeRepStar ( - Sing(STypeRep), - -- | Here is the definition of the singleton for @*@: - -- - -- > newtype instance Sing :: Type -> Type where - -- > STypeRep :: TypeRep a -> Sing a - -- - -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and 'TestCoercion' are - -- also supplied. - - SomeTypeRepStar(..) - ) where - -import Data.Singletons.Prelude.Instances -import Data.Singletons.Internal -import Data.Singletons.Prelude.Eq -import Data.Singletons.Decide -import Data.Singletons.ShowSing -import Type.Reflection -import Type.Reflection.Unsafe -import Unsafe.Coerce - -import Data.Kind -import Data.Type.Equality ((:~:)(..)) - -newtype instance Sing :: Type -> Type where - STypeRep :: TypeRep a -> Sing a - deriving (Eq, Ord, Show) - --- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to --- kind @*@. -data SomeTypeRepStar where - SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStar - -instance Eq SomeTypeRepStar where - SomeTypeRepStar a == SomeTypeRepStar b = - case eqTypeRep a b of - Just HRefl -> True - Nothing -> False - -instance Ord SomeTypeRepStar where - SomeTypeRepStar a `compare` SomeTypeRepStar b = - typeRepFingerprint a `compare` typeRepFingerprint b - -instance Show SomeTypeRepStar where - showsPrec p (SomeTypeRepStar ty) = showsPrec p ty - -instance Typeable a => SingI (a :: *) where - sing = STypeRep typeRep -instance SingKind Type where - type Demote Type = SomeTypeRepStar - fromSing (STypeRep tr) = SomeTypeRepStar tr - toSing (SomeTypeRepStar tr) = SomeSing $ STypeRep tr - -instance PEq Type where - type (a :: *) == (b :: *) = EqType a b - -type family EqType (a :: Type) (b :: Type) where - EqType a a = 'True - EqType a b = 'False - -instance SEq Type where - STypeRep tra %== STypeRep trb = - case eqTypeRep tra trb of - Just HRefl -> STrue - Nothing -> unsafeCoerce SFalse - -- the Data.Typeable interface isn't strong enough - -- to enable us to define this without unsafeCoerce - -instance SDecide Type where - STypeRep tra %~ STypeRep trb = - case eqTypeRep tra trb of - Just HRefl -> Proved Refl - Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed") - -instance ShowSing Type where - showsSingPrec = showsPrec diff --git a/src/Data/Singletons/TypeRepTYPE.hs b/src/Data/Singletons/TypeRepTYPE.hs new file mode 100644 --- /dev/null +++ b/src/Data/Singletons/TypeRepTYPE.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleInstances, + GADTs, UndecidableInstances, ScopedTypeVariables, + MagicHash, TypeOperators, PolyKinds #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.TypeRepTYPE +-- Copyright : (C) 2013 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Ryan Scott +-- Stability : experimental +-- Portability : non-portable +-- +-- This module defines singleton instances making 'TypeRep' the singleton for +-- the kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@), an instantiation of +-- which is the famous kind 'Type'. The definitions don't fully line up with +-- what is expected within the singletons library, so expect unusual results! +-- +---------------------------------------------------------------------------- + +module Data.Singletons.TypeRepTYPE ( + Sing(STypeRep), + -- | Here is the definition of the singleton for @'TYPE' rep@: + -- + -- > newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where + -- > STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a + -- + -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and + -- 'TestCoercion' are also supplied. + + SomeTypeRepTYPE(..) + ) where + +import Data.Kind (Type) +import Data.Singletons.Prelude.Instances +import Data.Singletons.Internal +import Data.Singletons.Prelude.Eq +import Data.Singletons.Decide +import Data.Type.Equality ((:~:)(..)) +import GHC.Exts (RuntimeRep, TYPE) +import Type.Reflection +import Type.Reflection.Unsafe +import Unsafe.Coerce + +-- | A choice of singleton for the kind @'TYPE' rep@ (for some 'RuntimeRep' +-- @rep@), an instantiation of which is the famous kind 'Type'. +-- +-- Conceivably, one could generalize this instance to `Sing :: k -> Type` for +-- /any/ kind @k@, and remove all other 'Sing' instances. We don't adopt this +-- design, however, since it is far more convenient in practice to work with +-- explicit singleton values than 'TypeRep's (for instance, 'TypeRep's are +-- more difficult to pattern match on, and require extra runtime checks). +-- +-- We cannot produce explicit singleton values for everything in @'TYPE' rep@, +-- however, since it is an open kind, so we reach for 'TypeRep' in this one +-- particular case. +newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where + STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a + deriving (Eq, Ord, Show) + +-- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to +-- kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@). +data SomeTypeRepTYPE :: RuntimeRep -> Type where + SomeTypeRepTYPE :: forall (rep :: RuntimeRep) (a :: TYPE rep). !(TypeRep a) -> SomeTypeRepTYPE rep + +instance Eq (SomeTypeRepTYPE rep) where + SomeTypeRepTYPE a == SomeTypeRepTYPE b = + case eqTypeRep a b of + Just HRefl -> True + Nothing -> False + +instance Ord (SomeTypeRepTYPE rep) where + SomeTypeRepTYPE a `compare` SomeTypeRepTYPE b = + typeRepFingerprint a `compare` typeRepFingerprint b + +instance Show (SomeTypeRepTYPE rep) where + showsPrec p (SomeTypeRepTYPE ty) = showsPrec p ty + +instance Typeable a => SingI (a :: TYPE rep) where + sing = STypeRep typeRep +instance SingKind (TYPE rep) where + type Demote (TYPE rep) = SomeTypeRepTYPE rep + fromSing (STypeRep tr) = SomeTypeRepTYPE tr + toSing (SomeTypeRepTYPE tr) = SomeSing $ STypeRep tr + +instance PEq (TYPE rep) +instance SEq (TYPE rep) where + STypeRep tra %== STypeRep trb = + case eqTypeRep tra trb of + Just HRefl -> STrue + Nothing -> unsafeCoerce SFalse + -- the Data.Typeable interface isn't strong enough + -- to enable us to define this without unsafeCoerce + +instance SDecide (TYPE rep) where + STypeRep tra %~ STypeRep trb = + case eqTypeRep tra trb of + Just HRefl -> Proved Refl + Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed") 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 @@ -25,9 +25,13 @@ import qualified Data.Map as Map import Data.List.NonEmpty (NonEmpty(..)) import Data.Map ( Map ) +import qualified Data.Monoid as Monoid +import Data.Semigroup as Semigroup import Data.Foldable +import Data.Functor.Identity import Data.Traversable import Data.Generics +import Data.Maybe import Data.Void import Control.Monad.Fail ( MonadFail ) @@ -42,17 +46,43 @@ boundedBasicTypes :: [Name] boundedBasicTypes = - [ ''(,) + [ ''(,) , ''(,,) , ''(,,,) , ''(,,,,) , ''(,,,,,) , ''(,,,,,,) + , ''Identity ] ++ enumBasicTypes enumBasicTypes :: [Name] enumBasicTypes = [ ''Bool, ''Ordering, ''() ] +semigroupBasicTypes :: [Name] +semigroupBasicTypes + = [ ''Dual + , ''All + , ''Any + , ''Sum + , ''Product + -- , ''Endo see https://github.com/goldfirere/singletons/issues/82 + {- , ''Alt singletons doesn't support higher kinds :( + see https://github.com/goldfirere/singletons/issues/150 + -} + + , ''Min + , ''Max + , ''Semigroup.First + , ''Semigroup.Last + , ''WrappedMonoid + ] + +monoidBasicTypes :: [Name] +monoidBasicTypes + = [ ''Monoid.First + , ''Monoid.Last + ] + -- like reportWarning, but generalized to any Quasi qReportWarning :: Quasi q => String -> q () qReportWarning = qReport False @@ -218,17 +248,6 @@ resultSigToMaybeKind (DTyVarSig (DPlainTV _)) = Nothing resultSigToMaybeKind (DTyVarSig (DKindedTV _ k)) = Just k --- Get argument types from an arrow type. Removing ForallT is an --- important preprocessing step required by promoteType. -unravel :: DType -> ([DTyVarBndr], [DPred], [DType], DType) -unravel (DForallT tvbs cxt ty) = - let (tvbs', cxt', tys, res) = unravel ty in - (tvbs ++ tvbs', cxt ++ cxt', tys, res) -unravel (DAppT (DAppT DArrowT t1) t2) = - let (tvbs, cxt, tys, res) = unravel t2 in - (tvbs, cxt, t1 : tys, res) -unravel t = ([], [], [], t) - -- Reconstruct arrow kind from the list of kinds ravel :: [DType] -> DType -> DType ravel [] res = res @@ -236,11 +255,12 @@ -- | 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 +predToType (DForallPr tvbs cxt p) = DForallT tvbs cxt (predToType p) +predToType (DAppPr p t) = DAppT (predToType p) t +predToType (DSigPr p k) = DSigT (predToType p) k +predToType (DVarPr n) = DVarT n +predToType (DConPr n) = DConT n +predToType DWildCardPr = DWildCardT -- count the number of arguments in a type countArgs :: DType -> Int @@ -280,10 +300,6 @@ (subst', tvbs') = mapAccumL subst_tvb subst tvbs cxt' = map (substPred subst') cxt inner_ty' = substType subst' inner_ty - - subst_tvb s tvb@(DPlainTV n) = (Map.delete n s, tvb) - subst_tvb s (DKindedTV n k) = (Map.delete n s, DKindedTV n (substKind s k)) - substType subst (DAppT ty1 ty2) = substType subst ty1 `DAppT` substType subst ty2 substType subst (DSigT ty ki) = substType subst ty `DSigT` substType subst ki substType subst (DVarT n) = @@ -294,41 +310,47 @@ substType _ ty@(DArrowT) = ty substType _ ty@(DLitT {}) = ty substType _ ty@DWildCardT = ty -substType _ ty@DStarT = ty substPred :: Map Name DType -> DPred -> DPred substPred subst pred | Map.null subst = pred +substPred subst (DForallPr tvbs cxt inner_pred) + = DForallPr tvbs' cxt' inner_pred' + where + (subst', tvbs') = mapAccumL subst_tvb subst tvbs + cxt' = map (substPred subst') cxt + inner_pred' = substPred subst' inner_pred substPred subst (DAppPr pred ty) = DAppPr (substPred subst pred) (substType subst ty) -substPred subst (DSigPr pred ki) = DSigPr (substPred subst pred) ki +substPred subst (DSigPr pred ki) = + DSigPr (substPred subst pred) (substKind subst ki) substPred _ pred@(DVarPr {}) = pred substPred _ pred@(DConPr {}) = pred substPred _ pred@DWildCardPr = pred -substKindInPred :: Map Name DKind -> DPred -> DPred -substKindInPred subst pred | Map.null subst = pred -substKindInPred subst (DAppPr pred ty) = - DAppPr (substKindInPred subst pred) (substType subst ty) -substKindInPred subst (DSigPr pred ki) = DSigPr (substKindInPred subst pred) - (substKind subst ki) -substKindInPred _ pred@(DVarPr {}) = pred -substKindInPred _ pred@(DConPr {}) = pred -substKindInPred _ pred@DWildCardPr = pred - -substKindInTvb :: Map Name DKind -> DTyVarBndr -> DTyVarBndr -substKindInTvb _ tvb@(DPlainTV _) = tvb -substKindInTvb subst (DKindedTV n ki) = DKindedTV n (substKind subst ki) - -addStar :: DKind -> DKind -addStar t = DAppT (DAppT DArrowT t) DStarT +subst_tvb :: Map Name DKind -> DTyVarBndr -> (Map Name DKind, DTyVarBndr) +subst_tvb s tvb@(DPlainTV n) = (Map.delete n s, tvb) +subst_tvb s (DKindedTV n k) = (Map.delete n s, DKindedTV n (substKind s k)) -addStar_maybe :: Maybe DKind -> Maybe DKind -addStar_maybe = fmap addStar +cuskify :: DTyVarBndr -> DTyVarBndr +cuskify (DPlainTV tvname) = DKindedTV tvname $ DConT typeKindName +cuskify tvb = tvb -- apply a type to a list of types foldType :: DType -> [DType] -> DType foldType = foldl DAppT +-- apply a type to a list of type variable binders +foldTypeTvbs :: DType -> [DTyVarBndr] -> DType +foldTypeTvbs ty = foldType ty . map tvbToType + +-- apply a pred to a list of types +foldPred :: DPred -> [DType] -> DPred +foldPred = foldl DAppPr + +-- apply a pred to a list of type variable binders +foldPredTvbs :: DPred -> [DTyVarBndr] -> DPred +foldPredTvbs pr = foldPred pr . map tvbToType + -- | Decompose an applied type into its individual components. For example, this: -- -- @ @@ -349,6 +371,13 @@ go acc (DForallT _ _ t) = go acc t go acc t = t :| acc +-- Construct a data type's variable binders, possibly using fresh variables +-- from the data type's kind signature. +buildDataDTvbs :: DsMonad q => [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr] +buildDataDTvbs tvbs mk = do + extra_tvbs <- mkExtraDKindBinders $ fromMaybe (DConT typeKindName) mk + pure $ tvbs ++ extra_tvbs + -- apply an expression to a list of expressions foldExp :: DExp -> [DExp] -> DExp foldExp = foldl DAppE @@ -404,7 +433,8 @@ qReifyConStrictness = lift `comp1` qReifyConStrictness qIsExtEnabled = lift `comp1` qIsExtEnabled qExtsEnabled = lift qExtsEnabled - qAddForeignFile = lift `comp2` qAddForeignFile + qAddForeignFilePath = lift `comp2` qAddForeignFilePath + qAddTempFile = lift `comp1` qAddTempFile qAddCorePlugin = lift `comp1` qAddCorePlugin qRecover exp handler = do diff --git a/tests/ByHand.hs b/tests/ByHand.hs new file mode 100644 --- /dev/null +++ b/tests/ByHand.hs @@ -0,0 +1,864 @@ +{- ByHand.hs + +(c) Richard Eisenberg 2012 +rae@cs.brynmawr.edu + +Shows the derivations for the singleton definitions done by hand. +This file is a great way to understand the singleton encoding better. + +-} + +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors -Wno-orphans #-} + +{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures, GADTs, + FlexibleInstances, FlexibleContexts, UndecidableInstances, + RankNTypes, TypeOperators, MultiParamTypeClasses, + FunctionalDependencies, ScopedTypeVariables, + LambdaCase, TemplateHaskell, EmptyCase, + AllowAmbiguousTypes, TypeApplications, EmptyCase + #-} + +module ByHand where + +import Data.Kind (Type) +import Prelude hiding (Bool, False, True, Maybe, Just, Nothing, Either, Left, Right, map, zipWith, + (&&), (||), (+), (-)) +import Unsafe.Coerce + +import Data.Type.Equality hiding (type (==), apply) +import Data.Proxy + +import Data.Singletons +import Data.Singletons.Decide + +----------------------------------- +-- Original ADTs ------------------ +----------------------------------- + +data Nat :: Type where + Zero :: Nat + Succ :: Nat -> Nat + deriving Eq + +data Bool :: Type where + False :: Bool + True :: Bool + +data Maybe :: Type -> Type where + Nothing :: Maybe a + Just :: a -> Maybe a + deriving Eq + +-- Defined using names to avoid fighting with concrete syntax +data List :: Type -> Type where + Nil :: List a + Cons :: a -> List a -> List a + deriving Eq + +data Either :: Type -> Type -> Type where + Left :: a -> Either a b + Right :: b -> Either a b + + +----------------------------------- +-- One-time definitions ----------- +----------------------------------- + +-- Promoted equality type class +class PEq k where + type (==) (a :: k) (b :: k) :: Bool + -- omitting definition of /= + +-- Singleton type equality type class +class SEq k where + (%==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a == b) + -- omitting definition of %/= + +type family If cond tru fls where + If True tru fls = tru + If False tru fls = fls + +sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c) +sIf STrue b _ = b +sIf SFalse _ c = c + +----------------------------------- +-- Auto-generated code ------------ +----------------------------------- + +-- Nat + +data instance Sing :: Nat -> Type where + SZero :: Sing Zero + SSucc :: Sing n -> Sing (Succ n) + +data SuccSym0 :: Nat ~> Nat +type instance Apply SuccSym0 x = Succ x + +type family EqualsNat (a :: Nat) (b :: Nat) where + EqualsNat Zero Zero = True + EqualsNat (Succ a) (Succ b) = a == b + EqualsNat (n1 :: Nat) (n2 :: Nat) = False +instance PEq Nat where + type a == b = EqualsNat a b + +instance SEq Nat where + SZero %== SZero = STrue + SZero %== (SSucc _) = SFalse + (SSucc _) %== SZero = SFalse + (SSucc n) %== (SSucc n') = n %== n' + +instance SDecide Nat where + SZero %~ SZero = Proved Refl + (SSucc m) %~ (SSucc n) = + case m %~ n of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + SZero %~ (SSucc _) = Disproved (\case) + (SSucc _) %~ SZero = Disproved (\case) + +instance SingI Zero where + sing = SZero +instance SingI n => SingI (Succ n) where + sing = SSucc sing +instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc n) = Succ (fromSing n) + toSing Zero = SomeSing SZero + toSing (Succ n) = withSomeSing n (\n' -> SomeSing $ SSucc n') + +-- Bool + +data instance Sing :: Bool -> Type where + SFalse :: Sing False + STrue :: Sing True + +(&&) :: Bool -> Bool -> Bool +False && _ = False +True && x = x + +type family (a :: Bool) && (b :: Bool) :: Bool where + False && _ = False + True && x = x + +(%&&) :: forall (a :: Bool) (b :: Bool). Sing a -> Sing b -> Sing (a && b) +SFalse %&& SFalse = SFalse +SFalse %&& STrue = SFalse +STrue %&& SFalse = SFalse +STrue %&& STrue = STrue + +instance SingI False where + sing = SFalse +instance SingI True where + sing = STrue +instance SingKind Bool where + type Demote Bool = Bool + fromSing SFalse = False + fromSing STrue = True + toSing False = SomeSing SFalse + toSing True = SomeSing STrue + +-- Maybe + +data instance Sing :: Maybe k -> Type where + SNothing :: Sing Nothing + SJust :: forall k (a :: k). Sing a -> Sing (Just a) + +type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) where + EqualsMaybe Nothing Nothing = True + EqualsMaybe (Just a) (Just a') = a == a' + EqualsMaybe (x :: Maybe k) (y :: Maybe k) = False +instance PEq a => PEq (Maybe a) where + type m1 == m2 = EqualsMaybe m1 m2 + +instance SDecide k => SDecide (Maybe k) where + SNothing %~ SNothing = Proved Refl + (SJust x) %~ (SJust y) = + case x %~ y of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + SNothing %~ (SJust _) = Disproved (\case) + (SJust _) %~ SNothing = Disproved (\case) + +instance SEq k => SEq (Maybe k) where + SNothing %== SNothing = STrue + SNothing %== (SJust _) = SFalse + (SJust _) %== SNothing = SFalse + (SJust a) %== (SJust a') = a %== a' + +instance SingI (Nothing :: Maybe k) where + sing = SNothing +instance SingI a => SingI (Just (a :: k)) where + sing = SJust sing +instance SingKind k => SingKind (Maybe k) where + type Demote (Maybe k) = Maybe (Demote k) + fromSing SNothing = Nothing + fromSing (SJust a) = Just (fromSing a) + toSing Nothing = SomeSing SNothing + toSing (Just x) = + case toSing x :: SomeSing k of + SomeSing x' -> SomeSing $ SJust x' + +-- List + +data instance Sing :: List k -> Type where + SNil :: Sing Nil + SCons :: forall k (h :: k) (t :: List k). Sing h -> Sing t -> Sing (Cons h t) + +type NilSym0 = Nil + +data ConsSym0 :: a ~> List a ~> List a +type instance Apply ConsSym0 a = ConsSym1 a + +data ConsSym1 :: a -> List a ~> List a +type instance Apply (ConsSym1 a) b = ConsSym2 a b + +type ConsSym2 a b = Cons a b + +type family EqualsList (a :: List k) (b :: List k) where + EqualsList Nil Nil = True + EqualsList (Cons a b) (Cons a' b') = (a == a') && (b == b') + EqualsList (x :: List k) (y :: List k) = False +instance PEq a => PEq (List a) where + type l1 == l2 = EqualsList l1 l2 + +instance SEq k => SEq (List k) where + SNil %== SNil = STrue + SNil %== (SCons _ _) = SFalse + (SCons _ _) %== SNil = SFalse + (SCons a b) %== (SCons a' b') = (a %== a') %&& (b %== b') + +instance SDecide k => SDecide (List k) where + SNil %~ SNil = Proved Refl + (SCons h1 t1) %~ (SCons h2 t2) = + case (h1 %~ h2, t1 %~ t2) of + (Proved Refl, Proved Refl) -> Proved Refl + (Disproved contra, _) -> Disproved (\Refl -> contra Refl) + (_, Disproved contra) -> Disproved (\Refl -> contra Refl) + SNil %~ (SCons _ _) = Disproved (\case) + (SCons _ _) %~ SNil = Disproved (\case) + +instance SingI Nil where + sing = SNil +instance (SingI h, SingI t) => + SingI (Cons (h :: k) (t :: List k)) where + sing = SCons sing sing +instance SingKind k => SingKind (List k) where + type Demote (List k) = List (Demote k) + fromSing SNil = Nil + fromSing (SCons h t) = Cons (fromSing h) (fromSing t) + toSing Nil = SomeSing SNil + toSing (Cons h t) = + case ( toSing h :: SomeSing k + , toSing t :: SomeSing (List k) ) of + (SomeSing h', SomeSing t') -> SomeSing $ SCons h' t' + +-- Either + +data instance Sing :: Either k1 k2 -> Type where + SLeft :: forall k1 (a :: k1). Sing a -> Sing (Left a) + SRight :: forall k2 (b :: k2). Sing b -> Sing (Right b) + +instance (SingI a) => SingI (Left (a :: k)) where + sing = SLeft sing +instance (SingI b) => SingI (Right (b :: k)) where + sing = SRight sing +instance (SingKind k1, SingKind k2) => SingKind (Either k1 k2) where + type Demote (Either k1 k2) = Either (Demote k1) (Demote k2) + fromSing (SLeft x) = Left (fromSing x) + fromSing (SRight x) = Right (fromSing x) + toSing (Left x) = + case toSing x :: SomeSing k1 of + SomeSing x' -> SomeSing $ SLeft x' + toSing (Right x) = + case toSing x :: SomeSing k2 of + SomeSing x' -> SomeSing $ SRight x' + +instance (SDecide k1, SDecide k2) => SDecide (Either k1 k2) where + (SLeft x) %~ (SLeft y) = + case x %~ y of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + (SRight x) %~ (SRight y) = + case x %~ y of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + (SLeft _) %~ (SRight _) = Disproved (\case) + (SRight _) %~ (SLeft _) = Disproved (\case) + +-- Composite + +data Composite :: Type -> Type -> Type where + MkComp :: Either (Maybe a) b -> Composite a b + +data instance Sing :: Composite k1 k2 -> Type where + SMkComp :: forall k1 k2 (a :: Either (Maybe k1) k2). Sing a -> Sing (MkComp a) + +instance SingI a => SingI (MkComp (a :: Either (Maybe k1) k2)) where + sing = SMkComp sing +instance (SingKind k1, SingKind k2) => SingKind (Composite k1 k2) where + type Demote (Composite k1 k2) = + Composite (Demote k1) (Demote k2) + fromSing (SMkComp x) = MkComp (fromSing x) + toSing (MkComp x) = + case toSing x :: SomeSing (Either (Maybe k1) k2) of + SomeSing x' -> SomeSing $ SMkComp x' + +instance (SDecide k1, SDecide k2) => SDecide (Composite k1 k2) where + (SMkComp x) %~ (SMkComp y) = + case x %~ y of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + +-- Empty + +data Empty +data instance Sing :: Empty -> Type +instance SingKind Empty where + type Demote Empty = Empty + fromSing = \case + toSing x = SomeSing (case x of) + +-- Type + +data Vec :: Type -> Nat -> Type where + VNil :: Vec a Zero + VCons :: a -> Vec a n -> Vec a (Succ n) + +data Rep = Nat | Maybe Rep | Vec Rep Nat + +data instance Sing :: Type -> Type where + SNat :: Sing Nat + SMaybe :: Sing a -> Sing (Maybe a) + SVec :: Sing a -> Sing n -> Sing (Vec a n) + +instance SingI Nat where + sing = SNat +instance SingI a => SingI (Maybe a) where + sing = SMaybe sing +instance (SingI a, SingI n) => SingI (Vec a n) where + sing = SVec sing sing + +instance SingKind Type where + type Demote Type = Rep + + fromSing SNat = Nat + fromSing (SMaybe a) = Maybe (fromSing a) + fromSing (SVec a n) = Vec (fromSing a) (fromSing n) + + toSing Nat = SomeSing SNat + toSing (Maybe a) = + case toSing a :: SomeSing Type of + SomeSing a' -> SomeSing $ SMaybe a' + toSing (Vec a n) = + case ( toSing a :: SomeSing Type + , toSing n :: SomeSing Nat) of + (SomeSing a', SomeSing n') -> SomeSing $ SVec a' n' + +instance SDecide Type where + SNat %~ SNat = Proved Refl + SNat %~ (SMaybe {}) = Disproved (\case) + SNat %~ (SVec {}) = Disproved (\case) + (SMaybe {}) %~ SNat = Disproved (\case) + (SMaybe a) %~ (SMaybe b) = + case a %~ b of + Proved Refl -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) + (SMaybe {}) %~ (SVec {}) = Disproved (\case) + (SVec {}) %~ SNat = Disproved (\case) + (SVec {}) %~ (SMaybe {}) = Disproved (\case) + (SVec a1 n1) %~ (SVec a2 n2) = + case (a1 %~ a2, n1 %~ n2) of + (Proved Refl, Proved Refl) -> Proved Refl + (Disproved contra, _) -> Disproved (\Refl -> contra Refl) + (_, Disproved contra) -> Disproved (\Refl -> contra Refl) + +type family EqualsType (a :: Type) (b :: Type) where + EqualsType a a = True + EqualsType _ _ = False +instance PEq Type where + type a == b = EqualsType a b + +instance SEq Type where + a %== b = + case a %~ b of + Proved Refl -> STrue + Disproved _ -> unsafeCoerce SFalse + +----------------------------------- +-- Some example functions --------- +----------------------------------- + +isJust :: Maybe a -> Bool +isJust Nothing = False +isJust (Just _) = True + +type family IsJust (a :: Maybe k) :: Bool where + IsJust Nothing = False + IsJust (Just a) = True + +-- defunctionalization symbols +data IsJustSym0 :: Maybe a ~> Bool +type instance Apply IsJustSym0 a = IsJust a + +sIsJust :: Sing a -> Sing (IsJust a) +sIsJust SNothing = SFalse +sIsJust (SJust _) = STrue + +pred :: Nat -> Nat +pred Zero = Zero +pred (Succ n) = n + +type family Pred (a :: Nat) :: Nat where + Pred Zero = Zero + Pred (Succ n) = n + +data PredSym0 :: Nat ~> Nat +type instance Apply PredSym0 a = Pred a + +sPred :: forall (t :: Nat). Sing t -> Sing (Pred t) +sPred SZero = SZero +sPred (SSucc n) = n + +map :: (a -> b) -> List a -> List b +map _ Nil = Nil +map f (Cons h t) = Cons (f h) (map f t) + +type family Map (f :: k1 ~> k2) (l :: List k1) :: List k2 where + Map f Nil = Nil + Map f (Cons h t) = Cons (Apply f h) (Map f t) + +-- defunctionalization symbols +data MapSym1 :: (a ~> b) -> List a ~> List b +data MapSym0 :: (a ~> b) ~> List a ~> List b +type instance Apply (MapSym1 f) xs = Map f xs +type instance Apply MapSym0 f = MapSym1 f + +sMap :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). + (forall b. Proxy f -> Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a) +sMap _ SNil = SNil +sMap f (SCons h t) = SCons (f Proxy h) (sMap f t) + +-- Alternative implementation of sMap with Proxy outside of callback. +-- Not generated by the library. +sMap2 :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). Proxy f -> + (forall b. Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a) +sMap2 _ _ SNil = SNil +sMap2 p f (SCons h t) = SCons (f h) (sMap2 p f t) + +-- test sMap +foo :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)) +foo = sMap (\(_ :: Proxy (TyCon1 Succ)) -> SSucc) (SCons (SSucc SZero) (SCons SZero SNil)) + +-- test sMap2 +bar :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)) +bar = sMap2 (Proxy :: Proxy SuccSym0) (SSucc) (SCons (SSucc SZero) (SCons SZero SNil)) + +baz :: Sing (Cons Zero (Cons Zero Nil)) +baz = sMap2 (Proxy :: Proxy PredSym0) (sPred) (SCons (SSucc SZero) (SCons SZero SNil)) + +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys +zipWith _ [] (_:_) = [] +zipWith _ (_:_) [] = [] +zipWith _ [] [] = [] + +type family ZipWith (k1 :: a ~> b ~> c) + (k2 :: List a) + (k3 :: List b) :: List c where + ZipWith f (Cons x xs) (Cons y ys) = Cons (Apply (Apply f x) y) (ZipWith f xs ys) + ZipWith f Nil (Cons z1 z2) = Nil + ZipWith f (Cons z1 z2) Nil = Nil + ZipWith f Nil Nil = Nil + +data ZipWithSym2 :: (a ~> b ~> c) -> List a -> List b ~> List c +data ZipWithSym1 :: (a ~> b ~> c) -> List a ~> List b ~> List c +data ZipWithSym0 :: (a ~> b ~> c) ~> List a ~> List b ~> List c +type instance Apply (ZipWithSym2 f xs) ys = ZipWith f xs ys +type instance Apply (ZipWithSym1 f) xs = ZipWithSym2 f xs +type instance Apply ZipWithSym0 f = ZipWithSym1 f + + +sZipWith :: forall a b c (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b). + (forall (t1 :: a). Proxy k1 -> Sing t1 -> forall (t2 :: b). Sing t2 -> Sing (Apply (Apply k1 t1) t2)) + -> Sing k2 -> Sing k3 -> Sing (ZipWith k1 k2 k3) +sZipWith f (SCons x xs) (SCons y ys) = SCons (f Proxy x y) (sZipWith f xs ys) +sZipWith _ SNil (SCons _ _) = SNil +sZipWith _ (SCons _ _) SNil = SNil +sZipWith _ SNil SNil = SNil + +either :: (a -> c) -> (b -> c) -> Either a b -> c +either l _ (Left x) = l x +either _ r (Right x) = r x + +type family Either_ (l :: a ~> c) (r :: b ~> c) (e :: Either a b) :: c where + Either_ l r (Left x) = Apply l x + Either_ l r (Right x) = Apply r x + +-- defunctionalization symbols +data Either_Sym2 :: (a ~> c) -> (b ~> c) -> Either a b ~> c +data Either_Sym1 :: (a ~> c) -> (b ~> c) ~> Either a b ~> c +data Either_Sym0 :: (a ~> c) ~> (b ~> c) ~> Either a b ~> c +type instance Apply (Either_Sym2 k1 k2) k3 = Either_ k1 k2 k3 +type instance Apply (Either_Sym1 k1) k2 = Either_Sym2 k1 k2 +type instance Apply Either_Sym0 k1 = Either_Sym1 k1 + +sEither :: forall a b c + (l :: a ~> c) + (r :: b ~> c) + (e :: Either a b). + (forall n. Proxy l -> Sing n -> Sing (Apply l n)) -> + (forall n. Proxy r -> Sing n -> Sing (Apply r n)) -> + Sing e -> Sing (Either_ l r e) +sEither l _ (SLeft x) = l Proxy x +sEither _ r (SRight x) = r Proxy x + +-- Alternative implementation of sEither with Proxy outside of callbacks. +-- Not generated by the library. +sEither2 :: forall a b c + (l :: a ~> c) + (r :: b ~> c) + (e :: Either a b). + Proxy l -> Proxy r -> + (forall n. Sing n -> Sing (Apply l n)) -> + (forall n. Sing n -> Sing (Apply r n)) -> + Sing e -> Sing (Either_ l r e) +sEither2 _ _ l _ (SLeft x) = l x +sEither2 _ _ _ r (SRight x) = r x + +eitherFoo :: Sing (Succ (Succ Zero)) +eitherFoo = sEither (\(_ :: Proxy SuccSym0) -> SSucc) + (\(_ :: Proxy PredSym0) -> sPred) (SLeft (SSucc SZero)) + +eitherBar :: Sing Zero +eitherBar = sEither2 (Proxy :: Proxy SuccSym0) + (Proxy :: Proxy PredSym0) + SSucc + sPred (SRight (SSucc SZero)) + +eitherToNat :: Either Nat Nat -> Nat +eitherToNat (Left x) = x +eitherToNat (Right x) = x + +type family EitherToNat (e :: Either Nat Nat) :: Nat where + EitherToNat (Left x) = x + EitherToNat (Right x) = x + +sEitherToNat :: Sing a -> Sing (EitherToNat a) +sEitherToNat (SLeft x) = x +sEitherToNat (SRight x) = x + +liftMaybe :: (a -> b) -> Maybe a -> Maybe b +liftMaybe _ Nothing = Nothing +liftMaybe f (Just a) = Just (f a) + +type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where + LiftMaybe f Nothing = Nothing + LiftMaybe f (Just a) = Just (Apply f a) + +data LiftMaybeSym1 :: (a ~> b) -> Maybe a ~> Maybe b +data LiftMaybeSym0 :: (a ~> b) ~> Maybe a ~> Maybe b +type instance Apply (LiftMaybeSym1 k1) k2 = LiftMaybe k1 k2 +type instance Apply LiftMaybeSym0 k1 = LiftMaybeSym1 k1 + +sLiftMaybe :: forall a b (f :: a ~> b) (x :: Maybe a). + (forall (y :: a). Proxy f -> Sing y -> Sing (Apply f y)) -> + Sing x -> Sing (LiftMaybe f x) +sLiftMaybe _ SNothing = SNothing +sLiftMaybe f (SJust a) = SJust (f Proxy a) + +(+) :: Nat -> Nat -> Nat +Zero + x = x +(Succ x) + y = Succ (x + y) + +type family (+) (m :: Nat) (n :: Nat) :: Nat where + Zero + x = x + (Succ x) + y = Succ (x + y) + +-- defunctionalization symbols +data (+$$) :: Nat -> Nat ~> Nat +data (+$) :: Nat ~> Nat ~> Nat +type instance Apply ((+$$) k1) k2 = (+) k1 k2 +type instance Apply (+$) k1 = (+$$) k1 + +(%+) :: Sing m -> Sing n -> Sing (m + n) +SZero %+ x = x +(SSucc x) %+ y = SSucc (x %+ y) + +(-) :: Nat -> Nat -> Nat +Zero - _ = Zero +(Succ x) - Zero = Succ x +(Succ x) - (Succ y) = x - y + +type family (-) (m :: Nat) (n :: Nat) :: Nat where + Zero - x = Zero + (Succ x) - Zero = Succ x + (Succ x) - (Succ y) = x - y + +data (-$$) :: Nat -> Nat ~> Nat +data (-$) :: Nat ~> Nat ~> Nat +type instance Apply ((-$$) k1) k2 = (-) k1 k2 +type instance Apply (-$) k1 = (-$$) k1 + +(%-) :: Sing m -> Sing n -> Sing (m - n) +SZero %- _ = SZero +(SSucc x) %- SZero = SSucc x +(SSucc x) %- (SSucc y) = x %- y + +isZero :: Nat -> Bool +isZero n = if n == Zero then True else False + +type family IsZero (n :: Nat) :: Bool where + IsZero n = If (n == Zero) True False + +data IsZeroSym0 :: Nat ~> Bool +type instance Apply IsZeroSym0 a = IsZero a + +sIsZero :: Sing n -> Sing (IsZero n) +sIsZero n = sIf (n %== SZero) STrue SFalse + +(||) :: Bool -> Bool -> Bool +False || x = x +True || _ = True + +type family (a :: Bool) || (b :: Bool) :: Bool where + False || x = x + True || x = True + +data (||$$) :: Bool -> Bool ~> Bool +data (||$) :: Bool ~> Bool ~> Bool +type instance Apply ((||$$) a) b = (||) a b +type instance Apply (||$) a = (||$$) a + +(%||) :: Sing a -> Sing b -> Sing (a || b) +SFalse %|| x = x +STrue %|| _ = STrue + +{- +contains :: Eq a => a -> List a -> Bool +contains _ Nil = False +contains elt (Cons h t) = (elt == h) || contains elt t +-} + +type family Contains (a :: k) (b :: List k) :: Bool where + Contains elt Nil = False + Contains elt (Cons h t) = (elt == h) || (Contains elt t) + +data ContainsSym1 :: a -> List a ~> Bool +data ContainsSym0 :: a ~> List a ~> Bool +type instance Apply (ContainsSym1 a) b = Contains a b +type instance Apply ContainsSym0 a = ContainsSym1 a + +{- +sContains :: forall k. SEq k => + forall (a :: k). Sing a -> + forall (list :: List k). Sing list -> Sing (Contains a list) +sContains _ SNil = SFalse +sContains elt (SCons h t) = (elt %== h) %|| (sContains elt t) +-} + +sContains :: forall a (t1 :: a) (t2 :: List a). SEq a => Sing t1 + -> Sing t2 -> Sing (Contains t1 t2) +sContains _ SNil = + let lambda :: forall wild. Sing (Contains wild Nil) + lambda = SFalse + in + lambda +sContains elt (SCons h t) = + let lambda :: forall elt h t. (elt ~ t1, (Cons h t) ~ t2) => Sing elt -> Sing h -> Sing t -> Sing (Contains elt (Cons h t)) + lambda elt' h' t' = (elt' %== h') %|| sContains elt' t' + in + lambda elt h t + +{- +cont :: Eq a => a -> List a -> Bool +cont = \elt list -> case list of + Nil -> False + Cons h t -> (elt == h) || cont elt t +-} + +type family Cont :: a ~> List a ~> Bool where + Cont = Lambda10Sym0 + +data Lambda10Sym0 f where + KindInferenceLambda10Sym0 :: (Lambda10Sym0 @@ arg) ~ Lambda10Sym1 arg + => Proxy arg + -> Lambda10Sym0 f +type instance Lambda10Sym0 `Apply` x = Lambda10Sym1 x + +data Lambda10Sym1 a f where + KindInferenceLambda10Sym1 :: (Lambda10Sym1 a @@ arg) ~ Lambda10Sym2 a arg + => Proxy arg + -> Lambda10Sym1 a f +type instance (Lambda10Sym1 a) `Apply` b = Lambda10Sym2 a b + +type Lambda10Sym2 a b = Lambda10 a b + +type family Lambda10 a b where + Lambda10 elt list = Case10 elt list list + +type family Case10 a b scrut where + Case10 elt list Nil = False + Case10 elt list (Cons h t) = (||$) @@ ((==$) @@ elt @@ h) @@ (Cont @@ elt @@ t) + +data (==$) f where + (:###==$) :: ((==$) @@ arg) ~ (==$$) arg + => Proxy arg + -> (==$) f +type instance (==$) `Apply` x = (==$$) x + +data (==$$) a f where + (:###==$$) :: ((==$$) x @@ arg) ~ (==$$$) x arg + => Proxy arg + -> (==$$) x y +type instance (==$$) a `Apply` b = (==$$$) a b + +type (==$$$) a b = (==) a b + + +impNat :: forall m n. SingI n => Proxy n -> Sing m -> Sing (n + m) +impNat _ sm = (sing :: Sing n) %+ sm + +callImpNat :: forall n m. Sing n -> Sing m -> Sing (n + m) +callImpNat sn sm = withSingI sn (impNat (Proxy :: Proxy n) sm) + +instance Show (Sing (n :: Nat)) where + show SZero = "SZero" + show (SSucc n) = "SSucc (" ++ (show n) ++ ")" + +{- +findIndices :: (a -> Bool) -> [a] -> [Nat] +findIndices p ls = loop Zero ls + where + loop _ [] = [] + loop n (x:xs) | p x = n : loop (Succ n) xs + | otherwise = loop (Succ n) xs +-} + +findIndices' :: forall a. (a -> Bool) -> [a] -> [Nat] +findIndices' p ls = + let loop :: Nat -> [a] -> [Nat] + loop _ [] = [] + loop n (x:xs) = case p x of + True -> n : loop (Succ n) xs + False -> loop (Succ n) xs + in + loop Zero ls + +type family FindIndices (f :: a ~> Bool) (ls :: List a) :: List Nat where + FindIndices p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls + +type family Let123Loop p ls (arg1 :: Nat) (arg2 :: List a) :: List Nat where + Let123Loop p ls z Nil = Nil + Let123Loop p ls n (x `Cons` xs) = Case123 p ls n x xs (p @@ x) + +type family Case123 p ls n x xs scrut where + Case123 p ls n x xs True = n `Cons` ((Let123LoopSym2 p ls) @@ (Succ n) @@ xs) + Case123 p ls n x xs False = (Let123LoopSym2 p ls) @@ (Succ n) @@ xs + +data Let123LoopSym2 a b c where + Let123LoopSym2KindInfernece :: ((Let123LoopSym2 a b @@ z) ~ Let123LoopSym3 a b z) + => Proxy z + -> Let123LoopSym2 a b c +type instance Apply (Let123LoopSym2 a b) c = Let123LoopSym3 a b c + +data Let123LoopSym3 a b c d where + KindInferenceLet123LoopSym3 :: ((Let123LoopSym3 a b c @@ z) ~ Let123LoopSym4 a b c z) + => Proxy z + -> Let123LoopSym3 a b c d +type instance Apply (Let123LoopSym3 a b c) d = Let123LoopSym4 a b c d + +type Let123LoopSym4 a b c d = Let123Loop a b c d + +data FindIndicesSym0 a where + KindInferenceFindIndicesSym0 :: (FindIndicesSym0 @@ z) ~ FindIndicesSym1 z + => Proxy z + -> FindIndicesSym0 a +type instance Apply FindIndicesSym0 a = FindIndicesSym1 a + +data FindIndicesSym1 a b where + KindInferenceFindIndicesSym1 :: (FindIndicesSym1 a @@ z) ~ FindIndicesSym2 a z + => Proxy z + -> FindIndicesSym1 a b +type instance Apply (FindIndicesSym1 a) b = FindIndicesSym2 a b + +type FindIndicesSym2 a b = FindIndices a b + +sFindIndices :: forall a (t1 :: a ~> Bool) (t2 :: (List a)). + Sing t1 + -> Sing t2 + -> Sing (FindIndicesSym0 @@ t1 @@ t2) +sFindIndices sP sLs = + let sLoop :: forall (u1 :: Nat). Sing u1 + -> forall (u2 :: List a). Sing u2 + -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2) + sLoop _ SNil = SNil + sLoop sN (sX `SCons` sXs) = case sP @@ sX of + STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@ + ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs) + SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs + in + (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs + + +fI :: forall a. (a -> Bool) -> [a] -> [Nat] +fI = \p ls -> + let loop :: Nat -> [a] -> [Nat] + loop _ [] = [] + loop n (x:xs) = case p x of + True -> n : loop (Succ n) xs + False -> loop (Succ n) xs + in + loop Zero ls + +type FI = Lambda22Sym0 + +type FISym0 = FI + +type family Lambda22 p ls where + Lambda22 p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls + +data Lambda22Sym0 a where + KindInferenceLambda22Sym0 :: (Lambda22Sym0 @@ z) ~ Lambda22Sym1 z + => Proxy z + -> Lambda22Sym0 a +type instance Apply Lambda22Sym0 a = Lambda22Sym1 a + +data Lambda22Sym1 a b where + KindInferenceLambda22Sym1 :: (Lambda22Sym1 a @@ z) ~ Lambda22Sym2 a z + => Proxy z + -> Lambda22Sym1 a b +type instance Apply (Lambda22Sym1 a) b = Lambda22Sym2 a b + +type Lambda22Sym2 a b = Lambda22 a b + +{- +sFI :: forall a (t1 :: a ~> Bool) (t2 :: List a). Sing t1 + -> Sing t2 + -> Sing (FISym0 @@ t1 @@ t2) +sFI = unSingFun2 (singFun2 @FI (\p ls -> + let lambda :: forall {-(t1 :: a ~> Bool)-} t1 t2. Sing t1 -> Sing t2 -> Sing (Lambda22Sym0 @@ t1 @@ t2) + lambda sP sLs = + let sLoop :: (Lambda22Sym0 @@ t1 @@ t2) ~ (Let123LoopSym2 t1 t2 @@ Zero @@ t2) => forall (u1 :: Nat). Sing u1 + -> forall {-(u2 :: List a)-} u2. Sing u2 + -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2) + sLoop _ SNil = SNil + sLoop sN (sX `SCons` sXs) = case sP @@ sX of + STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@ + ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs) + SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs + in + (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs + in + lambda p ls + )) +-} + +------------------------------------------------------------ + +data G a where + MkG :: G Bool + +data instance Sing :: G a -> Type where + SMkG :: Sing MkG diff --git a/tests/ByHand2.hs b/tests/ByHand2.hs new file mode 100644 --- /dev/null +++ b/tests/ByHand2.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators, + DefaultSignatures, ScopedTypeVariables, InstanceSigs, + MultiParamTypeClasses, FunctionalDependencies, + UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module ByHand2 where + +import Prelude hiding ( Eq(..), Ord(..), Bool(..), Ordering(..), not ) +import Data.Kind (Type) +import Data.Singletons (Sing) + +data Nat = Zero | Succ Nat +data Bool = False | True +data Ordering = LT | EQ | GT + +not :: Bool -> Bool +not False = True +not True = False + +class Eq a where + (==) :: a -> a -> Bool + (/=) :: a -> a -> Bool + infix 4 ==, /= + + x == y = not (x /= y) + x /= y = not (x == y) + +instance Eq Nat where + Zero == Zero = True + Zero == Succ _ = False + Succ _ == Zero = False + Succ x == Succ y = x == y + +data instance Sing :: Bool -> Type where + SFalse :: Sing 'False + STrue :: Sing 'True + +data instance Sing :: Nat -> Type where + SZero :: Sing 'Zero + SSucc :: Sing n -> Sing ('Succ n) + +type family Not (x :: Bool) :: Bool where + Not 'True = 'False + Not 'False = 'True + +sNot :: Sing b -> Sing (Not b) +sNot STrue = SFalse +sNot SFalse = STrue + +class PEq a where + type (==) (x :: a) (y :: a) :: Bool + type (/=) (x :: a) (y :: a) :: Bool + + type x == y = Not (x /= y) + type x /= y = Not (x == y) + +instance PEq Nat where + type 'Zero == 'Zero = 'True + type 'Succ x == 'Zero = 'False + type 'Zero == 'Succ x = 'False + type 'Succ x == 'Succ y = x == y + +class SEq a where + (%==) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x == y) + (%/=) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y) + + default (%==) :: ((x == y) ~ (Not (x /= y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x == y) + x %== y = sNot (x %/= y) + + default (%/=) :: ((x /= y) ~ (Not (x == y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y) + x %/= y = sNot (x %== y) + +instance SEq Nat where + (%==) :: forall (x :: Nat) (y :: Nat). Sing x -> Sing y -> Sing (x == y) + SZero %== SZero = STrue + SSucc _ %== SZero = SFalse + SZero %== SSucc _ = SFalse + SSucc x %== SSucc y = x %== y + +instance Eq Ordering where + LT == LT = True + LT == EQ = False + LT == GT = False + EQ == LT = False + EQ == EQ = True + EQ == GT = False + GT == LT = False + GT == EQ = False + GT == GT = True + +class Eq a => Ord a where + compare :: a -> a -> Ordering + (<) :: a -> a -> Bool + + x < y = compare x y == LT + +class PEq a => POrd a where + type Compare (x :: a) (y :: a) :: Ordering + type (<) (x :: a) (y :: a) :: Bool + + type x < y = Compare x y == 'LT + +instance Ord Nat where + compare Zero Zero = EQ + compare Zero (Succ _) = LT + compare (Succ _) Zero = GT + compare (Succ a) (Succ b) = compare a b + +instance POrd Nat where + type Compare 'Zero 'Zero = 'EQ + type Compare 'Zero ('Succ x) = 'LT + type Compare ('Succ x) 'Zero = 'GT + type Compare ('Succ x) ('Succ y) = Compare x y + +data instance Sing :: Ordering -> Type where + SLT :: Sing 'LT + SEQ :: Sing 'EQ + SGT :: Sing 'GT + +instance PEq Ordering where + type 'LT == 'LT = 'True + type 'LT == 'EQ = 'False + type 'LT == 'GT = 'False + type 'EQ == 'LT = 'False + type 'EQ == 'EQ = 'True + type 'EQ == 'GT = 'False + type 'GT == 'LT = 'False + type 'GT == 'EQ = 'False + type 'GT == 'GT = 'True + +instance SEq Ordering where + SLT %== SLT = STrue + SLT %== SEQ = SFalse + SLT %== SGT = SFalse + SEQ %== SLT = SFalse + SEQ %== SEQ = STrue + SEQ %== SGT = SFalse + SGT %== SLT = SFalse + SGT %== SEQ = SFalse + SGT %== SGT = STrue + +class SEq a => SOrd a where + sCompare :: Sing (x :: a) -> Sing (y :: a) -> Sing (Compare x y) + (%<) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x < y) + + default (%<) :: ((x < y) ~ (Compare x y == 'LT)) => Sing (x :: a) -> Sing (y :: a) -> Sing (x < y) + x %< y = sCompare x y %== SLT + +instance SOrd Nat where + sCompare SZero SZero = SEQ + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + sCompare (SSucc x) (SSucc y) = sCompare x y + +class Pointed a where + point :: a + +class PPointed a where + type Point :: a + +class SPointed a where + sPoint :: Sing (Point :: a) + +instance Pointed Nat where + point = Zero + +instance PPointed Nat where + type Point = 'Zero + +instance SPointed Nat where + sPoint = SZero + +-------------------------------- + +class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + +instance FD Bool Nat where + meth = not + l2r False = Zero + l2r True = Succ Zero + +t1 = meth True +t2 = l2r False + +class PFD a b | a -> b where + type Meth (x :: a) :: a + type L2r (x :: a) :: b + +instance PFD Bool Nat where + type Meth a = Not a + type L2r 'False = 'Zero + type L2r 'True = 'Succ 'Zero + +type T1 = Meth 'True +type T2 = L2r 'False + +class SFD a b | a -> b where + sMeth :: forall (x :: a). Sing x -> Sing (Meth x :: a) + sL2r :: forall (x :: a). Sing x -> Sing (L2r x :: b) + +instance SFD Bool Nat where + sMeth x = sNot x + sL2r SFalse = SZero + sL2r STrue = SSucc SZero + +sT1 = sMeth STrue +sT2 :: Sing (T2 :: Nat) +sT2 = sL2r SFalse diff --git a/tests/SingletonsTestSuite.hs b/tests/SingletonsTestSuite.hs --- a/tests/SingletonsTestSuite.hs +++ b/tests/SingletonsTestSuite.hs @@ -63,12 +63,15 @@ , compileAndDumpStdTest "T145" , compileAndDumpStdTest "PolyKinds" , compileAndDumpStdTest "PolyKindsApp" + , compileAndDumpStdTest "T160" , compileAndDumpStdTest "T163" , compileAndDumpStdTest "T166" , compileAndDumpStdTest "T172" , compileAndDumpStdTest "T175" , compileAndDumpStdTest "T176" , compileAndDumpStdTest "T178" + , compileAndDumpStdTest "T183" + , compileAndDumpStdTest "T184" , compileAndDumpStdTest "T187" , compileAndDumpStdTest "T190" , compileAndDumpStdTest "ShowDeriving" @@ -79,11 +82,26 @@ , compileAndDumpStdTest "T200" , compileAndDumpStdTest "T206" , compileAndDumpStdTest "T209" + , compileAndDumpStdTest "T216" , compileAndDumpStdTest "T226" , compileAndDumpStdTest "T229" , compileAndDumpStdTest "T249" , compileAndDumpStdTest "OverloadedStrings" , compileAndDumpStdTest "T271" + , compileAndDumpStdTest "T287" + , compileAndDumpStdTest "TypeRepTYPE" + , compileAndDumpStdTest "T297" + , compileAndDumpStdTest "T312" + , compileAndDumpStdTest "T313" + , compileAndDumpStdTest "T316" + , compileAndDumpStdTest "T322" + , compileAndDumpStdTest "NatSymbolReflexive" + , compileAndDumpStdTest "T323" + , compileAndDumpStdTest "T332" + , compileAndDumpStdTest "T342" + , compileAndDumpStdTest "FunctorLikeDeriving" + , compileAndDumpStdTest "T353" + , compileAndDumpStdTest "T358" ], testCompileAndDumpGroup "Promote" [ compileAndDumpStdTest "Constructors" @@ -92,6 +110,7 @@ , compileAndDumpStdTest "Pragmas" , compileAndDumpStdTest "Prelude" , compileAndDumpStdTest "T180" + , compileAndDumpStdTest "T361" ], testGroup "Database client" [ compileAndDumpTest "GradingClient/Database" ghcOpts diff --git a/tests/SingletonsTestSuiteUtils.hs b/tests/SingletonsTestSuiteUtils.hs --- a/tests/SingletonsTestSuiteUtils.hs +++ b/tests/SingletonsTestSuiteUtils.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module SingletonsTestSuiteUtils ( compileAndDumpTest , compileAndDumpStdTest @@ -7,77 +10,42 @@ , cleanFiles ) where +import Build_singletons ( ghcPath, ghcFlags, rootDir ) import Control.Exception ( Exception, throw ) -import Control.Monad ( liftM ) -import Data.List ( intercalate, find, isPrefixOf ) -import Data.Typeable ( Typeable ) +import Data.List ( intercalate ) import System.Exit ( ExitCode(..) ) import System.FilePath ( takeBaseName, pathSeparator ) import System.IO ( IOMode(..), hGetContents, openFile ) -import System.IO.Unsafe ( unsafePerformIO ) +import System.FilePath ( () ) import System.Process ( CreateProcess(..), StdStream(..) , createProcess, proc, waitForProcess , callCommand ) -import System.Directory ( doesFileExist ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.Golden ( goldenVsFileDiff ) -#ifndef CURRENT_PACKAGE_KEY -#include "../dist/build/autogen/cabal_macros.h" -#endif - -- Some infractructure for handling external process errors -data ProcessException = ProcessException String deriving (Typeable) - -instance Exception ProcessException - -instance Show ProcessException where - show (ProcessException msg) = msg --- GHC executable name (if on path) or full path -ghcPath :: FilePath -ghcPath = "ghc" +newtype ProcessException = ProcessException String + deriving newtype (Eq, Ord, Show) + deriving anyclass Exception -- directory storing compile-and-run tests and golden files goldenPath :: FilePath -goldenPath = "tests/compile-and-dump/" - --- path containing compiled *.hi files. Relative to goldenPath. --- See Note [-package-name hack] -includePath :: FilePath -includePath = "../../dist/build" +goldenPath = rootDir "tests/compile-and-dump/" ghcVersion :: String -ghcVersion = ".ghc84" - --- If a cabal sandbox is present, use its package database instead of the global one. -extraOpts :: [String] -extraOpts = unsafePerformIO $ do - sandboxed <- doesFileExist "cabal.sandbox.config" - if sandboxed - then do - let prefix = "package-db: " - opts_from_config config = - case find (prefix `isPrefixOf`) $ lines config of - Nothing -> [] - Just db_line -> let package_db = drop (length prefix) db_line in - [ "-no-user-package-db" - , "-package-db " ++ package_db ] - opts_from_config `liftM` readFile "cabal.sandbox.config" - else return [] +ghcVersion = ".ghc86" -- GHC options used when running the tests ghcOpts :: [String] -ghcOpts = extraOpts ++ [ +ghcOpts = ghcFlags ++ [ "-v0" , "-c" - , "-this-unit-id " ++ CURRENT_PACKAGE_KEY -- See Note [-this-unit-id hack] , "-ddump-splices" , "-dsuppress-uniques" , "-fforce-recomp" , "-fprint-explicit-kinds" , "-O0" - , "-i" ++ includePath -- necessary because some tests use these modules - , "-itests/compile-and-dump" + , "-i" ++ goldenPath , "-XTemplateHaskell" , "-XDataKinds" , "-XKindSignatures" @@ -97,24 +65,13 @@ , "-XInstanceSigs" , "-XDefaultSignatures" , "-XCPP" - , "-XTypeInType" , "-XStandaloneDeriving" , "-XTypeApplications" , "-XEmptyCase" + , "-XNoStarIsType" + , "-XQuantifiedConstraints" ] --- Note [-this-unit-id hack] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- We want to avoid installing singletons package before running the --- testsuite, because in this way we prevent double compilation of the --- library. To do this we pass -this-unit-id option to GHC to convince --- it that the test files are actually part of the current --- package. This means that library doesn't have to be installed --- globally and interface files generated during library compilation --- can be used when compiling test cases. We use "-i" option to point --- GHC to directory containing compiled interface files. - -- Compile a test using specified GHC options. Save output to file, filter with -- sed and compare it with golden file. This function also builds golden file -- from a template file. Putting it here is a bit of a hack but it's easy and it @@ -216,6 +173,10 @@ , "-e", "'s/[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/0123456789876543210/g'" , "-e", "'s/[!#$%&*+./>]\\{10\\}/%%%%%%%%%%/g'" , "-e", "'s/[!#$%&*+./>]\\{19\\}/%%%%%%%%%%%%%%%%%%%/g'" + -- Remove pretty-printed references to the singletons package + -- (e.g., turn `singletons-2.4.1:Sing` into `Sing`) to make the output + -- more stable. + , "-e", "'s/singletons-[0-9]\\+\\(\\.[0-9]\\+\\)*://g'" , file ] @@ -223,7 +184,7 @@ buildGoldenFile templateFilePath goldenFilePath = do hGoldenFile <- openFile goldenFilePath WriteMode runProcessWithOpts (UseHandle hGoldenFile) "awk" - [ "-f", "tests/compile-and-dump/buildGoldenFiles.awk" + [ "-f", goldenPath "buildGoldenFiles.awk" , templateFilePath ] @@ -242,4 +203,4 @@ throw $ ProcessException ("Error when running " ++ program ++ ":\n" ++ err) cleanFiles :: IO () -cleanFiles = callCommand "rm -f tests/compile-and-dump/*/*.{hi,o}" +cleanFiles = callCommand $ "rm -f " ++ rootDir "tests/compile-and-dump/*/*.{hi,o}" diff --git a/tests/compile-and-dump/GradingClient/Database.ghc84.template b/tests/compile-and-dump/GradingClient/Database.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/GradingClient/Database.ghc84.template +++ /dev/null @@ -1,2563 +0,0 @@ -GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Nat - = Zero | Succ Nat - deriving (Eq, Ord) |] - ======> - data Nat - = Zero | Succ Nat - deriving (Eq, Ord) - type ZeroSym0 = Zero - type SuccSym1 (t :: Nat) = Succ t - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) - data SuccSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b - Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 - instance PEq Nat where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: Nat) - where - SZero :: Sing Zero - SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) - type SNat = (Sing :: Nat -> Type) - instance SingKind Nat where - type Demote Nat = Nat - fromSing SZero = Zero - fromSing (SSucc b) = Succ (fromSing b) - toSing Zero = SomeSing SZero - toSing (Succ (b :: Demote Nat)) - = case toSing b :: SomeSing Nat of { - SomeSing c -> SomeSing (SSucc c) } - instance SOrd Nat => SOrd Nat where - sCompare :: - forall (t1 :: Nat) (t2 :: Nat). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering - -> Type) - -> Type) t1) t2) - sCompare SZero SZero - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - instance SEq Nat => SEq Nat where - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) (SSucc a) (SSucc b) = ((%==) a) b - instance SDecide Nat => SDecide Nat where - (%~) SZero SZero = Proved Refl - (%~) SZero (SSucc _) = Disproved (\ x -> case x of) - (%~) (SSucc _) SZero = Disproved (\ x -> case x of) - (%~) (SSucc a) (SSucc b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing -GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| append :: Schema -> Schema -> Schema - append (Sch s1) (Sch s2) = Sch (s1 ++ s2) - attrNotIn :: Attribute -> Schema -> Bool - attrNotIn _ (Sch []) = True - attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) - = (name /= name') && (attrNotIn (Attr name u) (Sch t)) - disjoint :: Schema -> Schema -> Bool - disjoint (Sch []) _ = True - disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) - occurs :: [AChar] -> Schema -> Bool - occurs _ (Sch []) = False - occurs name (Sch ((Attr name' _) : attrs)) - = name == name' || occurs name (Sch attrs) - lookup :: [AChar] -> Schema -> U - lookup _ (Sch []) = undefined - lookup name (Sch ((Attr name' u) : attrs)) - = if name == name' then u else lookup name (Sch attrs) - - data U - = BOOL | STRING | NAT | VEC U Nat - deriving (Read, Eq, Show) - data AChar - = CA | - CB | - CC | - CD | - CE | - CF | - CG | - CH | - CI | - CJ | - CK | - CL | - CM | - CN | - CO | - CP | - CQ | - CR | - CS | - CT | - CU | - CV | - CW | - CX | - CY | - CZ - deriving (Read, Show, Eq) - data Attribute = Attr [AChar] U - data Schema = Sch [Attribute] |] - ======> - data U - = BOOL | STRING | NAT | VEC U Nat - deriving (Read, Eq, Show) - data AChar - = CA | - CB | - CC | - CD | - CE | - CF | - CG | - CH | - CI | - CJ | - CK | - CL | - CM | - CN | - CO | - CP | - CQ | - CR | - CS | - CT | - CU | - CV | - CW | - CX | - CY | - CZ - deriving (Read, Show, Eq) - data Attribute = Attr [AChar] U - data Schema = Sch [Attribute] - append :: Schema -> Schema -> Schema - append (Sch s1) (Sch s2) = Sch (s1 ++ s2) - attrNotIn :: Attribute -> Schema -> Bool - attrNotIn _ (Sch GHC.Types.[]) = True - attrNotIn (Attr name u) (Sch (Attr name' _ GHC.Types.: t)) - = ((name /= name') && ((attrNotIn ((Attr name) u)) (Sch t))) - disjoint :: Schema -> Schema -> Bool - disjoint (Sch GHC.Types.[]) _ = True - disjoint (Sch (h GHC.Types.: t)) s - = (((attrNotIn h) s) && ((disjoint (Sch t)) s)) - occurs :: [AChar] -> Schema -> Bool - occurs _ (Sch GHC.Types.[]) = False - occurs name (Sch (Attr name' _ GHC.Types.: attrs)) - = ((name == name') || ((occurs name) (Sch attrs))) - lookup :: [AChar] -> Schema -> U - lookup _ (Sch GHC.Types.[]) = undefined - lookup name (Sch (Attr name' u GHC.Types.: attrs)) - = if (name == name') then u else (lookup name) (Sch attrs) - type BOOLSym0 = BOOL - type STRINGSym0 = STRING - type NATSym0 = NAT - type VECSym2 (t :: U) (t :: Nat) = VEC t t - instance SuppressUnusedWarnings VECSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) VECSym1KindInference) GHC.Tuple.()) - data VECSym1 (l :: U) (l :: TyFun Nat U) - = forall arg. SameKind (Apply (VECSym1 l) arg) (VECSym2 l arg) => - VECSym1KindInference - type instance Apply (VECSym1 l) l = VEC l l - instance SuppressUnusedWarnings VECSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) VECSym0KindInference) GHC.Tuple.()) - data VECSym0 (l :: TyFun U (TyFun Nat U -> Type)) - = forall arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => - VECSym0KindInference - type instance Apply VECSym0 l = VECSym1 l - type CASym0 = CA - type CBSym0 = CB - type CCSym0 = CC - type CDSym0 = CD - type CESym0 = CE - type CFSym0 = CF - type CGSym0 = CG - type CHSym0 = CH - type CISym0 = CI - type CJSym0 = CJ - type CKSym0 = CK - type CLSym0 = CL - type CMSym0 = CM - type CNSym0 = CN - type COSym0 = CO - type CPSym0 = CP - type CQSym0 = CQ - type CRSym0 = CR - type CSSym0 = CS - type CTSym0 = CT - type CUSym0 = CU - type CVSym0 = CV - type CWSym0 = CW - type CXSym0 = CX - type CYSym0 = CY - type CZSym0 = CZ - type AttrSym2 (t :: [AChar]) (t :: U) = Attr t t - instance SuppressUnusedWarnings AttrSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AttrSym1KindInference) GHC.Tuple.()) - data AttrSym1 (l :: [AChar]) (l :: TyFun U Attribute) - = forall arg. SameKind (Apply (AttrSym1 l) arg) (AttrSym2 l arg) => - AttrSym1KindInference - type instance Apply (AttrSym1 l) l = Attr l l - instance SuppressUnusedWarnings AttrSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AttrSym0KindInference) GHC.Tuple.()) - data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type)) - = forall arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => - AttrSym0KindInference - type instance Apply AttrSym0 l = AttrSym1 l - type SchSym1 (t :: [Attribute]) = Sch t - instance SuppressUnusedWarnings SchSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SchSym0KindInference) GHC.Tuple.()) - data SchSym0 (l :: TyFun [Attribute] Schema) - = forall arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => - SchSym0KindInference - type instance Apply SchSym0 l = Sch l - type Let0123456789876543210Scrutinee_0123456789876543210Sym4 t t t t = - Let0123456789876543210Scrutinee_0123456789876543210 t t t t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym3 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 l l l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l - type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where - Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name' - type family Case_0123456789876543210 name name' u attrs t where - Case_0123456789876543210 name name' u attrs True = u - Case_0123456789876543210 name name' u attrs False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) - type LookupSym2 (t :: [AChar]) (t :: Schema) = Lookup t t - instance SuppressUnusedWarnings LookupSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LookupSym1KindInference) GHC.Tuple.()) - data LookupSym1 (l :: [AChar]) (l :: TyFun Schema U) - = forall arg. SameKind (Apply (LookupSym1 l) arg) (LookupSym2 l arg) => - LookupSym1KindInference - type instance Apply (LookupSym1 l) l = Lookup l l - instance SuppressUnusedWarnings LookupSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LookupSym0KindInference) GHC.Tuple.()) - data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type)) - = forall arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => - LookupSym0KindInference - type instance Apply LookupSym0 l = LookupSym1 l - type OccursSym2 (t :: [AChar]) (t :: Schema) = Occurs t t - instance SuppressUnusedWarnings OccursSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) OccursSym1KindInference) GHC.Tuple.()) - data OccursSym1 (l :: [AChar]) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (OccursSym1 l) arg) (OccursSym2 l arg) => - OccursSym1KindInference - type instance Apply (OccursSym1 l) l = Occurs l l - instance SuppressUnusedWarnings OccursSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) OccursSym0KindInference) GHC.Tuple.()) - data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type)) - = forall arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => - OccursSym0KindInference - type instance Apply OccursSym0 l = OccursSym1 l - type AttrNotInSym2 (t :: Attribute) (t :: Schema) = AttrNotIn t t - instance SuppressUnusedWarnings AttrNotInSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AttrNotInSym1KindInference) GHC.Tuple.()) - data AttrNotInSym1 (l :: Attribute) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (AttrNotInSym1 l) arg) (AttrNotInSym2 l arg) => - AttrNotInSym1KindInference - type instance Apply (AttrNotInSym1 l) l = AttrNotIn l l - instance SuppressUnusedWarnings AttrNotInSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AttrNotInSym0KindInference) GHC.Tuple.()) - data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool - -> Type)) - = forall arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => - AttrNotInSym0KindInference - type instance Apply AttrNotInSym0 l = AttrNotInSym1 l - type DisjointSym2 (t :: Schema) (t :: Schema) = Disjoint t t - instance SuppressUnusedWarnings DisjointSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DisjointSym1KindInference) GHC.Tuple.()) - data DisjointSym1 (l :: Schema) (l :: TyFun Schema Bool) - = forall arg. SameKind (Apply (DisjointSym1 l) arg) (DisjointSym2 l arg) => - DisjointSym1KindInference - type instance Apply (DisjointSym1 l) l = Disjoint l l - instance SuppressUnusedWarnings DisjointSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DisjointSym0KindInference) GHC.Tuple.()) - data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type)) - = forall arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => - DisjointSym0KindInference - type instance Apply DisjointSym0 l = DisjointSym1 l - type AppendSym2 (t :: Schema) (t :: Schema) = Append t t - instance SuppressUnusedWarnings AppendSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AppendSym1KindInference) GHC.Tuple.()) - data AppendSym1 (l :: Schema) (l :: TyFun Schema Schema) - = forall arg. SameKind (Apply (AppendSym1 l) arg) (AppendSym2 l arg) => - AppendSym1KindInference - type instance Apply (AppendSym1 l) l = Append l l - instance SuppressUnusedWarnings AppendSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) AppendSym0KindInference) GHC.Tuple.()) - data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type)) - = forall arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => - AppendSym0KindInference - type instance Apply AppendSym0 l = AppendSym1 l - type family Lookup (a :: [AChar]) (a :: Schema) :: U where - Lookup _ (Sch '[]) = UndefinedSym0 - Lookup name (Sch ((:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) - type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where - Occurs _ (Sch '[]) = FalseSym0 - Occurs name (Sch ((:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) - type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where - AttrNotIn _ (Sch '[]) = TrueSym0 - AttrNotIn (Attr name u) (Sch ((:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) - type family Disjoint (a :: Schema) (a :: Schema) :: Bool where - Disjoint (Sch '[]) _ = TrueSym0 - Disjoint (Sch ((:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) - type family Append (a :: Schema) (a :: Schema) :: Schema where - Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ BOOL a_0123456789876543210 = Apply (Apply ShowStringSym0 "BOOL") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: U) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: U) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun U (TyFun Symbol Symbol - -> Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun U (TyFun Symbol Symbol - -> Type) - -> Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow U where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ CA a_0123456789876543210 = Apply (Apply ShowStringSym0 "CA") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CB a_0123456789876543210 = Apply (Apply ShowStringSym0 "CB") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CC a_0123456789876543210 = Apply (Apply ShowStringSym0 "CC") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CD a_0123456789876543210 = Apply (Apply ShowStringSym0 "CD") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CE a_0123456789876543210 = Apply (Apply ShowStringSym0 "CE") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CF a_0123456789876543210 = Apply (Apply ShowStringSym0 "CF") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CG a_0123456789876543210 = Apply (Apply ShowStringSym0 "CG") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CH a_0123456789876543210 = Apply (Apply ShowStringSym0 "CH") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CI a_0123456789876543210 = Apply (Apply ShowStringSym0 "CI") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CJ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CJ") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CK a_0123456789876543210 = Apply (Apply ShowStringSym0 "CK") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CL a_0123456789876543210 = Apply (Apply ShowStringSym0 "CL") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CM a_0123456789876543210 = Apply (Apply ShowStringSym0 "CM") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CN a_0123456789876543210 = Apply (Apply ShowStringSym0 "CN") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CO a_0123456789876543210 = Apply (Apply ShowStringSym0 "CO") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CP a_0123456789876543210 = Apply (Apply ShowStringSym0 "CP") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CQ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CQ") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CR a_0123456789876543210 = Apply (Apply ShowStringSym0 "CR") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CS a_0123456789876543210 = Apply (Apply ShowStringSym0 "CS") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CT a_0123456789876543210 = Apply (Apply ShowStringSym0 "CT") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CU a_0123456789876543210 = Apply (Apply ShowStringSym0 "CU") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CV a_0123456789876543210 = Apply (Apply ShowStringSym0 "CV") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CW a_0123456789876543210 = Apply (Apply ShowStringSym0 "CW") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: AChar) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: AChar) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun AChar (TyFun Symbol Symbol - -> Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun AChar (TyFun Symbol Symbol - -> Type) - -> Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow AChar where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where - Equals_0123456789876543210 BOOL BOOL = TrueSym0 - Equals_0123456789876543210 STRING STRING = TrueSym0 - Equals_0123456789876543210 NAT NAT = TrueSym0 - Equals_0123456789876543210 (VEC a a) (VEC b b) = (&&) ((==) a b) ((==) a b) - Equals_0123456789876543210 (_ :: U) (_ :: U) = FalseSym0 - instance PEq U where - type (==) a b = Equals_0123456789876543210 a b - type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where - Equals_0123456789876543210 CA CA = TrueSym0 - Equals_0123456789876543210 CB CB = TrueSym0 - Equals_0123456789876543210 CC CC = TrueSym0 - Equals_0123456789876543210 CD CD = TrueSym0 - Equals_0123456789876543210 CE CE = TrueSym0 - Equals_0123456789876543210 CF CF = TrueSym0 - Equals_0123456789876543210 CG CG = TrueSym0 - Equals_0123456789876543210 CH CH = TrueSym0 - Equals_0123456789876543210 CI CI = TrueSym0 - Equals_0123456789876543210 CJ CJ = TrueSym0 - Equals_0123456789876543210 CK CK = TrueSym0 - Equals_0123456789876543210 CL CL = TrueSym0 - Equals_0123456789876543210 CM CM = TrueSym0 - Equals_0123456789876543210 CN CN = TrueSym0 - Equals_0123456789876543210 CO CO = TrueSym0 - Equals_0123456789876543210 CP CP = TrueSym0 - Equals_0123456789876543210 CQ CQ = TrueSym0 - Equals_0123456789876543210 CR CR = TrueSym0 - Equals_0123456789876543210 CS CS = TrueSym0 - Equals_0123456789876543210 CT CT = TrueSym0 - Equals_0123456789876543210 CU CU = TrueSym0 - Equals_0123456789876543210 CV CV = TrueSym0 - Equals_0123456789876543210 CW CW = TrueSym0 - Equals_0123456789876543210 CX CX = TrueSym0 - Equals_0123456789876543210 CY CY = TrueSym0 - Equals_0123456789876543210 CZ CZ = TrueSym0 - Equals_0123456789876543210 (_ :: AChar) (_ :: AChar) = FalseSym0 - instance PEq AChar where - type (==) a b = Equals_0123456789876543210 a b - sLookup :: - forall (t :: [AChar]) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) - sOccurs :: - forall (t :: [AChar]) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) - sAttrNotIn :: - forall (t :: Attribute) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) - sDisjoint :: - forall (t :: Schema) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) - sAppend :: - forall (t :: Schema) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) - sLookup _ (SSch SNil) = sUndefined - sLookup - (sName :: Sing name) - (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u)) - (sAttrs :: Sing attrs))) - = let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) - sScrutinee_0123456789876543210 - = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) - sName' - in case sScrutinee_0123456789876543210 of - STrue -> sU - SFalse - -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName)) - ((applySing ((singFun1 @SchSym0) SSch)) sAttrs) :: - Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U) - sOccurs _ (SSch SNil) = SFalse - sOccurs - (sName :: Sing name) - (SSch (SCons (SAttr (sName' :: Sing name') _) - (sAttrs :: Sing attrs))) - = (applySing - ((applySing ((singFun2 @(||@#@$)) (%||))) - ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) - sName'))) - ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) - ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) - sAttrNotIn _ (SSch SNil) = STrue - sAttrNotIn - (SAttr (sName :: Sing name) (sU :: Sing u)) - (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) - = (applySing - ((applySing ((singFun2 @(&&@#@$)) (%&&))) - ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) - sName'))) - ((applySing - ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) - ((applySing ((singFun1 @SchSym0) SSch)) sT)) - sDisjoint (SSch SNil) _ = STrue - sDisjoint - (SSch (SCons (sH :: Sing h) (sT :: Sing t))) - (sS :: Sing s) - = (applySing - ((applySing ((singFun2 @(&&@#@$)) (%&&))) - ((applySing - ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH)) - sS))) - ((applySing - ((applySing ((singFun2 @DisjointSym0) sDisjoint)) - ((applySing ((singFun1 @SchSym0) SSch)) sT))) - sS) - sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2) - data instance Sing (z :: U) - where - SBOOL :: Sing BOOL - SSTRING :: Sing STRING - SNAT :: Sing NAT - SVEC :: forall (n :: U) (n :: Nat). - (Sing (n :: U)) -> (Sing (n :: Nat)) -> Sing (VEC n n) - type SU = (Sing :: U -> Type) - instance SingKind U where - type Demote U = U - fromSing SBOOL = BOOL - fromSing SSTRING = STRING - fromSing SNAT = NAT - fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b) - toSing BOOL = SomeSing SBOOL - toSing STRING = SomeSing SSTRING - toSing NAT = SomeSing SNAT - toSing (VEC (b :: Demote U) (b :: Demote Nat)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) } - data instance Sing (z :: AChar) - where - SCA :: Sing CA - SCB :: Sing CB - SCC :: Sing CC - SCD :: Sing CD - SCE :: Sing CE - SCF :: Sing CF - SCG :: Sing CG - SCH :: Sing CH - SCI :: Sing CI - SCJ :: Sing CJ - SCK :: Sing CK - SCL :: Sing CL - SCM :: Sing CM - SCN :: Sing CN - SCO :: Sing CO - SCP :: Sing CP - SCQ :: Sing CQ - SCR :: Sing CR - SCS :: Sing CS - SCT :: Sing CT - SCU :: Sing CU - SCV :: Sing CV - SCW :: Sing CW - SCX :: Sing CX - SCY :: Sing CY - SCZ :: Sing CZ - type SAChar = (Sing :: AChar -> Type) - instance SingKind AChar where - type Demote AChar = AChar - fromSing SCA = CA - fromSing SCB = CB - fromSing SCC = CC - fromSing SCD = CD - fromSing SCE = CE - fromSing SCF = CF - fromSing SCG = CG - fromSing SCH = CH - fromSing SCI = CI - fromSing SCJ = CJ - fromSing SCK = CK - fromSing SCL = CL - fromSing SCM = CM - fromSing SCN = CN - fromSing SCO = CO - fromSing SCP = CP - fromSing SCQ = CQ - fromSing SCR = CR - fromSing SCS = CS - fromSing SCT = CT - fromSing SCU = CU - fromSing SCV = CV - fromSing SCW = CW - fromSing SCX = CX - fromSing SCY = CY - fromSing SCZ = CZ - toSing CA = SomeSing SCA - toSing CB = SomeSing SCB - toSing CC = SomeSing SCC - toSing CD = SomeSing SCD - toSing CE = SomeSing SCE - toSing CF = SomeSing SCF - toSing CG = SomeSing SCG - toSing CH = SomeSing SCH - toSing CI = SomeSing SCI - toSing CJ = SomeSing SCJ - toSing CK = SomeSing SCK - toSing CL = SomeSing SCL - toSing CM = SomeSing SCM - toSing CN = SomeSing SCN - toSing CO = SomeSing SCO - toSing CP = SomeSing SCP - toSing CQ = SomeSing SCQ - toSing CR = SomeSing SCR - toSing CS = SomeSing SCS - toSing CT = SomeSing SCT - toSing CU = SomeSing SCU - toSing CV = SomeSing SCV - toSing CW = SomeSing SCW - toSing CX = SomeSing SCX - toSing CY = SomeSing SCY - toSing CZ = SomeSing SCZ - data instance Sing (z :: Attribute) - where - SAttr :: forall (n :: [AChar]) (n :: U). - (Sing (n :: [AChar])) -> (Sing (n :: U)) -> Sing (Attr n n) - type SAttribute = (Sing :: Attribute -> Type) - instance SingKind Attribute where - type Demote Attribute = Attribute - fromSing (SAttr b b) = (Attr (fromSing b)) (fromSing b) - toSing (Attr (b :: Demote [AChar]) (b :: Demote U)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing [AChar])) - (toSing b :: SomeSing U) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) } - data instance Sing (z :: Schema) - where - SSch :: forall (n :: [Attribute]). - (Sing (n :: [Attribute])) -> Sing (Sch n) - type SSchema = (Sing :: Schema -> Type) - instance SingKind Schema where - type Demote Schema = Schema - fromSing (SSch b) = Sch (fromSing b) - toSing (Sch (b :: Demote [Attribute])) - = case toSing b :: SomeSing [Attribute] of { - SomeSing c -> SomeSing (SSch c) } - instance (SShow U, SShow Nat) => SShow U where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: U) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun U (TyFun Symbol Symbol - -> Type) - -> Type) - -> Type) t1) t2) t3) - sShowsPrec - _ - SBOOL - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "BOOL"))) - sA_0123456789876543210 - sShowsPrec - _ - SSTRING - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "STRING"))) - sA_0123456789876543210 - sShowsPrec - _ - SNAT - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "NAT"))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SVEC (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "VEC ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - instance SShow AChar where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: AChar) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun AChar (TyFun Symbol Symbol - -> Type) - -> Type) - -> Type) t1) t2) t3) - sShowsPrec - _ - SCA - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CA"))) - sA_0123456789876543210 - sShowsPrec - _ - SCB - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CB"))) - sA_0123456789876543210 - sShowsPrec - _ - SCC - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CC"))) - sA_0123456789876543210 - sShowsPrec - _ - SCD - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CD"))) - sA_0123456789876543210 - sShowsPrec - _ - SCE - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CE"))) - sA_0123456789876543210 - sShowsPrec - _ - SCF - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CF"))) - sA_0123456789876543210 - sShowsPrec - _ - SCG - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CG"))) - sA_0123456789876543210 - sShowsPrec - _ - SCH - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CH"))) - sA_0123456789876543210 - sShowsPrec - _ - SCI - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CI"))) - sA_0123456789876543210 - sShowsPrec - _ - SCJ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CJ"))) - sA_0123456789876543210 - sShowsPrec - _ - SCK - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CK"))) - sA_0123456789876543210 - sShowsPrec - _ - SCL - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CL"))) - sA_0123456789876543210 - sShowsPrec - _ - SCM - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CM"))) - sA_0123456789876543210 - sShowsPrec - _ - SCN - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CN"))) - sA_0123456789876543210 - sShowsPrec - _ - SCO - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CO"))) - sA_0123456789876543210 - sShowsPrec - _ - SCP - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CP"))) - sA_0123456789876543210 - sShowsPrec - _ - SCQ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CQ"))) - sA_0123456789876543210 - sShowsPrec - _ - SCR - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CR"))) - sA_0123456789876543210 - sShowsPrec - _ - SCS - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CS"))) - sA_0123456789876543210 - sShowsPrec - _ - SCT - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CT"))) - sA_0123456789876543210 - sShowsPrec - _ - SCU - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CU"))) - sA_0123456789876543210 - sShowsPrec - _ - SCV - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CV"))) - sA_0123456789876543210 - sShowsPrec - _ - SCW - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CW"))) - sA_0123456789876543210 - sShowsPrec - _ - SCX - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CX"))) - sA_0123456789876543210 - sShowsPrec - _ - SCY - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CY"))) - sA_0123456789876543210 - sShowsPrec - _ - SCZ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "CZ"))) - sA_0123456789876543210 - instance (SEq U, SEq Nat) => SEq U where - (%==) SBOOL SBOOL = STrue - (%==) SBOOL SSTRING = SFalse - (%==) SBOOL SNAT = SFalse - (%==) SBOOL (SVEC _ _) = SFalse - (%==) SSTRING SBOOL = SFalse - (%==) SSTRING SSTRING = STrue - (%==) SSTRING SNAT = SFalse - (%==) SSTRING (SVEC _ _) = SFalse - (%==) SNAT SBOOL = SFalse - (%==) SNAT SSTRING = SFalse - (%==) SNAT SNAT = STrue - (%==) SNAT (SVEC _ _) = SFalse - (%==) (SVEC _ _) SBOOL = SFalse - (%==) (SVEC _ _) SSTRING = SFalse - (%==) (SVEC _ _) SNAT = SFalse - (%==) (SVEC a a) (SVEC b b) = ((%&&) (((%==) a) b)) (((%==) a) b) - instance (SDecide U, SDecide Nat) => SDecide U where - (%~) SBOOL SBOOL = Proved Refl - (%~) SBOOL SSTRING = Disproved (\ x -> case x of) - (%~) SBOOL SNAT = Disproved (\ x -> case x of) - (%~) SBOOL (SVEC _ _) = Disproved (\ x -> case x of) - (%~) SSTRING SBOOL = Disproved (\ x -> case x of) - (%~) SSTRING SSTRING = Proved Refl - (%~) SSTRING SNAT = Disproved (\ x -> case x of) - (%~) SSTRING (SVEC _ _) = Disproved (\ x -> case x of) - (%~) SNAT SBOOL = Disproved (\ x -> case x of) - (%~) SNAT SSTRING = Disproved (\ x -> case x of) - (%~) SNAT SNAT = Proved Refl - (%~) SNAT (SVEC _ _) = Disproved (\ x -> case x of) - (%~) (SVEC _ _) SBOOL = Disproved (\ x -> case x of) - (%~) (SVEC _ _) SSTRING = Disproved (\ x -> case x of) - (%~) (SVEC _ _) SNAT = Disproved (\ x -> case x of) - (%~) (SVEC a a) (SVEC b b) - = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of - GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl - GHC.Tuple.(,) (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,) _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SEq AChar where - (%==) SCA SCA = STrue - (%==) SCA SCB = SFalse - (%==) SCA SCC = SFalse - (%==) SCA SCD = SFalse - (%==) SCA SCE = SFalse - (%==) SCA SCF = SFalse - (%==) SCA SCG = SFalse - (%==) SCA SCH = SFalse - (%==) SCA SCI = SFalse - (%==) SCA SCJ = SFalse - (%==) SCA SCK = SFalse - (%==) SCA SCL = SFalse - (%==) SCA SCM = SFalse - (%==) SCA SCN = SFalse - (%==) SCA SCO = SFalse - (%==) SCA SCP = SFalse - (%==) SCA SCQ = SFalse - (%==) SCA SCR = SFalse - (%==) SCA SCS = SFalse - (%==) SCA SCT = SFalse - (%==) SCA SCU = SFalse - (%==) SCA SCV = SFalse - (%==) SCA SCW = SFalse - (%==) SCA SCX = SFalse - (%==) SCA SCY = SFalse - (%==) SCA SCZ = SFalse - (%==) SCB SCA = SFalse - (%==) SCB SCB = STrue - (%==) SCB SCC = SFalse - (%==) SCB SCD = SFalse - (%==) SCB SCE = SFalse - (%==) SCB SCF = SFalse - (%==) SCB SCG = SFalse - (%==) SCB SCH = SFalse - (%==) SCB SCI = SFalse - (%==) SCB SCJ = SFalse - (%==) SCB SCK = SFalse - (%==) SCB SCL = SFalse - (%==) SCB SCM = SFalse - (%==) SCB SCN = SFalse - (%==) SCB SCO = SFalse - (%==) SCB SCP = SFalse - (%==) SCB SCQ = SFalse - (%==) SCB SCR = SFalse - (%==) SCB SCS = SFalse - (%==) SCB SCT = SFalse - (%==) SCB SCU = SFalse - (%==) SCB SCV = SFalse - (%==) SCB SCW = SFalse - (%==) SCB SCX = SFalse - (%==) SCB SCY = SFalse - (%==) SCB SCZ = SFalse - (%==) SCC SCA = SFalse - (%==) SCC SCB = SFalse - (%==) SCC SCC = STrue - (%==) SCC SCD = SFalse - (%==) SCC SCE = SFalse - (%==) SCC SCF = SFalse - (%==) SCC SCG = SFalse - (%==) SCC SCH = SFalse - (%==) SCC SCI = SFalse - (%==) SCC SCJ = SFalse - (%==) SCC SCK = SFalse - (%==) SCC SCL = SFalse - (%==) SCC SCM = SFalse - (%==) SCC SCN = SFalse - (%==) SCC SCO = SFalse - (%==) SCC SCP = SFalse - (%==) SCC SCQ = SFalse - (%==) SCC SCR = SFalse - (%==) SCC SCS = SFalse - (%==) SCC SCT = SFalse - (%==) SCC SCU = SFalse - (%==) SCC SCV = SFalse - (%==) SCC SCW = SFalse - (%==) SCC SCX = SFalse - (%==) SCC SCY = SFalse - (%==) SCC SCZ = SFalse - (%==) SCD SCA = SFalse - (%==) SCD SCB = SFalse - (%==) SCD SCC = SFalse - (%==) SCD SCD = STrue - (%==) SCD SCE = SFalse - (%==) SCD SCF = SFalse - (%==) SCD SCG = SFalse - (%==) SCD SCH = SFalse - (%==) SCD SCI = SFalse - (%==) SCD SCJ = SFalse - (%==) SCD SCK = SFalse - (%==) SCD SCL = SFalse - (%==) SCD SCM = SFalse - (%==) SCD SCN = SFalse - (%==) SCD SCO = SFalse - (%==) SCD SCP = SFalse - (%==) SCD SCQ = SFalse - (%==) SCD SCR = SFalse - (%==) SCD SCS = SFalse - (%==) SCD SCT = SFalse - (%==) SCD SCU = SFalse - (%==) SCD SCV = SFalse - (%==) SCD SCW = SFalse - (%==) SCD SCX = SFalse - (%==) SCD SCY = SFalse - (%==) SCD SCZ = SFalse - (%==) SCE SCA = SFalse - (%==) SCE SCB = SFalse - (%==) SCE SCC = SFalse - (%==) SCE SCD = SFalse - (%==) SCE SCE = STrue - (%==) SCE SCF = SFalse - (%==) SCE SCG = SFalse - (%==) SCE SCH = SFalse - (%==) SCE SCI = SFalse - (%==) SCE SCJ = SFalse - (%==) SCE SCK = SFalse - (%==) SCE SCL = SFalse - (%==) SCE SCM = SFalse - (%==) SCE SCN = SFalse - (%==) SCE SCO = SFalse - (%==) SCE SCP = SFalse - (%==) SCE SCQ = SFalse - (%==) SCE SCR = SFalse - (%==) SCE SCS = SFalse - (%==) SCE SCT = SFalse - (%==) SCE SCU = SFalse - (%==) SCE SCV = SFalse - (%==) SCE SCW = SFalse - (%==) SCE SCX = SFalse - (%==) SCE SCY = SFalse - (%==) SCE SCZ = SFalse - (%==) SCF SCA = SFalse - (%==) SCF SCB = SFalse - (%==) SCF SCC = SFalse - (%==) SCF SCD = SFalse - (%==) SCF SCE = SFalse - (%==) SCF SCF = STrue - (%==) SCF SCG = SFalse - (%==) SCF SCH = SFalse - (%==) SCF SCI = SFalse - (%==) SCF SCJ = SFalse - (%==) SCF SCK = SFalse - (%==) SCF SCL = SFalse - (%==) SCF SCM = SFalse - (%==) SCF SCN = SFalse - (%==) SCF SCO = SFalse - (%==) SCF SCP = SFalse - (%==) SCF SCQ = SFalse - (%==) SCF SCR = SFalse - (%==) SCF SCS = SFalse - (%==) SCF SCT = SFalse - (%==) SCF SCU = SFalse - (%==) SCF SCV = SFalse - (%==) SCF SCW = SFalse - (%==) SCF SCX = SFalse - (%==) SCF SCY = SFalse - (%==) SCF SCZ = SFalse - (%==) SCG SCA = SFalse - (%==) SCG SCB = SFalse - (%==) SCG SCC = SFalse - (%==) SCG SCD = SFalse - (%==) SCG SCE = SFalse - (%==) SCG SCF = SFalse - (%==) SCG SCG = STrue - (%==) SCG SCH = SFalse - (%==) SCG SCI = SFalse - (%==) SCG SCJ = SFalse - (%==) SCG SCK = SFalse - (%==) SCG SCL = SFalse - (%==) SCG SCM = SFalse - (%==) SCG SCN = SFalse - (%==) SCG SCO = SFalse - (%==) SCG SCP = SFalse - (%==) SCG SCQ = SFalse - (%==) SCG SCR = SFalse - (%==) SCG SCS = SFalse - (%==) SCG SCT = SFalse - (%==) SCG SCU = SFalse - (%==) SCG SCV = SFalse - (%==) SCG SCW = SFalse - (%==) SCG SCX = SFalse - (%==) SCG SCY = SFalse - (%==) SCG SCZ = SFalse - (%==) SCH SCA = SFalse - (%==) SCH SCB = SFalse - (%==) SCH SCC = SFalse - (%==) SCH SCD = SFalse - (%==) SCH SCE = SFalse - (%==) SCH SCF = SFalse - (%==) SCH SCG = SFalse - (%==) SCH SCH = STrue - (%==) SCH SCI = SFalse - (%==) SCH SCJ = SFalse - (%==) SCH SCK = SFalse - (%==) SCH SCL = SFalse - (%==) SCH SCM = SFalse - (%==) SCH SCN = SFalse - (%==) SCH SCO = SFalse - (%==) SCH SCP = SFalse - (%==) SCH SCQ = SFalse - (%==) SCH SCR = SFalse - (%==) SCH SCS = SFalse - (%==) SCH SCT = SFalse - (%==) SCH SCU = SFalse - (%==) SCH SCV = SFalse - (%==) SCH SCW = SFalse - (%==) SCH SCX = SFalse - (%==) SCH SCY = SFalse - (%==) SCH SCZ = SFalse - (%==) SCI SCA = SFalse - (%==) SCI SCB = SFalse - (%==) SCI SCC = SFalse - (%==) SCI SCD = SFalse - (%==) SCI SCE = SFalse - (%==) SCI SCF = SFalse - (%==) SCI SCG = SFalse - (%==) SCI SCH = SFalse - (%==) SCI SCI = STrue - (%==) SCI SCJ = SFalse - (%==) SCI SCK = SFalse - (%==) SCI SCL = SFalse - (%==) SCI SCM = SFalse - (%==) SCI SCN = SFalse - (%==) SCI SCO = SFalse - (%==) SCI SCP = SFalse - (%==) SCI SCQ = SFalse - (%==) SCI SCR = SFalse - (%==) SCI SCS = SFalse - (%==) SCI SCT = SFalse - (%==) SCI SCU = SFalse - (%==) SCI SCV = SFalse - (%==) SCI SCW = SFalse - (%==) SCI SCX = SFalse - (%==) SCI SCY = SFalse - (%==) SCI SCZ = SFalse - (%==) SCJ SCA = SFalse - (%==) SCJ SCB = SFalse - (%==) SCJ SCC = SFalse - (%==) SCJ SCD = SFalse - (%==) SCJ SCE = SFalse - (%==) SCJ SCF = SFalse - (%==) SCJ SCG = SFalse - (%==) SCJ SCH = SFalse - (%==) SCJ SCI = SFalse - (%==) SCJ SCJ = STrue - (%==) SCJ SCK = SFalse - (%==) SCJ SCL = SFalse - (%==) SCJ SCM = SFalse - (%==) SCJ SCN = SFalse - (%==) SCJ SCO = SFalse - (%==) SCJ SCP = SFalse - (%==) SCJ SCQ = SFalse - (%==) SCJ SCR = SFalse - (%==) SCJ SCS = SFalse - (%==) SCJ SCT = SFalse - (%==) SCJ SCU = SFalse - (%==) SCJ SCV = SFalse - (%==) SCJ SCW = SFalse - (%==) SCJ SCX = SFalse - (%==) SCJ SCY = SFalse - (%==) SCJ SCZ = SFalse - (%==) SCK SCA = SFalse - (%==) SCK SCB = SFalse - (%==) SCK SCC = SFalse - (%==) SCK SCD = SFalse - (%==) SCK SCE = SFalse - (%==) SCK SCF = SFalse - (%==) SCK SCG = SFalse - (%==) SCK SCH = SFalse - (%==) SCK SCI = SFalse - (%==) SCK SCJ = SFalse - (%==) SCK SCK = STrue - (%==) SCK SCL = SFalse - (%==) SCK SCM = SFalse - (%==) SCK SCN = SFalse - (%==) SCK SCO = SFalse - (%==) SCK SCP = SFalse - (%==) SCK SCQ = SFalse - (%==) SCK SCR = SFalse - (%==) SCK SCS = SFalse - (%==) SCK SCT = SFalse - (%==) SCK SCU = SFalse - (%==) SCK SCV = SFalse - (%==) SCK SCW = SFalse - (%==) SCK SCX = SFalse - (%==) SCK SCY = SFalse - (%==) SCK SCZ = SFalse - (%==) SCL SCA = SFalse - (%==) SCL SCB = SFalse - (%==) SCL SCC = SFalse - (%==) SCL SCD = SFalse - (%==) SCL SCE = SFalse - (%==) SCL SCF = SFalse - (%==) SCL SCG = SFalse - (%==) SCL SCH = SFalse - (%==) SCL SCI = SFalse - (%==) SCL SCJ = SFalse - (%==) SCL SCK = SFalse - (%==) SCL SCL = STrue - (%==) SCL SCM = SFalse - (%==) SCL SCN = SFalse - (%==) SCL SCO = SFalse - (%==) SCL SCP = SFalse - (%==) SCL SCQ = SFalse - (%==) SCL SCR = SFalse - (%==) SCL SCS = SFalse - (%==) SCL SCT = SFalse - (%==) SCL SCU = SFalse - (%==) SCL SCV = SFalse - (%==) SCL SCW = SFalse - (%==) SCL SCX = SFalse - (%==) SCL SCY = SFalse - (%==) SCL SCZ = SFalse - (%==) SCM SCA = SFalse - (%==) SCM SCB = SFalse - (%==) SCM SCC = SFalse - (%==) SCM SCD = SFalse - (%==) SCM SCE = SFalse - (%==) SCM SCF = SFalse - (%==) SCM SCG = SFalse - (%==) SCM SCH = SFalse - (%==) SCM SCI = SFalse - (%==) SCM SCJ = SFalse - (%==) SCM SCK = SFalse - (%==) SCM SCL = SFalse - (%==) SCM SCM = STrue - (%==) SCM SCN = SFalse - (%==) SCM SCO = SFalse - (%==) SCM SCP = SFalse - (%==) SCM SCQ = SFalse - (%==) SCM SCR = SFalse - (%==) SCM SCS = SFalse - (%==) SCM SCT = SFalse - (%==) SCM SCU = SFalse - (%==) SCM SCV = SFalse - (%==) SCM SCW = SFalse - (%==) SCM SCX = SFalse - (%==) SCM SCY = SFalse - (%==) SCM SCZ = SFalse - (%==) SCN SCA = SFalse - (%==) SCN SCB = SFalse - (%==) SCN SCC = SFalse - (%==) SCN SCD = SFalse - (%==) SCN SCE = SFalse - (%==) SCN SCF = SFalse - (%==) SCN SCG = SFalse - (%==) SCN SCH = SFalse - (%==) SCN SCI = SFalse - (%==) SCN SCJ = SFalse - (%==) SCN SCK = SFalse - (%==) SCN SCL = SFalse - (%==) SCN SCM = SFalse - (%==) SCN SCN = STrue - (%==) SCN SCO = SFalse - (%==) SCN SCP = SFalse - (%==) SCN SCQ = SFalse - (%==) SCN SCR = SFalse - (%==) SCN SCS = SFalse - (%==) SCN SCT = SFalse - (%==) SCN SCU = SFalse - (%==) SCN SCV = SFalse - (%==) SCN SCW = SFalse - (%==) SCN SCX = SFalse - (%==) SCN SCY = SFalse - (%==) SCN SCZ = SFalse - (%==) SCO SCA = SFalse - (%==) SCO SCB = SFalse - (%==) SCO SCC = SFalse - (%==) SCO SCD = SFalse - (%==) SCO SCE = SFalse - (%==) SCO SCF = SFalse - (%==) SCO SCG = SFalse - (%==) SCO SCH = SFalse - (%==) SCO SCI = SFalse - (%==) SCO SCJ = SFalse - (%==) SCO SCK = SFalse - (%==) SCO SCL = SFalse - (%==) SCO SCM = SFalse - (%==) SCO SCN = SFalse - (%==) SCO SCO = STrue - (%==) SCO SCP = SFalse - (%==) SCO SCQ = SFalse - (%==) SCO SCR = SFalse - (%==) SCO SCS = SFalse - (%==) SCO SCT = SFalse - (%==) SCO SCU = SFalse - (%==) SCO SCV = SFalse - (%==) SCO SCW = SFalse - (%==) SCO SCX = SFalse - (%==) SCO SCY = SFalse - (%==) SCO SCZ = SFalse - (%==) SCP SCA = SFalse - (%==) SCP SCB = SFalse - (%==) SCP SCC = SFalse - (%==) SCP SCD = SFalse - (%==) SCP SCE = SFalse - (%==) SCP SCF = SFalse - (%==) SCP SCG = SFalse - (%==) SCP SCH = SFalse - (%==) SCP SCI = SFalse - (%==) SCP SCJ = SFalse - (%==) SCP SCK = SFalse - (%==) SCP SCL = SFalse - (%==) SCP SCM = SFalse - (%==) SCP SCN = SFalse - (%==) SCP SCO = SFalse - (%==) SCP SCP = STrue - (%==) SCP SCQ = SFalse - (%==) SCP SCR = SFalse - (%==) SCP SCS = SFalse - (%==) SCP SCT = SFalse - (%==) SCP SCU = SFalse - (%==) SCP SCV = SFalse - (%==) SCP SCW = SFalse - (%==) SCP SCX = SFalse - (%==) SCP SCY = SFalse - (%==) SCP SCZ = SFalse - (%==) SCQ SCA = SFalse - (%==) SCQ SCB = SFalse - (%==) SCQ SCC = SFalse - (%==) SCQ SCD = SFalse - (%==) SCQ SCE = SFalse - (%==) SCQ SCF = SFalse - (%==) SCQ SCG = SFalse - (%==) SCQ SCH = SFalse - (%==) SCQ SCI = SFalse - (%==) SCQ SCJ = SFalse - (%==) SCQ SCK = SFalse - (%==) SCQ SCL = SFalse - (%==) SCQ SCM = SFalse - (%==) SCQ SCN = SFalse - (%==) SCQ SCO = SFalse - (%==) SCQ SCP = SFalse - (%==) SCQ SCQ = STrue - (%==) SCQ SCR = SFalse - (%==) SCQ SCS = SFalse - (%==) SCQ SCT = SFalse - (%==) SCQ SCU = SFalse - (%==) SCQ SCV = SFalse - (%==) SCQ SCW = SFalse - (%==) SCQ SCX = SFalse - (%==) SCQ SCY = SFalse - (%==) SCQ SCZ = SFalse - (%==) SCR SCA = SFalse - (%==) SCR SCB = SFalse - (%==) SCR SCC = SFalse - (%==) SCR SCD = SFalse - (%==) SCR SCE = SFalse - (%==) SCR SCF = SFalse - (%==) SCR SCG = SFalse - (%==) SCR SCH = SFalse - (%==) SCR SCI = SFalse - (%==) SCR SCJ = SFalse - (%==) SCR SCK = SFalse - (%==) SCR SCL = SFalse - (%==) SCR SCM = SFalse - (%==) SCR SCN = SFalse - (%==) SCR SCO = SFalse - (%==) SCR SCP = SFalse - (%==) SCR SCQ = SFalse - (%==) SCR SCR = STrue - (%==) SCR SCS = SFalse - (%==) SCR SCT = SFalse - (%==) SCR SCU = SFalse - (%==) SCR SCV = SFalse - (%==) SCR SCW = SFalse - (%==) SCR SCX = SFalse - (%==) SCR SCY = SFalse - (%==) SCR SCZ = SFalse - (%==) SCS SCA = SFalse - (%==) SCS SCB = SFalse - (%==) SCS SCC = SFalse - (%==) SCS SCD = SFalse - (%==) SCS SCE = SFalse - (%==) SCS SCF = SFalse - (%==) SCS SCG = SFalse - (%==) SCS SCH = SFalse - (%==) SCS SCI = SFalse - (%==) SCS SCJ = SFalse - (%==) SCS SCK = SFalse - (%==) SCS SCL = SFalse - (%==) SCS SCM = SFalse - (%==) SCS SCN = SFalse - (%==) SCS SCO = SFalse - (%==) SCS SCP = SFalse - (%==) SCS SCQ = SFalse - (%==) SCS SCR = SFalse - (%==) SCS SCS = STrue - (%==) SCS SCT = SFalse - (%==) SCS SCU = SFalse - (%==) SCS SCV = SFalse - (%==) SCS SCW = SFalse - (%==) SCS SCX = SFalse - (%==) SCS SCY = SFalse - (%==) SCS SCZ = SFalse - (%==) SCT SCA = SFalse - (%==) SCT SCB = SFalse - (%==) SCT SCC = SFalse - (%==) SCT SCD = SFalse - (%==) SCT SCE = SFalse - (%==) SCT SCF = SFalse - (%==) SCT SCG = SFalse - (%==) SCT SCH = SFalse - (%==) SCT SCI = SFalse - (%==) SCT SCJ = SFalse - (%==) SCT SCK = SFalse - (%==) SCT SCL = SFalse - (%==) SCT SCM = SFalse - (%==) SCT SCN = SFalse - (%==) SCT SCO = SFalse - (%==) SCT SCP = SFalse - (%==) SCT SCQ = SFalse - (%==) SCT SCR = SFalse - (%==) SCT SCS = SFalse - (%==) SCT SCT = STrue - (%==) SCT SCU = SFalse - (%==) SCT SCV = SFalse - (%==) SCT SCW = SFalse - (%==) SCT SCX = SFalse - (%==) SCT SCY = SFalse - (%==) SCT SCZ = SFalse - (%==) SCU SCA = SFalse - (%==) SCU SCB = SFalse - (%==) SCU SCC = SFalse - (%==) SCU SCD = SFalse - (%==) SCU SCE = SFalse - (%==) SCU SCF = SFalse - (%==) SCU SCG = SFalse - (%==) SCU SCH = SFalse - (%==) SCU SCI = SFalse - (%==) SCU SCJ = SFalse - (%==) SCU SCK = SFalse - (%==) SCU SCL = SFalse - (%==) SCU SCM = SFalse - (%==) SCU SCN = SFalse - (%==) SCU SCO = SFalse - (%==) SCU SCP = SFalse - (%==) SCU SCQ = SFalse - (%==) SCU SCR = SFalse - (%==) SCU SCS = SFalse - (%==) SCU SCT = SFalse - (%==) SCU SCU = STrue - (%==) SCU SCV = SFalse - (%==) SCU SCW = SFalse - (%==) SCU SCX = SFalse - (%==) SCU SCY = SFalse - (%==) SCU SCZ = SFalse - (%==) SCV SCA = SFalse - (%==) SCV SCB = SFalse - (%==) SCV SCC = SFalse - (%==) SCV SCD = SFalse - (%==) SCV SCE = SFalse - (%==) SCV SCF = SFalse - (%==) SCV SCG = SFalse - (%==) SCV SCH = SFalse - (%==) SCV SCI = SFalse - (%==) SCV SCJ = SFalse - (%==) SCV SCK = SFalse - (%==) SCV SCL = SFalse - (%==) SCV SCM = SFalse - (%==) SCV SCN = SFalse - (%==) SCV SCO = SFalse - (%==) SCV SCP = SFalse - (%==) SCV SCQ = SFalse - (%==) SCV SCR = SFalse - (%==) SCV SCS = SFalse - (%==) SCV SCT = SFalse - (%==) SCV SCU = SFalse - (%==) SCV SCV = STrue - (%==) SCV SCW = SFalse - (%==) SCV SCX = SFalse - (%==) SCV SCY = SFalse - (%==) SCV SCZ = SFalse - (%==) SCW SCA = SFalse - (%==) SCW SCB = SFalse - (%==) SCW SCC = SFalse - (%==) SCW SCD = SFalse - (%==) SCW SCE = SFalse - (%==) SCW SCF = SFalse - (%==) SCW SCG = SFalse - (%==) SCW SCH = SFalse - (%==) SCW SCI = SFalse - (%==) SCW SCJ = SFalse - (%==) SCW SCK = SFalse - (%==) SCW SCL = SFalse - (%==) SCW SCM = SFalse - (%==) SCW SCN = SFalse - (%==) SCW SCO = SFalse - (%==) SCW SCP = SFalse - (%==) SCW SCQ = SFalse - (%==) SCW SCR = SFalse - (%==) SCW SCS = SFalse - (%==) SCW SCT = SFalse - (%==) SCW SCU = SFalse - (%==) SCW SCV = SFalse - (%==) SCW SCW = STrue - (%==) SCW SCX = SFalse - (%==) SCW SCY = SFalse - (%==) SCW SCZ = SFalse - (%==) SCX SCA = SFalse - (%==) SCX SCB = SFalse - (%==) SCX SCC = SFalse - (%==) SCX SCD = SFalse - (%==) SCX SCE = SFalse - (%==) SCX SCF = SFalse - (%==) SCX SCG = SFalse - (%==) SCX SCH = SFalse - (%==) SCX SCI = SFalse - (%==) SCX SCJ = SFalse - (%==) SCX SCK = SFalse - (%==) SCX SCL = SFalse - (%==) SCX SCM = SFalse - (%==) SCX SCN = SFalse - (%==) SCX SCO = SFalse - (%==) SCX SCP = SFalse - (%==) SCX SCQ = SFalse - (%==) SCX SCR = SFalse - (%==) SCX SCS = SFalse - (%==) SCX SCT = SFalse - (%==) SCX SCU = SFalse - (%==) SCX SCV = SFalse - (%==) SCX SCW = SFalse - (%==) SCX SCX = STrue - (%==) SCX SCY = SFalse - (%==) SCX SCZ = SFalse - (%==) SCY SCA = SFalse - (%==) SCY SCB = SFalse - (%==) SCY SCC = SFalse - (%==) SCY SCD = SFalse - (%==) SCY SCE = SFalse - (%==) SCY SCF = SFalse - (%==) SCY SCG = SFalse - (%==) SCY SCH = SFalse - (%==) SCY SCI = SFalse - (%==) SCY SCJ = SFalse - (%==) SCY SCK = SFalse - (%==) SCY SCL = SFalse - (%==) SCY SCM = SFalse - (%==) SCY SCN = SFalse - (%==) SCY SCO = SFalse - (%==) SCY SCP = SFalse - (%==) SCY SCQ = SFalse - (%==) SCY SCR = SFalse - (%==) SCY SCS = SFalse - (%==) SCY SCT = SFalse - (%==) SCY SCU = SFalse - (%==) SCY SCV = SFalse - (%==) SCY SCW = SFalse - (%==) SCY SCX = SFalse - (%==) SCY SCY = STrue - (%==) SCY SCZ = SFalse - (%==) SCZ SCA = SFalse - (%==) SCZ SCB = SFalse - (%==) SCZ SCC = SFalse - (%==) SCZ SCD = SFalse - (%==) SCZ SCE = SFalse - (%==) SCZ SCF = SFalse - (%==) SCZ SCG = SFalse - (%==) SCZ SCH = SFalse - (%==) SCZ SCI = SFalse - (%==) SCZ SCJ = SFalse - (%==) SCZ SCK = SFalse - (%==) SCZ SCL = SFalse - (%==) SCZ SCM = SFalse - (%==) SCZ SCN = SFalse - (%==) SCZ SCO = SFalse - (%==) SCZ SCP = SFalse - (%==) SCZ SCQ = SFalse - (%==) SCZ SCR = SFalse - (%==) SCZ SCS = SFalse - (%==) SCZ SCT = SFalse - (%==) SCZ SCU = SFalse - (%==) SCZ SCV = SFalse - (%==) SCZ SCW = SFalse - (%==) SCZ SCX = SFalse - (%==) SCZ SCY = SFalse - (%==) SCZ SCZ = STrue - instance SDecide AChar where - (%~) SCA SCA = Proved Refl - (%~) SCA SCB = Disproved (\ x -> case x of) - (%~) SCA SCC = Disproved (\ x -> case x of) - (%~) SCA SCD = Disproved (\ x -> case x of) - (%~) SCA SCE = Disproved (\ x -> case x of) - (%~) SCA SCF = Disproved (\ x -> case x of) - (%~) SCA SCG = Disproved (\ x -> case x of) - (%~) SCA SCH = Disproved (\ x -> case x of) - (%~) SCA SCI = Disproved (\ x -> case x of) - (%~) SCA SCJ = Disproved (\ x -> case x of) - (%~) SCA SCK = Disproved (\ x -> case x of) - (%~) SCA SCL = Disproved (\ x -> case x of) - (%~) SCA SCM = Disproved (\ x -> case x of) - (%~) SCA SCN = Disproved (\ x -> case x of) - (%~) SCA SCO = Disproved (\ x -> case x of) - (%~) SCA SCP = Disproved (\ x -> case x of) - (%~) SCA SCQ = Disproved (\ x -> case x of) - (%~) SCA SCR = Disproved (\ x -> case x of) - (%~) SCA SCS = Disproved (\ x -> case x of) - (%~) SCA SCT = Disproved (\ x -> case x of) - (%~) SCA SCU = Disproved (\ x -> case x of) - (%~) SCA SCV = Disproved (\ x -> case x of) - (%~) SCA SCW = Disproved (\ x -> case x of) - (%~) SCA SCX = Disproved (\ x -> case x of) - (%~) SCA SCY = Disproved (\ x -> case x of) - (%~) SCA SCZ = Disproved (\ x -> case x of) - (%~) SCB SCA = Disproved (\ x -> case x of) - (%~) SCB SCB = Proved Refl - (%~) SCB SCC = Disproved (\ x -> case x of) - (%~) SCB SCD = Disproved (\ x -> case x of) - (%~) SCB SCE = Disproved (\ x -> case x of) - (%~) SCB SCF = Disproved (\ x -> case x of) - (%~) SCB SCG = Disproved (\ x -> case x of) - (%~) SCB SCH = Disproved (\ x -> case x of) - (%~) SCB SCI = Disproved (\ x -> case x of) - (%~) SCB SCJ = Disproved (\ x -> case x of) - (%~) SCB SCK = Disproved (\ x -> case x of) - (%~) SCB SCL = Disproved (\ x -> case x of) - (%~) SCB SCM = Disproved (\ x -> case x of) - (%~) SCB SCN = Disproved (\ x -> case x of) - (%~) SCB SCO = Disproved (\ x -> case x of) - (%~) SCB SCP = Disproved (\ x -> case x of) - (%~) SCB SCQ = Disproved (\ x -> case x of) - (%~) SCB SCR = Disproved (\ x -> case x of) - (%~) SCB SCS = Disproved (\ x -> case x of) - (%~) SCB SCT = Disproved (\ x -> case x of) - (%~) SCB SCU = Disproved (\ x -> case x of) - (%~) SCB SCV = Disproved (\ x -> case x of) - (%~) SCB SCW = Disproved (\ x -> case x of) - (%~) SCB SCX = Disproved (\ x -> case x of) - (%~) SCB SCY = Disproved (\ x -> case x of) - (%~) SCB SCZ = Disproved (\ x -> case x of) - (%~) SCC SCA = Disproved (\ x -> case x of) - (%~) SCC SCB = Disproved (\ x -> case x of) - (%~) SCC SCC = Proved Refl - (%~) SCC SCD = Disproved (\ x -> case x of) - (%~) SCC SCE = Disproved (\ x -> case x of) - (%~) SCC SCF = Disproved (\ x -> case x of) - (%~) SCC SCG = Disproved (\ x -> case x of) - (%~) SCC SCH = Disproved (\ x -> case x of) - (%~) SCC SCI = Disproved (\ x -> case x of) - (%~) SCC SCJ = Disproved (\ x -> case x of) - (%~) SCC SCK = Disproved (\ x -> case x of) - (%~) SCC SCL = Disproved (\ x -> case x of) - (%~) SCC SCM = Disproved (\ x -> case x of) - (%~) SCC SCN = Disproved (\ x -> case x of) - (%~) SCC SCO = Disproved (\ x -> case x of) - (%~) SCC SCP = Disproved (\ x -> case x of) - (%~) SCC SCQ = Disproved (\ x -> case x of) - (%~) SCC SCR = Disproved (\ x -> case x of) - (%~) SCC SCS = Disproved (\ x -> case x of) - (%~) SCC SCT = Disproved (\ x -> case x of) - (%~) SCC SCU = Disproved (\ x -> case x of) - (%~) SCC SCV = Disproved (\ x -> case x of) - (%~) SCC SCW = Disproved (\ x -> case x of) - (%~) SCC SCX = Disproved (\ x -> case x of) - (%~) SCC SCY = Disproved (\ x -> case x of) - (%~) SCC SCZ = Disproved (\ x -> case x of) - (%~) SCD SCA = Disproved (\ x -> case x of) - (%~) SCD SCB = Disproved (\ x -> case x of) - (%~) SCD SCC = Disproved (\ x -> case x of) - (%~) SCD SCD = Proved Refl - (%~) SCD SCE = Disproved (\ x -> case x of) - (%~) SCD SCF = Disproved (\ x -> case x of) - (%~) SCD SCG = Disproved (\ x -> case x of) - (%~) SCD SCH = Disproved (\ x -> case x of) - (%~) SCD SCI = Disproved (\ x -> case x of) - (%~) SCD SCJ = Disproved (\ x -> case x of) - (%~) SCD SCK = Disproved (\ x -> case x of) - (%~) SCD SCL = Disproved (\ x -> case x of) - (%~) SCD SCM = Disproved (\ x -> case x of) - (%~) SCD SCN = Disproved (\ x -> case x of) - (%~) SCD SCO = Disproved (\ x -> case x of) - (%~) SCD SCP = Disproved (\ x -> case x of) - (%~) SCD SCQ = Disproved (\ x -> case x of) - (%~) SCD SCR = Disproved (\ x -> case x of) - (%~) SCD SCS = Disproved (\ x -> case x of) - (%~) SCD SCT = Disproved (\ x -> case x of) - (%~) SCD SCU = Disproved (\ x -> case x of) - (%~) SCD SCV = Disproved (\ x -> case x of) - (%~) SCD SCW = Disproved (\ x -> case x of) - (%~) SCD SCX = Disproved (\ x -> case x of) - (%~) SCD SCY = Disproved (\ x -> case x of) - (%~) SCD SCZ = Disproved (\ x -> case x of) - (%~) SCE SCA = Disproved (\ x -> case x of) - (%~) SCE SCB = Disproved (\ x -> case x of) - (%~) SCE SCC = Disproved (\ x -> case x of) - (%~) SCE SCD = Disproved (\ x -> case x of) - (%~) SCE SCE = Proved Refl - (%~) SCE SCF = Disproved (\ x -> case x of) - (%~) SCE SCG = Disproved (\ x -> case x of) - (%~) SCE SCH = Disproved (\ x -> case x of) - (%~) SCE SCI = Disproved (\ x -> case x of) - (%~) SCE SCJ = Disproved (\ x -> case x of) - (%~) SCE SCK = Disproved (\ x -> case x of) - (%~) SCE SCL = Disproved (\ x -> case x of) - (%~) SCE SCM = Disproved (\ x -> case x of) - (%~) SCE SCN = Disproved (\ x -> case x of) - (%~) SCE SCO = Disproved (\ x -> case x of) - (%~) SCE SCP = Disproved (\ x -> case x of) - (%~) SCE SCQ = Disproved (\ x -> case x of) - (%~) SCE SCR = Disproved (\ x -> case x of) - (%~) SCE SCS = Disproved (\ x -> case x of) - (%~) SCE SCT = Disproved (\ x -> case x of) - (%~) SCE SCU = Disproved (\ x -> case x of) - (%~) SCE SCV = Disproved (\ x -> case x of) - (%~) SCE SCW = Disproved (\ x -> case x of) - (%~) SCE SCX = Disproved (\ x -> case x of) - (%~) SCE SCY = Disproved (\ x -> case x of) - (%~) SCE SCZ = Disproved (\ x -> case x of) - (%~) SCF SCA = Disproved (\ x -> case x of) - (%~) SCF SCB = Disproved (\ x -> case x of) - (%~) SCF SCC = Disproved (\ x -> case x of) - (%~) SCF SCD = Disproved (\ x -> case x of) - (%~) SCF SCE = Disproved (\ x -> case x of) - (%~) SCF SCF = Proved Refl - (%~) SCF SCG = Disproved (\ x -> case x of) - (%~) SCF SCH = Disproved (\ x -> case x of) - (%~) SCF SCI = Disproved (\ x -> case x of) - (%~) SCF SCJ = Disproved (\ x -> case x of) - (%~) SCF SCK = Disproved (\ x -> case x of) - (%~) SCF SCL = Disproved (\ x -> case x of) - (%~) SCF SCM = Disproved (\ x -> case x of) - (%~) SCF SCN = Disproved (\ x -> case x of) - (%~) SCF SCO = Disproved (\ x -> case x of) - (%~) SCF SCP = Disproved (\ x -> case x of) - (%~) SCF SCQ = Disproved (\ x -> case x of) - (%~) SCF SCR = Disproved (\ x -> case x of) - (%~) SCF SCS = Disproved (\ x -> case x of) - (%~) SCF SCT = Disproved (\ x -> case x of) - (%~) SCF SCU = Disproved (\ x -> case x of) - (%~) SCF SCV = Disproved (\ x -> case x of) - (%~) SCF SCW = Disproved (\ x -> case x of) - (%~) SCF SCX = Disproved (\ x -> case x of) - (%~) SCF SCY = Disproved (\ x -> case x of) - (%~) SCF SCZ = Disproved (\ x -> case x of) - (%~) SCG SCA = Disproved (\ x -> case x of) - (%~) SCG SCB = Disproved (\ x -> case x of) - (%~) SCG SCC = Disproved (\ x -> case x of) - (%~) SCG SCD = Disproved (\ x -> case x of) - (%~) SCG SCE = Disproved (\ x -> case x of) - (%~) SCG SCF = Disproved (\ x -> case x of) - (%~) SCG SCG = Proved Refl - (%~) SCG SCH = Disproved (\ x -> case x of) - (%~) SCG SCI = Disproved (\ x -> case x of) - (%~) SCG SCJ = Disproved (\ x -> case x of) - (%~) SCG SCK = Disproved (\ x -> case x of) - (%~) SCG SCL = Disproved (\ x -> case x of) - (%~) SCG SCM = Disproved (\ x -> case x of) - (%~) SCG SCN = Disproved (\ x -> case x of) - (%~) SCG SCO = Disproved (\ x -> case x of) - (%~) SCG SCP = Disproved (\ x -> case x of) - (%~) SCG SCQ = Disproved (\ x -> case x of) - (%~) SCG SCR = Disproved (\ x -> case x of) - (%~) SCG SCS = Disproved (\ x -> case x of) - (%~) SCG SCT = Disproved (\ x -> case x of) - (%~) SCG SCU = Disproved (\ x -> case x of) - (%~) SCG SCV = Disproved (\ x -> case x of) - (%~) SCG SCW = Disproved (\ x -> case x of) - (%~) SCG SCX = Disproved (\ x -> case x of) - (%~) SCG SCY = Disproved (\ x -> case x of) - (%~) SCG SCZ = Disproved (\ x -> case x of) - (%~) SCH SCA = Disproved (\ x -> case x of) - (%~) SCH SCB = Disproved (\ x -> case x of) - (%~) SCH SCC = Disproved (\ x -> case x of) - (%~) SCH SCD = Disproved (\ x -> case x of) - (%~) SCH SCE = Disproved (\ x -> case x of) - (%~) SCH SCF = Disproved (\ x -> case x of) - (%~) SCH SCG = Disproved (\ x -> case x of) - (%~) SCH SCH = Proved Refl - (%~) SCH SCI = Disproved (\ x -> case x of) - (%~) SCH SCJ = Disproved (\ x -> case x of) - (%~) SCH SCK = Disproved (\ x -> case x of) - (%~) SCH SCL = Disproved (\ x -> case x of) - (%~) SCH SCM = Disproved (\ x -> case x of) - (%~) SCH SCN = Disproved (\ x -> case x of) - (%~) SCH SCO = Disproved (\ x -> case x of) - (%~) SCH SCP = Disproved (\ x -> case x of) - (%~) SCH SCQ = Disproved (\ x -> case x of) - (%~) SCH SCR = Disproved (\ x -> case x of) - (%~) SCH SCS = Disproved (\ x -> case x of) - (%~) SCH SCT = Disproved (\ x -> case x of) - (%~) SCH SCU = Disproved (\ x -> case x of) - (%~) SCH SCV = Disproved (\ x -> case x of) - (%~) SCH SCW = Disproved (\ x -> case x of) - (%~) SCH SCX = Disproved (\ x -> case x of) - (%~) SCH SCY = Disproved (\ x -> case x of) - (%~) SCH SCZ = Disproved (\ x -> case x of) - (%~) SCI SCA = Disproved (\ x -> case x of) - (%~) SCI SCB = Disproved (\ x -> case x of) - (%~) SCI SCC = Disproved (\ x -> case x of) - (%~) SCI SCD = Disproved (\ x -> case x of) - (%~) SCI SCE = Disproved (\ x -> case x of) - (%~) SCI SCF = Disproved (\ x -> case x of) - (%~) SCI SCG = Disproved (\ x -> case x of) - (%~) SCI SCH = Disproved (\ x -> case x of) - (%~) SCI SCI = Proved Refl - (%~) SCI SCJ = Disproved (\ x -> case x of) - (%~) SCI SCK = Disproved (\ x -> case x of) - (%~) SCI SCL = Disproved (\ x -> case x of) - (%~) SCI SCM = Disproved (\ x -> case x of) - (%~) SCI SCN = Disproved (\ x -> case x of) - (%~) SCI SCO = Disproved (\ x -> case x of) - (%~) SCI SCP = Disproved (\ x -> case x of) - (%~) SCI SCQ = Disproved (\ x -> case x of) - (%~) SCI SCR = Disproved (\ x -> case x of) - (%~) SCI SCS = Disproved (\ x -> case x of) - (%~) SCI SCT = Disproved (\ x -> case x of) - (%~) SCI SCU = Disproved (\ x -> case x of) - (%~) SCI SCV = Disproved (\ x -> case x of) - (%~) SCI SCW = Disproved (\ x -> case x of) - (%~) SCI SCX = Disproved (\ x -> case x of) - (%~) SCI SCY = Disproved (\ x -> case x of) - (%~) SCI SCZ = Disproved (\ x -> case x of) - (%~) SCJ SCA = Disproved (\ x -> case x of) - (%~) SCJ SCB = Disproved (\ x -> case x of) - (%~) SCJ SCC = Disproved (\ x -> case x of) - (%~) SCJ SCD = Disproved (\ x -> case x of) - (%~) SCJ SCE = Disproved (\ x -> case x of) - (%~) SCJ SCF = Disproved (\ x -> case x of) - (%~) SCJ SCG = Disproved (\ x -> case x of) - (%~) SCJ SCH = Disproved (\ x -> case x of) - (%~) SCJ SCI = Disproved (\ x -> case x of) - (%~) SCJ SCJ = Proved Refl - (%~) SCJ SCK = Disproved (\ x -> case x of) - (%~) SCJ SCL = Disproved (\ x -> case x of) - (%~) SCJ SCM = Disproved (\ x -> case x of) - (%~) SCJ SCN = Disproved (\ x -> case x of) - (%~) SCJ SCO = Disproved (\ x -> case x of) - (%~) SCJ SCP = Disproved (\ x -> case x of) - (%~) SCJ SCQ = Disproved (\ x -> case x of) - (%~) SCJ SCR = Disproved (\ x -> case x of) - (%~) SCJ SCS = Disproved (\ x -> case x of) - (%~) SCJ SCT = Disproved (\ x -> case x of) - (%~) SCJ SCU = Disproved (\ x -> case x of) - (%~) SCJ SCV = Disproved (\ x -> case x of) - (%~) SCJ SCW = Disproved (\ x -> case x of) - (%~) SCJ SCX = Disproved (\ x -> case x of) - (%~) SCJ SCY = Disproved (\ x -> case x of) - (%~) SCJ SCZ = Disproved (\ x -> case x of) - (%~) SCK SCA = Disproved (\ x -> case x of) - (%~) SCK SCB = Disproved (\ x -> case x of) - (%~) SCK SCC = Disproved (\ x -> case x of) - (%~) SCK SCD = Disproved (\ x -> case x of) - (%~) SCK SCE = Disproved (\ x -> case x of) - (%~) SCK SCF = Disproved (\ x -> case x of) - (%~) SCK SCG = Disproved (\ x -> case x of) - (%~) SCK SCH = Disproved (\ x -> case x of) - (%~) SCK SCI = Disproved (\ x -> case x of) - (%~) SCK SCJ = Disproved (\ x -> case x of) - (%~) SCK SCK = Proved Refl - (%~) SCK SCL = Disproved (\ x -> case x of) - (%~) SCK SCM = Disproved (\ x -> case x of) - (%~) SCK SCN = Disproved (\ x -> case x of) - (%~) SCK SCO = Disproved (\ x -> case x of) - (%~) SCK SCP = Disproved (\ x -> case x of) - (%~) SCK SCQ = Disproved (\ x -> case x of) - (%~) SCK SCR = Disproved (\ x -> case x of) - (%~) SCK SCS = Disproved (\ x -> case x of) - (%~) SCK SCT = Disproved (\ x -> case x of) - (%~) SCK SCU = Disproved (\ x -> case x of) - (%~) SCK SCV = Disproved (\ x -> case x of) - (%~) SCK SCW = Disproved (\ x -> case x of) - (%~) SCK SCX = Disproved (\ x -> case x of) - (%~) SCK SCY = Disproved (\ x -> case x of) - (%~) SCK SCZ = Disproved (\ x -> case x of) - (%~) SCL SCA = Disproved (\ x -> case x of) - (%~) SCL SCB = Disproved (\ x -> case x of) - (%~) SCL SCC = Disproved (\ x -> case x of) - (%~) SCL SCD = Disproved (\ x -> case x of) - (%~) SCL SCE = Disproved (\ x -> case x of) - (%~) SCL SCF = Disproved (\ x -> case x of) - (%~) SCL SCG = Disproved (\ x -> case x of) - (%~) SCL SCH = Disproved (\ x -> case x of) - (%~) SCL SCI = Disproved (\ x -> case x of) - (%~) SCL SCJ = Disproved (\ x -> case x of) - (%~) SCL SCK = Disproved (\ x -> case x of) - (%~) SCL SCL = Proved Refl - (%~) SCL SCM = Disproved (\ x -> case x of) - (%~) SCL SCN = Disproved (\ x -> case x of) - (%~) SCL SCO = Disproved (\ x -> case x of) - (%~) SCL SCP = Disproved (\ x -> case x of) - (%~) SCL SCQ = Disproved (\ x -> case x of) - (%~) SCL SCR = Disproved (\ x -> case x of) - (%~) SCL SCS = Disproved (\ x -> case x of) - (%~) SCL SCT = Disproved (\ x -> case x of) - (%~) SCL SCU = Disproved (\ x -> case x of) - (%~) SCL SCV = Disproved (\ x -> case x of) - (%~) SCL SCW = Disproved (\ x -> case x of) - (%~) SCL SCX = Disproved (\ x -> case x of) - (%~) SCL SCY = Disproved (\ x -> case x of) - (%~) SCL SCZ = Disproved (\ x -> case x of) - (%~) SCM SCA = Disproved (\ x -> case x of) - (%~) SCM SCB = Disproved (\ x -> case x of) - (%~) SCM SCC = Disproved (\ x -> case x of) - (%~) SCM SCD = Disproved (\ x -> case x of) - (%~) SCM SCE = Disproved (\ x -> case x of) - (%~) SCM SCF = Disproved (\ x -> case x of) - (%~) SCM SCG = Disproved (\ x -> case x of) - (%~) SCM SCH = Disproved (\ x -> case x of) - (%~) SCM SCI = Disproved (\ x -> case x of) - (%~) SCM SCJ = Disproved (\ x -> case x of) - (%~) SCM SCK = Disproved (\ x -> case x of) - (%~) SCM SCL = Disproved (\ x -> case x of) - (%~) SCM SCM = Proved Refl - (%~) SCM SCN = Disproved (\ x -> case x of) - (%~) SCM SCO = Disproved (\ x -> case x of) - (%~) SCM SCP = Disproved (\ x -> case x of) - (%~) SCM SCQ = Disproved (\ x -> case x of) - (%~) SCM SCR = Disproved (\ x -> case x of) - (%~) SCM SCS = Disproved (\ x -> case x of) - (%~) SCM SCT = Disproved (\ x -> case x of) - (%~) SCM SCU = Disproved (\ x -> case x of) - (%~) SCM SCV = Disproved (\ x -> case x of) - (%~) SCM SCW = Disproved (\ x -> case x of) - (%~) SCM SCX = Disproved (\ x -> case x of) - (%~) SCM SCY = Disproved (\ x -> case x of) - (%~) SCM SCZ = Disproved (\ x -> case x of) - (%~) SCN SCA = Disproved (\ x -> case x of) - (%~) SCN SCB = Disproved (\ x -> case x of) - (%~) SCN SCC = Disproved (\ x -> case x of) - (%~) SCN SCD = Disproved (\ x -> case x of) - (%~) SCN SCE = Disproved (\ x -> case x of) - (%~) SCN SCF = Disproved (\ x -> case x of) - (%~) SCN SCG = Disproved (\ x -> case x of) - (%~) SCN SCH = Disproved (\ x -> case x of) - (%~) SCN SCI = Disproved (\ x -> case x of) - (%~) SCN SCJ = Disproved (\ x -> case x of) - (%~) SCN SCK = Disproved (\ x -> case x of) - (%~) SCN SCL = Disproved (\ x -> case x of) - (%~) SCN SCM = Disproved (\ x -> case x of) - (%~) SCN SCN = Proved Refl - (%~) SCN SCO = Disproved (\ x -> case x of) - (%~) SCN SCP = Disproved (\ x -> case x of) - (%~) SCN SCQ = Disproved (\ x -> case x of) - (%~) SCN SCR = Disproved (\ x -> case x of) - (%~) SCN SCS = Disproved (\ x -> case x of) - (%~) SCN SCT = Disproved (\ x -> case x of) - (%~) SCN SCU = Disproved (\ x -> case x of) - (%~) SCN SCV = Disproved (\ x -> case x of) - (%~) SCN SCW = Disproved (\ x -> case x of) - (%~) SCN SCX = Disproved (\ x -> case x of) - (%~) SCN SCY = Disproved (\ x -> case x of) - (%~) SCN SCZ = Disproved (\ x -> case x of) - (%~) SCO SCA = Disproved (\ x -> case x of) - (%~) SCO SCB = Disproved (\ x -> case x of) - (%~) SCO SCC = Disproved (\ x -> case x of) - (%~) SCO SCD = Disproved (\ x -> case x of) - (%~) SCO SCE = Disproved (\ x -> case x of) - (%~) SCO SCF = Disproved (\ x -> case x of) - (%~) SCO SCG = Disproved (\ x -> case x of) - (%~) SCO SCH = Disproved (\ x -> case x of) - (%~) SCO SCI = Disproved (\ x -> case x of) - (%~) SCO SCJ = Disproved (\ x -> case x of) - (%~) SCO SCK = Disproved (\ x -> case x of) - (%~) SCO SCL = Disproved (\ x -> case x of) - (%~) SCO SCM = Disproved (\ x -> case x of) - (%~) SCO SCN = Disproved (\ x -> case x of) - (%~) SCO SCO = Proved Refl - (%~) SCO SCP = Disproved (\ x -> case x of) - (%~) SCO SCQ = Disproved (\ x -> case x of) - (%~) SCO SCR = Disproved (\ x -> case x of) - (%~) SCO SCS = Disproved (\ x -> case x of) - (%~) SCO SCT = Disproved (\ x -> case x of) - (%~) SCO SCU = Disproved (\ x -> case x of) - (%~) SCO SCV = Disproved (\ x -> case x of) - (%~) SCO SCW = Disproved (\ x -> case x of) - (%~) SCO SCX = Disproved (\ x -> case x of) - (%~) SCO SCY = Disproved (\ x -> case x of) - (%~) SCO SCZ = Disproved (\ x -> case x of) - (%~) SCP SCA = Disproved (\ x -> case x of) - (%~) SCP SCB = Disproved (\ x -> case x of) - (%~) SCP SCC = Disproved (\ x -> case x of) - (%~) SCP SCD = Disproved (\ x -> case x of) - (%~) SCP SCE = Disproved (\ x -> case x of) - (%~) SCP SCF = Disproved (\ x -> case x of) - (%~) SCP SCG = Disproved (\ x -> case x of) - (%~) SCP SCH = Disproved (\ x -> case x of) - (%~) SCP SCI = Disproved (\ x -> case x of) - (%~) SCP SCJ = Disproved (\ x -> case x of) - (%~) SCP SCK = Disproved (\ x -> case x of) - (%~) SCP SCL = Disproved (\ x -> case x of) - (%~) SCP SCM = Disproved (\ x -> case x of) - (%~) SCP SCN = Disproved (\ x -> case x of) - (%~) SCP SCO = Disproved (\ x -> case x of) - (%~) SCP SCP = Proved Refl - (%~) SCP SCQ = Disproved (\ x -> case x of) - (%~) SCP SCR = Disproved (\ x -> case x of) - (%~) SCP SCS = Disproved (\ x -> case x of) - (%~) SCP SCT = Disproved (\ x -> case x of) - (%~) SCP SCU = Disproved (\ x -> case x of) - (%~) SCP SCV = Disproved (\ x -> case x of) - (%~) SCP SCW = Disproved (\ x -> case x of) - (%~) SCP SCX = Disproved (\ x -> case x of) - (%~) SCP SCY = Disproved (\ x -> case x of) - (%~) SCP SCZ = Disproved (\ x -> case x of) - (%~) SCQ SCA = Disproved (\ x -> case x of) - (%~) SCQ SCB = Disproved (\ x -> case x of) - (%~) SCQ SCC = Disproved (\ x -> case x of) - (%~) SCQ SCD = Disproved (\ x -> case x of) - (%~) SCQ SCE = Disproved (\ x -> case x of) - (%~) SCQ SCF = Disproved (\ x -> case x of) - (%~) SCQ SCG = Disproved (\ x -> case x of) - (%~) SCQ SCH = Disproved (\ x -> case x of) - (%~) SCQ SCI = Disproved (\ x -> case x of) - (%~) SCQ SCJ = Disproved (\ x -> case x of) - (%~) SCQ SCK = Disproved (\ x -> case x of) - (%~) SCQ SCL = Disproved (\ x -> case x of) - (%~) SCQ SCM = Disproved (\ x -> case x of) - (%~) SCQ SCN = Disproved (\ x -> case x of) - (%~) SCQ SCO = Disproved (\ x -> case x of) - (%~) SCQ SCP = Disproved (\ x -> case x of) - (%~) SCQ SCQ = Proved Refl - (%~) SCQ SCR = Disproved (\ x -> case x of) - (%~) SCQ SCS = Disproved (\ x -> case x of) - (%~) SCQ SCT = Disproved (\ x -> case x of) - (%~) SCQ SCU = Disproved (\ x -> case x of) - (%~) SCQ SCV = Disproved (\ x -> case x of) - (%~) SCQ SCW = Disproved (\ x -> case x of) - (%~) SCQ SCX = Disproved (\ x -> case x of) - (%~) SCQ SCY = Disproved (\ x -> case x of) - (%~) SCQ SCZ = Disproved (\ x -> case x of) - (%~) SCR SCA = Disproved (\ x -> case x of) - (%~) SCR SCB = Disproved (\ x -> case x of) - (%~) SCR SCC = Disproved (\ x -> case x of) - (%~) SCR SCD = Disproved (\ x -> case x of) - (%~) SCR SCE = Disproved (\ x -> case x of) - (%~) SCR SCF = Disproved (\ x -> case x of) - (%~) SCR SCG = Disproved (\ x -> case x of) - (%~) SCR SCH = Disproved (\ x -> case x of) - (%~) SCR SCI = Disproved (\ x -> case x of) - (%~) SCR SCJ = Disproved (\ x -> case x of) - (%~) SCR SCK = Disproved (\ x -> case x of) - (%~) SCR SCL = Disproved (\ x -> case x of) - (%~) SCR SCM = Disproved (\ x -> case x of) - (%~) SCR SCN = Disproved (\ x -> case x of) - (%~) SCR SCO = Disproved (\ x -> case x of) - (%~) SCR SCP = Disproved (\ x -> case x of) - (%~) SCR SCQ = Disproved (\ x -> case x of) - (%~) SCR SCR = Proved Refl - (%~) SCR SCS = Disproved (\ x -> case x of) - (%~) SCR SCT = Disproved (\ x -> case x of) - (%~) SCR SCU = Disproved (\ x -> case x of) - (%~) SCR SCV = Disproved (\ x -> case x of) - (%~) SCR SCW = Disproved (\ x -> case x of) - (%~) SCR SCX = Disproved (\ x -> case x of) - (%~) SCR SCY = Disproved (\ x -> case x of) - (%~) SCR SCZ = Disproved (\ x -> case x of) - (%~) SCS SCA = Disproved (\ x -> case x of) - (%~) SCS SCB = Disproved (\ x -> case x of) - (%~) SCS SCC = Disproved (\ x -> case x of) - (%~) SCS SCD = Disproved (\ x -> case x of) - (%~) SCS SCE = Disproved (\ x -> case x of) - (%~) SCS SCF = Disproved (\ x -> case x of) - (%~) SCS SCG = Disproved (\ x -> case x of) - (%~) SCS SCH = Disproved (\ x -> case x of) - (%~) SCS SCI = Disproved (\ x -> case x of) - (%~) SCS SCJ = Disproved (\ x -> case x of) - (%~) SCS SCK = Disproved (\ x -> case x of) - (%~) SCS SCL = Disproved (\ x -> case x of) - (%~) SCS SCM = Disproved (\ x -> case x of) - (%~) SCS SCN = Disproved (\ x -> case x of) - (%~) SCS SCO = Disproved (\ x -> case x of) - (%~) SCS SCP = Disproved (\ x -> case x of) - (%~) SCS SCQ = Disproved (\ x -> case x of) - (%~) SCS SCR = Disproved (\ x -> case x of) - (%~) SCS SCS = Proved Refl - (%~) SCS SCT = Disproved (\ x -> case x of) - (%~) SCS SCU = Disproved (\ x -> case x of) - (%~) SCS SCV = Disproved (\ x -> case x of) - (%~) SCS SCW = Disproved (\ x -> case x of) - (%~) SCS SCX = Disproved (\ x -> case x of) - (%~) SCS SCY = Disproved (\ x -> case x of) - (%~) SCS SCZ = Disproved (\ x -> case x of) - (%~) SCT SCA = Disproved (\ x -> case x of) - (%~) SCT SCB = Disproved (\ x -> case x of) - (%~) SCT SCC = Disproved (\ x -> case x of) - (%~) SCT SCD = Disproved (\ x -> case x of) - (%~) SCT SCE = Disproved (\ x -> case x of) - (%~) SCT SCF = Disproved (\ x -> case x of) - (%~) SCT SCG = Disproved (\ x -> case x of) - (%~) SCT SCH = Disproved (\ x -> case x of) - (%~) SCT SCI = Disproved (\ x -> case x of) - (%~) SCT SCJ = Disproved (\ x -> case x of) - (%~) SCT SCK = Disproved (\ x -> case x of) - (%~) SCT SCL = Disproved (\ x -> case x of) - (%~) SCT SCM = Disproved (\ x -> case x of) - (%~) SCT SCN = Disproved (\ x -> case x of) - (%~) SCT SCO = Disproved (\ x -> case x of) - (%~) SCT SCP = Disproved (\ x -> case x of) - (%~) SCT SCQ = Disproved (\ x -> case x of) - (%~) SCT SCR = Disproved (\ x -> case x of) - (%~) SCT SCS = Disproved (\ x -> case x of) - (%~) SCT SCT = Proved Refl - (%~) SCT SCU = Disproved (\ x -> case x of) - (%~) SCT SCV = Disproved (\ x -> case x of) - (%~) SCT SCW = Disproved (\ x -> case x of) - (%~) SCT SCX = Disproved (\ x -> case x of) - (%~) SCT SCY = Disproved (\ x -> case x of) - (%~) SCT SCZ = Disproved (\ x -> case x of) - (%~) SCU SCA = Disproved (\ x -> case x of) - (%~) SCU SCB = Disproved (\ x -> case x of) - (%~) SCU SCC = Disproved (\ x -> case x of) - (%~) SCU SCD = Disproved (\ x -> case x of) - (%~) SCU SCE = Disproved (\ x -> case x of) - (%~) SCU SCF = Disproved (\ x -> case x of) - (%~) SCU SCG = Disproved (\ x -> case x of) - (%~) SCU SCH = Disproved (\ x -> case x of) - (%~) SCU SCI = Disproved (\ x -> case x of) - (%~) SCU SCJ = Disproved (\ x -> case x of) - (%~) SCU SCK = Disproved (\ x -> case x of) - (%~) SCU SCL = Disproved (\ x -> case x of) - (%~) SCU SCM = Disproved (\ x -> case x of) - (%~) SCU SCN = Disproved (\ x -> case x of) - (%~) SCU SCO = Disproved (\ x -> case x of) - (%~) SCU SCP = Disproved (\ x -> case x of) - (%~) SCU SCQ = Disproved (\ x -> case x of) - (%~) SCU SCR = Disproved (\ x -> case x of) - (%~) SCU SCS = Disproved (\ x -> case x of) - (%~) SCU SCT = Disproved (\ x -> case x of) - (%~) SCU SCU = Proved Refl - (%~) SCU SCV = Disproved (\ x -> case x of) - (%~) SCU SCW = Disproved (\ x -> case x of) - (%~) SCU SCX = Disproved (\ x -> case x of) - (%~) SCU SCY = Disproved (\ x -> case x of) - (%~) SCU SCZ = Disproved (\ x -> case x of) - (%~) SCV SCA = Disproved (\ x -> case x of) - (%~) SCV SCB = Disproved (\ x -> case x of) - (%~) SCV SCC = Disproved (\ x -> case x of) - (%~) SCV SCD = Disproved (\ x -> case x of) - (%~) SCV SCE = Disproved (\ x -> case x of) - (%~) SCV SCF = Disproved (\ x -> case x of) - (%~) SCV SCG = Disproved (\ x -> case x of) - (%~) SCV SCH = Disproved (\ x -> case x of) - (%~) SCV SCI = Disproved (\ x -> case x of) - (%~) SCV SCJ = Disproved (\ x -> case x of) - (%~) SCV SCK = Disproved (\ x -> case x of) - (%~) SCV SCL = Disproved (\ x -> case x of) - (%~) SCV SCM = Disproved (\ x -> case x of) - (%~) SCV SCN = Disproved (\ x -> case x of) - (%~) SCV SCO = Disproved (\ x -> case x of) - (%~) SCV SCP = Disproved (\ x -> case x of) - (%~) SCV SCQ = Disproved (\ x -> case x of) - (%~) SCV SCR = Disproved (\ x -> case x of) - (%~) SCV SCS = Disproved (\ x -> case x of) - (%~) SCV SCT = Disproved (\ x -> case x of) - (%~) SCV SCU = Disproved (\ x -> case x of) - (%~) SCV SCV = Proved Refl - (%~) SCV SCW = Disproved (\ x -> case x of) - (%~) SCV SCX = Disproved (\ x -> case x of) - (%~) SCV SCY = Disproved (\ x -> case x of) - (%~) SCV SCZ = Disproved (\ x -> case x of) - (%~) SCW SCA = Disproved (\ x -> case x of) - (%~) SCW SCB = Disproved (\ x -> case x of) - (%~) SCW SCC = Disproved (\ x -> case x of) - (%~) SCW SCD = Disproved (\ x -> case x of) - (%~) SCW SCE = Disproved (\ x -> case x of) - (%~) SCW SCF = Disproved (\ x -> case x of) - (%~) SCW SCG = Disproved (\ x -> case x of) - (%~) SCW SCH = Disproved (\ x -> case x of) - (%~) SCW SCI = Disproved (\ x -> case x of) - (%~) SCW SCJ = Disproved (\ x -> case x of) - (%~) SCW SCK = Disproved (\ x -> case x of) - (%~) SCW SCL = Disproved (\ x -> case x of) - (%~) SCW SCM = Disproved (\ x -> case x of) - (%~) SCW SCN = Disproved (\ x -> case x of) - (%~) SCW SCO = Disproved (\ x -> case x of) - (%~) SCW SCP = Disproved (\ x -> case x of) - (%~) SCW SCQ = Disproved (\ x -> case x of) - (%~) SCW SCR = Disproved (\ x -> case x of) - (%~) SCW SCS = Disproved (\ x -> case x of) - (%~) SCW SCT = Disproved (\ x -> case x of) - (%~) SCW SCU = Disproved (\ x -> case x of) - (%~) SCW SCV = Disproved (\ x -> case x of) - (%~) SCW SCW = Proved Refl - (%~) SCW SCX = Disproved (\ x -> case x of) - (%~) SCW SCY = Disproved (\ x -> case x of) - (%~) SCW SCZ = Disproved (\ x -> case x of) - (%~) SCX SCA = Disproved (\ x -> case x of) - (%~) SCX SCB = Disproved (\ x -> case x of) - (%~) SCX SCC = Disproved (\ x -> case x of) - (%~) SCX SCD = Disproved (\ x -> case x of) - (%~) SCX SCE = Disproved (\ x -> case x of) - (%~) SCX SCF = Disproved (\ x -> case x of) - (%~) SCX SCG = Disproved (\ x -> case x of) - (%~) SCX SCH = Disproved (\ x -> case x of) - (%~) SCX SCI = Disproved (\ x -> case x of) - (%~) SCX SCJ = Disproved (\ x -> case x of) - (%~) SCX SCK = Disproved (\ x -> case x of) - (%~) SCX SCL = Disproved (\ x -> case x of) - (%~) SCX SCM = Disproved (\ x -> case x of) - (%~) SCX SCN = Disproved (\ x -> case x of) - (%~) SCX SCO = Disproved (\ x -> case x of) - (%~) SCX SCP = Disproved (\ x -> case x of) - (%~) SCX SCQ = Disproved (\ x -> case x of) - (%~) SCX SCR = Disproved (\ x -> case x of) - (%~) SCX SCS = Disproved (\ x -> case x of) - (%~) SCX SCT = Disproved (\ x -> case x of) - (%~) SCX SCU = Disproved (\ x -> case x of) - (%~) SCX SCV = Disproved (\ x -> case x of) - (%~) SCX SCW = Disproved (\ x -> case x of) - (%~) SCX SCX = Proved Refl - (%~) SCX SCY = Disproved (\ x -> case x of) - (%~) SCX SCZ = Disproved (\ x -> case x of) - (%~) SCY SCA = Disproved (\ x -> case x of) - (%~) SCY SCB = Disproved (\ x -> case x of) - (%~) SCY SCC = Disproved (\ x -> case x of) - (%~) SCY SCD = Disproved (\ x -> case x of) - (%~) SCY SCE = Disproved (\ x -> case x of) - (%~) SCY SCF = Disproved (\ x -> case x of) - (%~) SCY SCG = Disproved (\ x -> case x of) - (%~) SCY SCH = Disproved (\ x -> case x of) - (%~) SCY SCI = Disproved (\ x -> case x of) - (%~) SCY SCJ = Disproved (\ x -> case x of) - (%~) SCY SCK = Disproved (\ x -> case x of) - (%~) SCY SCL = Disproved (\ x -> case x of) - (%~) SCY SCM = Disproved (\ x -> case x of) - (%~) SCY SCN = Disproved (\ x -> case x of) - (%~) SCY SCO = Disproved (\ x -> case x of) - (%~) SCY SCP = Disproved (\ x -> case x of) - (%~) SCY SCQ = Disproved (\ x -> case x of) - (%~) SCY SCR = Disproved (\ x -> case x of) - (%~) SCY SCS = Disproved (\ x -> case x of) - (%~) SCY SCT = Disproved (\ x -> case x of) - (%~) SCY SCU = Disproved (\ x -> case x of) - (%~) SCY SCV = Disproved (\ x -> case x of) - (%~) SCY SCW = Disproved (\ x -> case x of) - (%~) SCY SCX = Disproved (\ x -> case x of) - (%~) SCY SCY = Proved Refl - (%~) SCY SCZ = Disproved (\ x -> case x of) - (%~) SCZ SCA = Disproved (\ x -> case x of) - (%~) SCZ SCB = Disproved (\ x -> case x of) - (%~) SCZ SCC = Disproved (\ x -> case x of) - (%~) SCZ SCD = Disproved (\ x -> case x of) - (%~) SCZ SCE = Disproved (\ x -> case x of) - (%~) SCZ SCF = Disproved (\ x -> case x of) - (%~) SCZ SCG = Disproved (\ x -> case x of) - (%~) SCZ SCH = Disproved (\ x -> case x of) - (%~) SCZ SCI = Disproved (\ x -> case x of) - (%~) SCZ SCJ = Disproved (\ x -> case x of) - (%~) SCZ SCK = Disproved (\ x -> case x of) - (%~) SCZ SCL = Disproved (\ x -> case x of) - (%~) SCZ SCM = Disproved (\ x -> case x of) - (%~) SCZ SCN = Disproved (\ x -> case x of) - (%~) SCZ SCO = Disproved (\ x -> case x of) - (%~) SCZ SCP = Disproved (\ x -> case x of) - (%~) SCZ SCQ = Disproved (\ x -> case x of) - (%~) SCZ SCR = Disproved (\ x -> case x of) - (%~) SCZ SCS = Disproved (\ x -> case x of) - (%~) SCZ SCT = Disproved (\ x -> case x of) - (%~) SCZ SCU = Disproved (\ x -> case x of) - (%~) SCZ SCV = Disproved (\ x -> case x of) - (%~) SCZ SCW = Disproved (\ x -> case x of) - (%~) SCZ SCX = Disproved (\ x -> case x of) - (%~) SCZ SCY = Disproved (\ x -> case x of) - (%~) SCZ SCZ = Proved Refl - instance (Data.Singletons.ShowSing.ShowSing U, - Data.Singletons.ShowSing.ShowSing Nat) => - Data.Singletons.ShowSing.ShowSing U where - Data.Singletons.ShowSing.showsSingPrec _ SBOOL = showString "SBOOL" - Data.Singletons.ShowSing.showsSingPrec _ SSTRING - = showString "SSTRING" - Data.Singletons.ShowSing.showsSingPrec _ SNAT = showString "SNAT" - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SVEC arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SVEC ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - (((.) GHC.Show.showSpace) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)))) - instance (Data.Singletons.ShowSing.ShowSing U, - Data.Singletons.ShowSing.ShowSing Nat) => - Show (Sing (z :: U)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance Data.Singletons.ShowSing.ShowSing AChar where - Data.Singletons.ShowSing.showsSingPrec _ SCA = showString "SCA" - Data.Singletons.ShowSing.showsSingPrec _ SCB = showString "SCB" - Data.Singletons.ShowSing.showsSingPrec _ SCC = showString "SCC" - Data.Singletons.ShowSing.showsSingPrec _ SCD = showString "SCD" - Data.Singletons.ShowSing.showsSingPrec _ SCE = showString "SCE" - Data.Singletons.ShowSing.showsSingPrec _ SCF = showString "SCF" - Data.Singletons.ShowSing.showsSingPrec _ SCG = showString "SCG" - Data.Singletons.ShowSing.showsSingPrec _ SCH = showString "SCH" - Data.Singletons.ShowSing.showsSingPrec _ SCI = showString "SCI" - Data.Singletons.ShowSing.showsSingPrec _ SCJ = showString "SCJ" - Data.Singletons.ShowSing.showsSingPrec _ SCK = showString "SCK" - Data.Singletons.ShowSing.showsSingPrec _ SCL = showString "SCL" - Data.Singletons.ShowSing.showsSingPrec _ SCM = showString "SCM" - Data.Singletons.ShowSing.showsSingPrec _ SCN = showString "SCN" - Data.Singletons.ShowSing.showsSingPrec _ SCO = showString "SCO" - Data.Singletons.ShowSing.showsSingPrec _ SCP = showString "SCP" - Data.Singletons.ShowSing.showsSingPrec _ SCQ = showString "SCQ" - Data.Singletons.ShowSing.showsSingPrec _ SCR = showString "SCR" - Data.Singletons.ShowSing.showsSingPrec _ SCS = showString "SCS" - Data.Singletons.ShowSing.showsSingPrec _ SCT = showString "SCT" - Data.Singletons.ShowSing.showsSingPrec _ SCU = showString "SCU" - Data.Singletons.ShowSing.showsSingPrec _ SCV = showString "SCV" - Data.Singletons.ShowSing.showsSingPrec _ SCW = showString "SCW" - Data.Singletons.ShowSing.showsSingPrec _ SCX = showString "SCX" - Data.Singletons.ShowSing.showsSingPrec _ SCY = showString "SCY" - Data.Singletons.ShowSing.showsSingPrec _ SCZ = showString "SCZ" - instance Show (Sing (z :: AChar)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI BOOL where - sing = SBOOL - instance SingI STRING where - sing = SSTRING - instance SingI NAT where - sing = SNAT - instance (SingI n, SingI n) => - SingI (VEC (n :: U) (n :: Nat)) where - sing = (SVEC sing) sing - instance SingI CA where - sing = SCA - instance SingI CB where - sing = SCB - instance SingI CC where - sing = SCC - instance SingI CD where - sing = SCD - instance SingI CE where - sing = SCE - instance SingI CF where - sing = SCF - instance SingI CG where - sing = SCG - instance SingI CH where - sing = SCH - instance SingI CI where - sing = SCI - instance SingI CJ where - sing = SCJ - instance SingI CK where - sing = SCK - instance SingI CL where - sing = SCL - instance SingI CM where - sing = SCM - instance SingI CN where - sing = SCN - instance SingI CO where - sing = SCO - instance SingI CP where - sing = SCP - instance SingI CQ where - sing = SCQ - instance SingI CR where - sing = SCR - instance SingI CS where - sing = SCS - instance SingI CT where - sing = SCT - instance SingI CU where - sing = SCU - instance SingI CV where - sing = SCV - instance SingI CW where - sing = SCW - instance SingI CX where - sing = SCX - instance SingI CY where - sing = SCY - instance SingI CZ where - sing = SCZ - instance (SingI n, SingI n) => - SingI (Attr (n :: [AChar]) (n :: U)) where - sing = (SAttr sing) sing - instance SingI n => SingI (Sch (n :: [Attribute])) where - sing = SSch sing -GradingClient/Database.hs:0:0:: Splicing declarations - return [] ======> -GradingClient/Database.hs:(0,0)-(0,0): Splicing expression - cases ''Row [| r |] [| changeId (n ++ (getId r)) r |] - ======> - case r of - EmptyRow _ -> (changeId (((++) n) (getId r))) r - ConsRow _ _ -> (changeId (((++) n) (getId r))) r diff --git a/tests/compile-and-dump/GradingClient/Database.ghc86.template b/tests/compile-and-dump/GradingClient/Database.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Database.ghc86.template @@ -0,0 +1,2610 @@ +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + type ZeroSym0 = Zero + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) + data SuccSym0 :: (~>) Nat Nat + where + SuccSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0 t0123456789876543210 + type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: Nat -> Type + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) + -> Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance SingI (SuccSym0 :: (~>) Nat Nat) where + sing = (singFun1 @SuccSym0) SSucc + instance SingI (TyCon1 Succ :: (~>) Nat Nat) where + sing = (singFun1 @(TyCon1 Succ)) SSucc +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch []) = True + attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) + = (name /= name') && (attrNotIn (Attr name u) (Sch t)) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch []) _ = True + disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch []) = False + occurs name (Sch ((Attr name' _) : attrs)) + = name == name' || occurs name (Sch attrs) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch []) = undefined + lookup name (Sch ((Attr name' u) : attrs)) + = if name == name' then u else lookup name (Sch attrs) + + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] |] + ======> + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] + append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch []) = True + attrNotIn (Attr name u) (Sch (Attr name' _ : t)) + = ((name /= name') && (attrNotIn ((Attr name) u)) (Sch t)) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch []) _ = True + disjoint (Sch (h : t)) s + = ((attrNotIn h) s && (disjoint (Sch t)) s) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch []) = False + occurs name (Sch (Attr name' _ : attrs)) + = ((name == name') || (occurs name) (Sch attrs)) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch []) = undefined + lookup name (Sch (Attr name' u : attrs)) + = if (name == name') then u else (lookup name) (Sch attrs) + type BOOLSym0 = BOOL + type STRINGSym0 = STRING + type NATSym0 = NAT + type VECSym2 (t0123456789876543210 :: U) (t0123456789876543210 :: Nat) = + VEC t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (VECSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) VECSym1KindInference) ()) + data VECSym1 (t0123456789876543210 :: U) :: (~>) Nat U + where + VECSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (VECSym1 t0123456789876543210) arg) (VECSym2 t0123456789876543210 arg) => + VECSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (VECSym1 t0123456789876543210) t0123456789876543210 = VEC t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings VECSym0 where + suppressUnusedWarnings = snd (((,) VECSym0KindInference) ()) + data VECSym0 :: (~>) U ((~>) Nat U) + where + VECSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => + VECSym0 t0123456789876543210 + type instance Apply VECSym0 t0123456789876543210 = VECSym1 t0123456789876543210 + type CASym0 = CA + type CBSym0 = CB + type CCSym0 = CC + type CDSym0 = CD + type CESym0 = CE + type CFSym0 = CF + type CGSym0 = CG + type CHSym0 = CH + type CISym0 = CI + type CJSym0 = CJ + type CKSym0 = CK + type CLSym0 = CL + type CMSym0 = CM + type CNSym0 = CN + type COSym0 = CO + type CPSym0 = CP + type CQSym0 = CQ + type CRSym0 = CR + type CSSym0 = CS + type CTSym0 = CT + type CUSym0 = CU + type CVSym0 = CV + type CWSym0 = CW + type CXSym0 = CX + type CYSym0 = CY + type CZSym0 = CZ + type AttrSym2 (t0123456789876543210 :: [AChar]) (t0123456789876543210 :: U) = + Attr t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (AttrSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) AttrSym1KindInference) ()) + data AttrSym1 (t0123456789876543210 :: [AChar]) :: (~>) U Attribute + where + AttrSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (AttrSym1 t0123456789876543210) arg) (AttrSym2 t0123456789876543210 arg) => + AttrSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (AttrSym1 t0123456789876543210) t0123456789876543210 = Attr t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings AttrSym0 where + suppressUnusedWarnings = snd (((,) AttrSym0KindInference) ()) + data AttrSym0 :: (~>) [AChar] ((~>) U Attribute) + where + AttrSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => + AttrSym0 t0123456789876543210 + type instance Apply AttrSym0 t0123456789876543210 = AttrSym1 t0123456789876543210 + type SchSym1 (t0123456789876543210 :: [Attribute]) = + Sch t0123456789876543210 + instance SuppressUnusedWarnings SchSym0 where + suppressUnusedWarnings = snd (((,) SchSym0KindInference) ()) + data SchSym0 :: (~>) [Attribute] Schema + where + SchSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => + SchSym0 t0123456789876543210 + type instance Apply SchSym0 t0123456789876543210 = Sch t0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: forall name0123456789876543210 + name'0123456789876543210 + u0123456789876543210 + attrs0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 u0123456789876543210 name'0123456789876543210 name0123456789876543210 attrs0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall name0123456789876543210 + name'0123456789876543210 + u0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name'0123456789876543210 name0123456789876543210 u0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall name0123456789876543210 + name'0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) name'0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall name0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where + Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name' + type family Case_0123456789876543210 name name' u attrs t where + Case_0123456789876543210 name name' u attrs 'True = u + Case_0123456789876543210 name name' u attrs 'False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) + type LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = + Lookup a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) LookupSym1KindInference) ()) + data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U + where + LookupSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) => + LookupSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (LookupSym1 a0123456789876543210) a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings LookupSym0 where + suppressUnusedWarnings = snd (((,) LookupSym0KindInference) ()) + data LookupSym0 :: (~>) [AChar] ((~>) Schema U) + where + LookupSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => + LookupSym0 a0123456789876543210 + type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210 + type OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = + Occurs a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) OccursSym1KindInference) ()) + data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool + where + OccursSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) => + OccursSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (OccursSym1 a0123456789876543210) a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings OccursSym0 where + suppressUnusedWarnings = snd (((,) OccursSym0KindInference) ()) + data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) + where + OccursSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => + OccursSym0 a0123456789876543210 + type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 + type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) = + AttrNotIn a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ()) + data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool + where + AttrNotInSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => + AttrNotInSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings AttrNotInSym0 where + suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) + data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) + where + AttrNotInSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => + AttrNotInSym0 a0123456789876543210 + type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 + type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = + Disjoint a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) DisjointSym1KindInference) ()) + data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool + where + DisjointSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) => + DisjointSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (DisjointSym1 a0123456789876543210) a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings DisjointSym0 where + suppressUnusedWarnings = snd (((,) DisjointSym0KindInference) ()) + data DisjointSym0 :: (~>) Schema ((~>) Schema Bool) + where + DisjointSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => + DisjointSym0 a0123456789876543210 + type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210 + type AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = + Append a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) AppendSym1KindInference) ()) + data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema + where + AppendSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) => + AppendSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (AppendSym1 a0123456789876543210) a0123456789876543210 = Append a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings AppendSym0 where + suppressUnusedWarnings = snd (((,) AppendSym0KindInference) ()) + data AppendSym0 :: (~>) Schema ((~>) Schema Schema) + where + AppendSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => + AppendSym0 a0123456789876543210 + type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210 + type family Lookup (a :: [AChar]) (a :: Schema) :: U where + Lookup _ (Sch '[]) = UndefinedSym0 + Lookup name (Sch ( '(:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) + type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where + Occurs _ (Sch '[]) = FalseSym0 + Occurs name (Sch ( '(:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) + type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where + AttrNotIn _ (Sch '[]) = TrueSym0 + AttrNotIn (Attr name u) (Sch ( '(:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) + type family Disjoint (a :: Schema) (a :: Schema) :: Bool where + Disjoint (Sch '[]) _ = TrueSym0 + Disjoint (Sch ( '(:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) + type family Append (a :: Schema) (a :: Schema) :: Schema where + Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ BOOL a_0123456789876543210 = Apply (Apply ShowStringSym0 "BOOL") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) U ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow U where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ CA a_0123456789876543210 = Apply (Apply ShowStringSym0 "CA") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CB a_0123456789876543210 = Apply (Apply ShowStringSym0 "CB") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CC a_0123456789876543210 = Apply (Apply ShowStringSym0 "CC") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CD a_0123456789876543210 = Apply (Apply ShowStringSym0 "CD") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CE a_0123456789876543210 = Apply (Apply ShowStringSym0 "CE") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CF a_0123456789876543210 = Apply (Apply ShowStringSym0 "CF") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CG a_0123456789876543210 = Apply (Apply ShowStringSym0 "CG") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CH a_0123456789876543210 = Apply (Apply ShowStringSym0 "CH") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CI a_0123456789876543210 = Apply (Apply ShowStringSym0 "CI") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CJ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CJ") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CK a_0123456789876543210 = Apply (Apply ShowStringSym0 "CK") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CL a_0123456789876543210 = Apply (Apply ShowStringSym0 "CL") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CM a_0123456789876543210 = Apply (Apply ShowStringSym0 "CM") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CN a_0123456789876543210 = Apply (Apply ShowStringSym0 "CN") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CO a_0123456789876543210 = Apply (Apply ShowStringSym0 "CO") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CP a_0123456789876543210 = Apply (Apply ShowStringSym0 "CP") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CQ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CQ") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CR a_0123456789876543210 = Apply (Apply ShowStringSym0 "CR") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CS a_0123456789876543210 = Apply (Apply ShowStringSym0 "CS") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CT a_0123456789876543210 = Apply (Apply ShowStringSym0 "CT") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CU a_0123456789876543210 = Apply (Apply ShowStringSym0 "CU") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CV a_0123456789876543210 = Apply (Apply ShowStringSym0 "CV") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CW a_0123456789876543210 = Apply (Apply ShowStringSym0 "CW") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) AChar ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow AChar where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where + Equals_0123456789876543210 BOOL BOOL = TrueSym0 + Equals_0123456789876543210 STRING STRING = TrueSym0 + Equals_0123456789876543210 NAT NAT = TrueSym0 + Equals_0123456789876543210 (VEC a a) (VEC b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: U) (_ :: U) = FalseSym0 + instance PEq U where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where + Equals_0123456789876543210 CA CA = TrueSym0 + Equals_0123456789876543210 CB CB = TrueSym0 + Equals_0123456789876543210 CC CC = TrueSym0 + Equals_0123456789876543210 CD CD = TrueSym0 + Equals_0123456789876543210 CE CE = TrueSym0 + Equals_0123456789876543210 CF CF = TrueSym0 + Equals_0123456789876543210 CG CG = TrueSym0 + Equals_0123456789876543210 CH CH = TrueSym0 + Equals_0123456789876543210 CI CI = TrueSym0 + Equals_0123456789876543210 CJ CJ = TrueSym0 + Equals_0123456789876543210 CK CK = TrueSym0 + Equals_0123456789876543210 CL CL = TrueSym0 + Equals_0123456789876543210 CM CM = TrueSym0 + Equals_0123456789876543210 CN CN = TrueSym0 + Equals_0123456789876543210 CO CO = TrueSym0 + Equals_0123456789876543210 CP CP = TrueSym0 + Equals_0123456789876543210 CQ CQ = TrueSym0 + Equals_0123456789876543210 CR CR = TrueSym0 + Equals_0123456789876543210 CS CS = TrueSym0 + Equals_0123456789876543210 CT CT = TrueSym0 + Equals_0123456789876543210 CU CU = TrueSym0 + Equals_0123456789876543210 CV CV = TrueSym0 + Equals_0123456789876543210 CW CW = TrueSym0 + Equals_0123456789876543210 CX CX = TrueSym0 + Equals_0123456789876543210 CY CY = TrueSym0 + Equals_0123456789876543210 CZ CZ = TrueSym0 + Equals_0123456789876543210 (_ :: AChar) (_ :: AChar) = FalseSym0 + instance PEq AChar where + type (==) a b = Equals_0123456789876543210 a b + sLookup :: + forall (t :: [AChar]) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) + sOccurs :: + forall (t :: [AChar]) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) + sAttrNotIn :: + forall (t :: Attribute) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) + sDisjoint :: + forall (t :: Schema) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) + sAppend :: + forall (t :: Schema) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) + sLookup _ (SSch SNil) = sUndefined + sLookup + (sName :: Sing name) + (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u)) + (sAttrs :: Sing attrs))) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) + sName' + in (case sScrutinee_0123456789876543210 of + STrue -> sU + SFalse + -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName)) + ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) :: + Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U) + sOccurs _ (SSch SNil) = SFalse + sOccurs + (sName :: Sing name) + (SSch (SCons (SAttr (sName' :: Sing name') _) + (sAttrs :: Sing attrs))) + = (applySing + ((applySing ((singFun2 @(||@#@$)) (%||))) + ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) + sName'))) + ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) + ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) + sAttrNotIn _ (SSch SNil) = STrue + sAttrNotIn + (SAttr (sName :: Sing name) (sU :: Sing u)) + (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) + = (applySing + ((applySing ((singFun2 @(&&@#@$)) (%&&))) + ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) + sName'))) + ((applySing + ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) + ((applySing ((singFun1 @SchSym0) SSch)) sT)) + sDisjoint (SSch SNil) _ = STrue + sDisjoint + (SSch (SCons (sH :: Sing h) (sT :: Sing t))) + (sS :: Sing s) + = (applySing + ((applySing ((singFun2 @(&&@#@$)) (%&&))) + ((applySing + ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH)) + sS))) + ((applySing + ((applySing ((singFun2 @DisjointSym0) sDisjoint)) + ((applySing ((singFun1 @SchSym0) SSch)) sT))) + sS) + sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2) + instance SingI (LookupSym0 :: (~>) [AChar] ((~>) Schema U)) where + sing = (singFun2 @LookupSym0) sLookup + instance SingI d => + SingI (LookupSym1 (d :: [AChar]) :: (~>) Schema U) where + sing = (singFun1 @(LookupSym1 (d :: [AChar]))) (sLookup (sing @d)) + instance SingI (OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)) where + sing = (singFun2 @OccursSym0) sOccurs + instance SingI d => + SingI (OccursSym1 (d :: [AChar]) :: (~>) Schema Bool) where + sing = (singFun1 @(OccursSym1 (d :: [AChar]))) (sOccurs (sing @d)) + instance SingI (AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)) where + sing = (singFun2 @AttrNotInSym0) sAttrNotIn + instance SingI d => + SingI (AttrNotInSym1 (d :: Attribute) :: (~>) Schema Bool) where + sing + = (singFun1 @(AttrNotInSym1 (d :: Attribute))) + (sAttrNotIn (sing @d)) + instance SingI (DisjointSym0 :: (~>) Schema ((~>) Schema Bool)) where + sing = (singFun2 @DisjointSym0) sDisjoint + instance SingI d => + SingI (DisjointSym1 (d :: Schema) :: (~>) Schema Bool) where + sing + = (singFun1 @(DisjointSym1 (d :: Schema))) (sDisjoint (sing @d)) + instance SingI (AppendSym0 :: (~>) Schema ((~>) Schema Schema)) where + sing = (singFun2 @AppendSym0) sAppend + instance SingI d => + SingI (AppendSym1 (d :: Schema) :: (~>) Schema Schema) where + sing = (singFun1 @(AppendSym1 (d :: Schema))) (sAppend (sing @d)) + data instance Sing :: U -> Type + where + SBOOL :: Sing BOOL + SSTRING :: Sing STRING + SNAT :: Sing NAT + SVEC :: forall (n :: U) (n :: Nat). + (Sing (n :: U)) -> (Sing (n :: Nat)) -> Sing (VEC n n) + type SU = (Sing :: U -> Type) + instance SingKind U where + type Demote U = U + fromSing SBOOL = BOOL + fromSing SSTRING = STRING + fromSing SNAT = NAT + fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b) + toSing BOOL = SomeSing SBOOL + toSing STRING = SomeSing SSTRING + toSing NAT = SomeSing SNAT + toSing (VEC (b :: Demote U) (b :: Demote Nat)) + = case + ((,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) } + data instance Sing :: AChar -> Type + where + SCA :: Sing CA + SCB :: Sing CB + SCC :: Sing CC + SCD :: Sing CD + SCE :: Sing CE + SCF :: Sing CF + SCG :: Sing CG + SCH :: Sing CH + SCI :: Sing CI + SCJ :: Sing CJ + SCK :: Sing CK + SCL :: Sing CL + SCM :: Sing CM + SCN :: Sing CN + SCO :: Sing CO + SCP :: Sing CP + SCQ :: Sing CQ + SCR :: Sing CR + SCS :: Sing CS + SCT :: Sing CT + SCU :: Sing CU + SCV :: Sing CV + SCW :: Sing CW + SCX :: Sing CX + SCY :: Sing CY + SCZ :: Sing CZ + type SAChar = (Sing :: AChar -> Type) + instance SingKind AChar where + type Demote AChar = AChar + fromSing SCA = CA + fromSing SCB = CB + fromSing SCC = CC + fromSing SCD = CD + fromSing SCE = CE + fromSing SCF = CF + fromSing SCG = CG + fromSing SCH = CH + fromSing SCI = CI + fromSing SCJ = CJ + fromSing SCK = CK + fromSing SCL = CL + fromSing SCM = CM + fromSing SCN = CN + fromSing SCO = CO + fromSing SCP = CP + fromSing SCQ = CQ + fromSing SCR = CR + fromSing SCS = CS + fromSing SCT = CT + fromSing SCU = CU + fromSing SCV = CV + fromSing SCW = CW + fromSing SCX = CX + fromSing SCY = CY + fromSing SCZ = CZ + toSing CA = SomeSing SCA + toSing CB = SomeSing SCB + toSing CC = SomeSing SCC + toSing CD = SomeSing SCD + toSing CE = SomeSing SCE + toSing CF = SomeSing SCF + toSing CG = SomeSing SCG + toSing CH = SomeSing SCH + toSing CI = SomeSing SCI + toSing CJ = SomeSing SCJ + toSing CK = SomeSing SCK + toSing CL = SomeSing SCL + toSing CM = SomeSing SCM + toSing CN = SomeSing SCN + toSing CO = SomeSing SCO + toSing CP = SomeSing SCP + toSing CQ = SomeSing SCQ + toSing CR = SomeSing SCR + toSing CS = SomeSing SCS + toSing CT = SomeSing SCT + toSing CU = SomeSing SCU + toSing CV = SomeSing SCV + toSing CW = SomeSing SCW + toSing CX = SomeSing SCX + toSing CY = SomeSing SCY + toSing CZ = SomeSing SCZ + data instance Sing :: Attribute -> Type + where + SAttr :: forall (n :: [AChar]) (n :: U). + (Sing (n :: [AChar])) -> (Sing (n :: U)) -> Sing (Attr n n) + type SAttribute = (Sing :: Attribute -> Type) + instance SingKind Attribute where + type Demote Attribute = Attribute + fromSing (SAttr b b) = (Attr (fromSing b)) (fromSing b) + toSing (Attr (b :: Demote [AChar]) (b :: Demote U)) + = case + ((,) (toSing b :: SomeSing [AChar])) (toSing b :: SomeSing U) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) } + data instance Sing :: Schema -> Type + where + SSch :: forall (n :: [Attribute]). + (Sing (n :: [Attribute])) -> Sing (Sch n) + type SSchema = (Sing :: Schema -> Type) + instance SingKind Schema where + type Demote Schema = Schema + fromSing (SSch b) = Sch (fromSing b) + toSing (Sch (b :: Demote [Attribute])) + = case toSing b :: SomeSing [Attribute] of { + SomeSing c -> SomeSing (SSch c) } + instance (SShow U, SShow Nat) => SShow U where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: U) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) + -> Type) t1) t2) t3) + sShowsPrec + _ + SBOOL + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "BOOL"))) + sA_0123456789876543210 + sShowsPrec + _ + SSTRING + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "STRING"))) + sA_0123456789876543210 + sShowsPrec + _ + SNAT + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "NAT"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SVEC (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "VEC ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance SShow AChar where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: AChar) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) + -> Type) t1) t2) t3) + sShowsPrec + _ + SCA + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CA"))) + sA_0123456789876543210 + sShowsPrec + _ + SCB + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CB"))) + sA_0123456789876543210 + sShowsPrec + _ + SCC + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CC"))) + sA_0123456789876543210 + sShowsPrec + _ + SCD + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CD"))) + sA_0123456789876543210 + sShowsPrec + _ + SCE + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CE"))) + sA_0123456789876543210 + sShowsPrec + _ + SCF + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CF"))) + sA_0123456789876543210 + sShowsPrec + _ + SCG + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CG"))) + sA_0123456789876543210 + sShowsPrec + _ + SCH + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CH"))) + sA_0123456789876543210 + sShowsPrec + _ + SCI + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CI"))) + sA_0123456789876543210 + sShowsPrec + _ + SCJ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CJ"))) + sA_0123456789876543210 + sShowsPrec + _ + SCK + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CK"))) + sA_0123456789876543210 + sShowsPrec + _ + SCL + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CL"))) + sA_0123456789876543210 + sShowsPrec + _ + SCM + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CM"))) + sA_0123456789876543210 + sShowsPrec + _ + SCN + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CN"))) + sA_0123456789876543210 + sShowsPrec + _ + SCO + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CO"))) + sA_0123456789876543210 + sShowsPrec + _ + SCP + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CP"))) + sA_0123456789876543210 + sShowsPrec + _ + SCQ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CQ"))) + sA_0123456789876543210 + sShowsPrec + _ + SCR + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CR"))) + sA_0123456789876543210 + sShowsPrec + _ + SCS + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CS"))) + sA_0123456789876543210 + sShowsPrec + _ + SCT + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CT"))) + sA_0123456789876543210 + sShowsPrec + _ + SCU + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CU"))) + sA_0123456789876543210 + sShowsPrec + _ + SCV + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CV"))) + sA_0123456789876543210 + sShowsPrec + _ + SCW + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CW"))) + sA_0123456789876543210 + sShowsPrec + _ + SCX + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CX"))) + sA_0123456789876543210 + sShowsPrec + _ + SCY + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CY"))) + sA_0123456789876543210 + sShowsPrec + _ + SCZ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "CZ"))) + sA_0123456789876543210 + instance (SEq U, SEq Nat) => SEq U where + (%==) SBOOL SBOOL = STrue + (%==) SBOOL SSTRING = SFalse + (%==) SBOOL SNAT = SFalse + (%==) SBOOL (SVEC _ _) = SFalse + (%==) SSTRING SBOOL = SFalse + (%==) SSTRING SSTRING = STrue + (%==) SSTRING SNAT = SFalse + (%==) SSTRING (SVEC _ _) = SFalse + (%==) SNAT SBOOL = SFalse + (%==) SNAT SSTRING = SFalse + (%==) SNAT SNAT = STrue + (%==) SNAT (SVEC _ _) = SFalse + (%==) (SVEC _ _) SBOOL = SFalse + (%==) (SVEC _ _) SSTRING = SFalse + (%==) (SVEC _ _) SNAT = SFalse + (%==) (SVEC a a) (SVEC b b) = ((%&&) (((%==) a) b)) (((%==) a) b) + instance (SDecide U, SDecide Nat) => SDecide U where + (%~) SBOOL SBOOL = Proved Refl + (%~) SBOOL SSTRING = Disproved (\ x -> case x of) + (%~) SBOOL SNAT = Disproved (\ x -> case x of) + (%~) SBOOL (SVEC _ _) = Disproved (\ x -> case x of) + (%~) SSTRING SBOOL = Disproved (\ x -> case x of) + (%~) SSTRING SSTRING = Proved Refl + (%~) SSTRING SNAT = Disproved (\ x -> case x of) + (%~) SSTRING (SVEC _ _) = Disproved (\ x -> case x of) + (%~) SNAT SBOOL = Disproved (\ x -> case x of) + (%~) SNAT SSTRING = Disproved (\ x -> case x of) + (%~) SNAT SNAT = Proved Refl + (%~) SNAT (SVEC _ _) = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SBOOL = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SSTRING = Disproved (\ x -> case x of) + (%~) (SVEC _ _) SNAT = Disproved (\ x -> case x of) + (%~) (SVEC a a) (SVEC b b) + = case ((,) (((%~) a) b)) (((%~) a) b) of + (,) (Proved Refl) (Proved Refl) -> Proved Refl + (,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq AChar where + (%==) SCA SCA = STrue + (%==) SCA SCB = SFalse + (%==) SCA SCC = SFalse + (%==) SCA SCD = SFalse + (%==) SCA SCE = SFalse + (%==) SCA SCF = SFalse + (%==) SCA SCG = SFalse + (%==) SCA SCH = SFalse + (%==) SCA SCI = SFalse + (%==) SCA SCJ = SFalse + (%==) SCA SCK = SFalse + (%==) SCA SCL = SFalse + (%==) SCA SCM = SFalse + (%==) SCA SCN = SFalse + (%==) SCA SCO = SFalse + (%==) SCA SCP = SFalse + (%==) SCA SCQ = SFalse + (%==) SCA SCR = SFalse + (%==) SCA SCS = SFalse + (%==) SCA SCT = SFalse + (%==) SCA SCU = SFalse + (%==) SCA SCV = SFalse + (%==) SCA SCW = SFalse + (%==) SCA SCX = SFalse + (%==) SCA SCY = SFalse + (%==) SCA SCZ = SFalse + (%==) SCB SCA = SFalse + (%==) SCB SCB = STrue + (%==) SCB SCC = SFalse + (%==) SCB SCD = SFalse + (%==) SCB SCE = SFalse + (%==) SCB SCF = SFalse + (%==) SCB SCG = SFalse + (%==) SCB SCH = SFalse + (%==) SCB SCI = SFalse + (%==) SCB SCJ = SFalse + (%==) SCB SCK = SFalse + (%==) SCB SCL = SFalse + (%==) SCB SCM = SFalse + (%==) SCB SCN = SFalse + (%==) SCB SCO = SFalse + (%==) SCB SCP = SFalse + (%==) SCB SCQ = SFalse + (%==) SCB SCR = SFalse + (%==) SCB SCS = SFalse + (%==) SCB SCT = SFalse + (%==) SCB SCU = SFalse + (%==) SCB SCV = SFalse + (%==) SCB SCW = SFalse + (%==) SCB SCX = SFalse + (%==) SCB SCY = SFalse + (%==) SCB SCZ = SFalse + (%==) SCC SCA = SFalse + (%==) SCC SCB = SFalse + (%==) SCC SCC = STrue + (%==) SCC SCD = SFalse + (%==) SCC SCE = SFalse + (%==) SCC SCF = SFalse + (%==) SCC SCG = SFalse + (%==) SCC SCH = SFalse + (%==) SCC SCI = SFalse + (%==) SCC SCJ = SFalse + (%==) SCC SCK = SFalse + (%==) SCC SCL = SFalse + (%==) SCC SCM = SFalse + (%==) SCC SCN = SFalse + (%==) SCC SCO = SFalse + (%==) SCC SCP = SFalse + (%==) SCC SCQ = SFalse + (%==) SCC SCR = SFalse + (%==) SCC SCS = SFalse + (%==) SCC SCT = SFalse + (%==) SCC SCU = SFalse + (%==) SCC SCV = SFalse + (%==) SCC SCW = SFalse + (%==) SCC SCX = SFalse + (%==) SCC SCY = SFalse + (%==) SCC SCZ = SFalse + (%==) SCD SCA = SFalse + (%==) SCD SCB = SFalse + (%==) SCD SCC = SFalse + (%==) SCD SCD = STrue + (%==) SCD SCE = SFalse + (%==) SCD SCF = SFalse + (%==) SCD SCG = SFalse + (%==) SCD SCH = SFalse + (%==) SCD SCI = SFalse + (%==) SCD SCJ = SFalse + (%==) SCD SCK = SFalse + (%==) SCD SCL = SFalse + (%==) SCD SCM = SFalse + (%==) SCD SCN = SFalse + (%==) SCD SCO = SFalse + (%==) SCD SCP = SFalse + (%==) SCD SCQ = SFalse + (%==) SCD SCR = SFalse + (%==) SCD SCS = SFalse + (%==) SCD SCT = SFalse + (%==) SCD SCU = SFalse + (%==) SCD SCV = SFalse + (%==) SCD SCW = SFalse + (%==) SCD SCX = SFalse + (%==) SCD SCY = SFalse + (%==) SCD SCZ = SFalse + (%==) SCE SCA = SFalse + (%==) SCE SCB = SFalse + (%==) SCE SCC = SFalse + (%==) SCE SCD = SFalse + (%==) SCE SCE = STrue + (%==) SCE SCF = SFalse + (%==) SCE SCG = SFalse + (%==) SCE SCH = SFalse + (%==) SCE SCI = SFalse + (%==) SCE SCJ = SFalse + (%==) SCE SCK = SFalse + (%==) SCE SCL = SFalse + (%==) SCE SCM = SFalse + (%==) SCE SCN = SFalse + (%==) SCE SCO = SFalse + (%==) SCE SCP = SFalse + (%==) SCE SCQ = SFalse + (%==) SCE SCR = SFalse + (%==) SCE SCS = SFalse + (%==) SCE SCT = SFalse + (%==) SCE SCU = SFalse + (%==) SCE SCV = SFalse + (%==) SCE SCW = SFalse + (%==) SCE SCX = SFalse + (%==) SCE SCY = SFalse + (%==) SCE SCZ = SFalse + (%==) SCF SCA = SFalse + (%==) SCF SCB = SFalse + (%==) SCF SCC = SFalse + (%==) SCF SCD = SFalse + (%==) SCF SCE = SFalse + (%==) SCF SCF = STrue + (%==) SCF SCG = SFalse + (%==) SCF SCH = SFalse + (%==) SCF SCI = SFalse + (%==) SCF SCJ = SFalse + (%==) SCF SCK = SFalse + (%==) SCF SCL = SFalse + (%==) SCF SCM = SFalse + (%==) SCF SCN = SFalse + (%==) SCF SCO = SFalse + (%==) SCF SCP = SFalse + (%==) SCF SCQ = SFalse + (%==) SCF SCR = SFalse + (%==) SCF SCS = SFalse + (%==) SCF SCT = SFalse + (%==) SCF SCU = SFalse + (%==) SCF SCV = SFalse + (%==) SCF SCW = SFalse + (%==) SCF SCX = SFalse + (%==) SCF SCY = SFalse + (%==) SCF SCZ = SFalse + (%==) SCG SCA = SFalse + (%==) SCG SCB = SFalse + (%==) SCG SCC = SFalse + (%==) SCG SCD = SFalse + (%==) SCG SCE = SFalse + (%==) SCG SCF = SFalse + (%==) SCG SCG = STrue + (%==) SCG SCH = SFalse + (%==) SCG SCI = SFalse + (%==) SCG SCJ = SFalse + (%==) SCG SCK = SFalse + (%==) SCG SCL = SFalse + (%==) SCG SCM = SFalse + (%==) SCG SCN = SFalse + (%==) SCG SCO = SFalse + (%==) SCG SCP = SFalse + (%==) SCG SCQ = SFalse + (%==) SCG SCR = SFalse + (%==) SCG SCS = SFalse + (%==) SCG SCT = SFalse + (%==) SCG SCU = SFalse + (%==) SCG SCV = SFalse + (%==) SCG SCW = SFalse + (%==) SCG SCX = SFalse + (%==) SCG SCY = SFalse + (%==) SCG SCZ = SFalse + (%==) SCH SCA = SFalse + (%==) SCH SCB = SFalse + (%==) SCH SCC = SFalse + (%==) SCH SCD = SFalse + (%==) SCH SCE = SFalse + (%==) SCH SCF = SFalse + (%==) SCH SCG = SFalse + (%==) SCH SCH = STrue + (%==) SCH SCI = SFalse + (%==) SCH SCJ = SFalse + (%==) SCH SCK = SFalse + (%==) SCH SCL = SFalse + (%==) SCH SCM = SFalse + (%==) SCH SCN = SFalse + (%==) SCH SCO = SFalse + (%==) SCH SCP = SFalse + (%==) SCH SCQ = SFalse + (%==) SCH SCR = SFalse + (%==) SCH SCS = SFalse + (%==) SCH SCT = SFalse + (%==) SCH SCU = SFalse + (%==) SCH SCV = SFalse + (%==) SCH SCW = SFalse + (%==) SCH SCX = SFalse + (%==) SCH SCY = SFalse + (%==) SCH SCZ = SFalse + (%==) SCI SCA = SFalse + (%==) SCI SCB = SFalse + (%==) SCI SCC = SFalse + (%==) SCI SCD = SFalse + (%==) SCI SCE = SFalse + (%==) SCI SCF = SFalse + (%==) SCI SCG = SFalse + (%==) SCI SCH = SFalse + (%==) SCI SCI = STrue + (%==) SCI SCJ = SFalse + (%==) SCI SCK = SFalse + (%==) SCI SCL = SFalse + (%==) SCI SCM = SFalse + (%==) SCI SCN = SFalse + (%==) SCI SCO = SFalse + (%==) SCI SCP = SFalse + (%==) SCI SCQ = SFalse + (%==) SCI SCR = SFalse + (%==) SCI SCS = SFalse + (%==) SCI SCT = SFalse + (%==) SCI SCU = SFalse + (%==) SCI SCV = SFalse + (%==) SCI SCW = SFalse + (%==) SCI SCX = SFalse + (%==) SCI SCY = SFalse + (%==) SCI SCZ = SFalse + (%==) SCJ SCA = SFalse + (%==) SCJ SCB = SFalse + (%==) SCJ SCC = SFalse + (%==) SCJ SCD = SFalse + (%==) SCJ SCE = SFalse + (%==) SCJ SCF = SFalse + (%==) SCJ SCG = SFalse + (%==) SCJ SCH = SFalse + (%==) SCJ SCI = SFalse + (%==) SCJ SCJ = STrue + (%==) SCJ SCK = SFalse + (%==) SCJ SCL = SFalse + (%==) SCJ SCM = SFalse + (%==) SCJ SCN = SFalse + (%==) SCJ SCO = SFalse + (%==) SCJ SCP = SFalse + (%==) SCJ SCQ = SFalse + (%==) SCJ SCR = SFalse + (%==) SCJ SCS = SFalse + (%==) SCJ SCT = SFalse + (%==) SCJ SCU = SFalse + (%==) SCJ SCV = SFalse + (%==) SCJ SCW = SFalse + (%==) SCJ SCX = SFalse + (%==) SCJ SCY = SFalse + (%==) SCJ SCZ = SFalse + (%==) SCK SCA = SFalse + (%==) SCK SCB = SFalse + (%==) SCK SCC = SFalse + (%==) SCK SCD = SFalse + (%==) SCK SCE = SFalse + (%==) SCK SCF = SFalse + (%==) SCK SCG = SFalse + (%==) SCK SCH = SFalse + (%==) SCK SCI = SFalse + (%==) SCK SCJ = SFalse + (%==) SCK SCK = STrue + (%==) SCK SCL = SFalse + (%==) SCK SCM = SFalse + (%==) SCK SCN = SFalse + (%==) SCK SCO = SFalse + (%==) SCK SCP = SFalse + (%==) SCK SCQ = SFalse + (%==) SCK SCR = SFalse + (%==) SCK SCS = SFalse + (%==) SCK SCT = SFalse + (%==) SCK SCU = SFalse + (%==) SCK SCV = SFalse + (%==) SCK SCW = SFalse + (%==) SCK SCX = SFalse + (%==) SCK SCY = SFalse + (%==) SCK SCZ = SFalse + (%==) SCL SCA = SFalse + (%==) SCL SCB = SFalse + (%==) SCL SCC = SFalse + (%==) SCL SCD = SFalse + (%==) SCL SCE = SFalse + (%==) SCL SCF = SFalse + (%==) SCL SCG = SFalse + (%==) SCL SCH = SFalse + (%==) SCL SCI = SFalse + (%==) SCL SCJ = SFalse + (%==) SCL SCK = SFalse + (%==) SCL SCL = STrue + (%==) SCL SCM = SFalse + (%==) SCL SCN = SFalse + (%==) SCL SCO = SFalse + (%==) SCL SCP = SFalse + (%==) SCL SCQ = SFalse + (%==) SCL SCR = SFalse + (%==) SCL SCS = SFalse + (%==) SCL SCT = SFalse + (%==) SCL SCU = SFalse + (%==) SCL SCV = SFalse + (%==) SCL SCW = SFalse + (%==) SCL SCX = SFalse + (%==) SCL SCY = SFalse + (%==) SCL SCZ = SFalse + (%==) SCM SCA = SFalse + (%==) SCM SCB = SFalse + (%==) SCM SCC = SFalse + (%==) SCM SCD = SFalse + (%==) SCM SCE = SFalse + (%==) SCM SCF = SFalse + (%==) SCM SCG = SFalse + (%==) SCM SCH = SFalse + (%==) SCM SCI = SFalse + (%==) SCM SCJ = SFalse + (%==) SCM SCK = SFalse + (%==) SCM SCL = SFalse + (%==) SCM SCM = STrue + (%==) SCM SCN = SFalse + (%==) SCM SCO = SFalse + (%==) SCM SCP = SFalse + (%==) SCM SCQ = SFalse + (%==) SCM SCR = SFalse + (%==) SCM SCS = SFalse + (%==) SCM SCT = SFalse + (%==) SCM SCU = SFalse + (%==) SCM SCV = SFalse + (%==) SCM SCW = SFalse + (%==) SCM SCX = SFalse + (%==) SCM SCY = SFalse + (%==) SCM SCZ = SFalse + (%==) SCN SCA = SFalse + (%==) SCN SCB = SFalse + (%==) SCN SCC = SFalse + (%==) SCN SCD = SFalse + (%==) SCN SCE = SFalse + (%==) SCN SCF = SFalse + (%==) SCN SCG = SFalse + (%==) SCN SCH = SFalse + (%==) SCN SCI = SFalse + (%==) SCN SCJ = SFalse + (%==) SCN SCK = SFalse + (%==) SCN SCL = SFalse + (%==) SCN SCM = SFalse + (%==) SCN SCN = STrue + (%==) SCN SCO = SFalse + (%==) SCN SCP = SFalse + (%==) SCN SCQ = SFalse + (%==) SCN SCR = SFalse + (%==) SCN SCS = SFalse + (%==) SCN SCT = SFalse + (%==) SCN SCU = SFalse + (%==) SCN SCV = SFalse + (%==) SCN SCW = SFalse + (%==) SCN SCX = SFalse + (%==) SCN SCY = SFalse + (%==) SCN SCZ = SFalse + (%==) SCO SCA = SFalse + (%==) SCO SCB = SFalse + (%==) SCO SCC = SFalse + (%==) SCO SCD = SFalse + (%==) SCO SCE = SFalse + (%==) SCO SCF = SFalse + (%==) SCO SCG = SFalse + (%==) SCO SCH = SFalse + (%==) SCO SCI = SFalse + (%==) SCO SCJ = SFalse + (%==) SCO SCK = SFalse + (%==) SCO SCL = SFalse + (%==) SCO SCM = SFalse + (%==) SCO SCN = SFalse + (%==) SCO SCO = STrue + (%==) SCO SCP = SFalse + (%==) SCO SCQ = SFalse + (%==) SCO SCR = SFalse + (%==) SCO SCS = SFalse + (%==) SCO SCT = SFalse + (%==) SCO SCU = SFalse + (%==) SCO SCV = SFalse + (%==) SCO SCW = SFalse + (%==) SCO SCX = SFalse + (%==) SCO SCY = SFalse + (%==) SCO SCZ = SFalse + (%==) SCP SCA = SFalse + (%==) SCP SCB = SFalse + (%==) SCP SCC = SFalse + (%==) SCP SCD = SFalse + (%==) SCP SCE = SFalse + (%==) SCP SCF = SFalse + (%==) SCP SCG = SFalse + (%==) SCP SCH = SFalse + (%==) SCP SCI = SFalse + (%==) SCP SCJ = SFalse + (%==) SCP SCK = SFalse + (%==) SCP SCL = SFalse + (%==) SCP SCM = SFalse + (%==) SCP SCN = SFalse + (%==) SCP SCO = SFalse + (%==) SCP SCP = STrue + (%==) SCP SCQ = SFalse + (%==) SCP SCR = SFalse + (%==) SCP SCS = SFalse + (%==) SCP SCT = SFalse + (%==) SCP SCU = SFalse + (%==) SCP SCV = SFalse + (%==) SCP SCW = SFalse + (%==) SCP SCX = SFalse + (%==) SCP SCY = SFalse + (%==) SCP SCZ = SFalse + (%==) SCQ SCA = SFalse + (%==) SCQ SCB = SFalse + (%==) SCQ SCC = SFalse + (%==) SCQ SCD = SFalse + (%==) SCQ SCE = SFalse + (%==) SCQ SCF = SFalse + (%==) SCQ SCG = SFalse + (%==) SCQ SCH = SFalse + (%==) SCQ SCI = SFalse + (%==) SCQ SCJ = SFalse + (%==) SCQ SCK = SFalse + (%==) SCQ SCL = SFalse + (%==) SCQ SCM = SFalse + (%==) SCQ SCN = SFalse + (%==) SCQ SCO = SFalse + (%==) SCQ SCP = SFalse + (%==) SCQ SCQ = STrue + (%==) SCQ SCR = SFalse + (%==) SCQ SCS = SFalse + (%==) SCQ SCT = SFalse + (%==) SCQ SCU = SFalse + (%==) SCQ SCV = SFalse + (%==) SCQ SCW = SFalse + (%==) SCQ SCX = SFalse + (%==) SCQ SCY = SFalse + (%==) SCQ SCZ = SFalse + (%==) SCR SCA = SFalse + (%==) SCR SCB = SFalse + (%==) SCR SCC = SFalse + (%==) SCR SCD = SFalse + (%==) SCR SCE = SFalse + (%==) SCR SCF = SFalse + (%==) SCR SCG = SFalse + (%==) SCR SCH = SFalse + (%==) SCR SCI = SFalse + (%==) SCR SCJ = SFalse + (%==) SCR SCK = SFalse + (%==) SCR SCL = SFalse + (%==) SCR SCM = SFalse + (%==) SCR SCN = SFalse + (%==) SCR SCO = SFalse + (%==) SCR SCP = SFalse + (%==) SCR SCQ = SFalse + (%==) SCR SCR = STrue + (%==) SCR SCS = SFalse + (%==) SCR SCT = SFalse + (%==) SCR SCU = SFalse + (%==) SCR SCV = SFalse + (%==) SCR SCW = SFalse + (%==) SCR SCX = SFalse + (%==) SCR SCY = SFalse + (%==) SCR SCZ = SFalse + (%==) SCS SCA = SFalse + (%==) SCS SCB = SFalse + (%==) SCS SCC = SFalse + (%==) SCS SCD = SFalse + (%==) SCS SCE = SFalse + (%==) SCS SCF = SFalse + (%==) SCS SCG = SFalse + (%==) SCS SCH = SFalse + (%==) SCS SCI = SFalse + (%==) SCS SCJ = SFalse + (%==) SCS SCK = SFalse + (%==) SCS SCL = SFalse + (%==) SCS SCM = SFalse + (%==) SCS SCN = SFalse + (%==) SCS SCO = SFalse + (%==) SCS SCP = SFalse + (%==) SCS SCQ = SFalse + (%==) SCS SCR = SFalse + (%==) SCS SCS = STrue + (%==) SCS SCT = SFalse + (%==) SCS SCU = SFalse + (%==) SCS SCV = SFalse + (%==) SCS SCW = SFalse + (%==) SCS SCX = SFalse + (%==) SCS SCY = SFalse + (%==) SCS SCZ = SFalse + (%==) SCT SCA = SFalse + (%==) SCT SCB = SFalse + (%==) SCT SCC = SFalse + (%==) SCT SCD = SFalse + (%==) SCT SCE = SFalse + (%==) SCT SCF = SFalse + (%==) SCT SCG = SFalse + (%==) SCT SCH = SFalse + (%==) SCT SCI = SFalse + (%==) SCT SCJ = SFalse + (%==) SCT SCK = SFalse + (%==) SCT SCL = SFalse + (%==) SCT SCM = SFalse + (%==) SCT SCN = SFalse + (%==) SCT SCO = SFalse + (%==) SCT SCP = SFalse + (%==) SCT SCQ = SFalse + (%==) SCT SCR = SFalse + (%==) SCT SCS = SFalse + (%==) SCT SCT = STrue + (%==) SCT SCU = SFalse + (%==) SCT SCV = SFalse + (%==) SCT SCW = SFalse + (%==) SCT SCX = SFalse + (%==) SCT SCY = SFalse + (%==) SCT SCZ = SFalse + (%==) SCU SCA = SFalse + (%==) SCU SCB = SFalse + (%==) SCU SCC = SFalse + (%==) SCU SCD = SFalse + (%==) SCU SCE = SFalse + (%==) SCU SCF = SFalse + (%==) SCU SCG = SFalse + (%==) SCU SCH = SFalse + (%==) SCU SCI = SFalse + (%==) SCU SCJ = SFalse + (%==) SCU SCK = SFalse + (%==) SCU SCL = SFalse + (%==) SCU SCM = SFalse + (%==) SCU SCN = SFalse + (%==) SCU SCO = SFalse + (%==) SCU SCP = SFalse + (%==) SCU SCQ = SFalse + (%==) SCU SCR = SFalse + (%==) SCU SCS = SFalse + (%==) SCU SCT = SFalse + (%==) SCU SCU = STrue + (%==) SCU SCV = SFalse + (%==) SCU SCW = SFalse + (%==) SCU SCX = SFalse + (%==) SCU SCY = SFalse + (%==) SCU SCZ = SFalse + (%==) SCV SCA = SFalse + (%==) SCV SCB = SFalse + (%==) SCV SCC = SFalse + (%==) SCV SCD = SFalse + (%==) SCV SCE = SFalse + (%==) SCV SCF = SFalse + (%==) SCV SCG = SFalse + (%==) SCV SCH = SFalse + (%==) SCV SCI = SFalse + (%==) SCV SCJ = SFalse + (%==) SCV SCK = SFalse + (%==) SCV SCL = SFalse + (%==) SCV SCM = SFalse + (%==) SCV SCN = SFalse + (%==) SCV SCO = SFalse + (%==) SCV SCP = SFalse + (%==) SCV SCQ = SFalse + (%==) SCV SCR = SFalse + (%==) SCV SCS = SFalse + (%==) SCV SCT = SFalse + (%==) SCV SCU = SFalse + (%==) SCV SCV = STrue + (%==) SCV SCW = SFalse + (%==) SCV SCX = SFalse + (%==) SCV SCY = SFalse + (%==) SCV SCZ = SFalse + (%==) SCW SCA = SFalse + (%==) SCW SCB = SFalse + (%==) SCW SCC = SFalse + (%==) SCW SCD = SFalse + (%==) SCW SCE = SFalse + (%==) SCW SCF = SFalse + (%==) SCW SCG = SFalse + (%==) SCW SCH = SFalse + (%==) SCW SCI = SFalse + (%==) SCW SCJ = SFalse + (%==) SCW SCK = SFalse + (%==) SCW SCL = SFalse + (%==) SCW SCM = SFalse + (%==) SCW SCN = SFalse + (%==) SCW SCO = SFalse + (%==) SCW SCP = SFalse + (%==) SCW SCQ = SFalse + (%==) SCW SCR = SFalse + (%==) SCW SCS = SFalse + (%==) SCW SCT = SFalse + (%==) SCW SCU = SFalse + (%==) SCW SCV = SFalse + (%==) SCW SCW = STrue + (%==) SCW SCX = SFalse + (%==) SCW SCY = SFalse + (%==) SCW SCZ = SFalse + (%==) SCX SCA = SFalse + (%==) SCX SCB = SFalse + (%==) SCX SCC = SFalse + (%==) SCX SCD = SFalse + (%==) SCX SCE = SFalse + (%==) SCX SCF = SFalse + (%==) SCX SCG = SFalse + (%==) SCX SCH = SFalse + (%==) SCX SCI = SFalse + (%==) SCX SCJ = SFalse + (%==) SCX SCK = SFalse + (%==) SCX SCL = SFalse + (%==) SCX SCM = SFalse + (%==) SCX SCN = SFalse + (%==) SCX SCO = SFalse + (%==) SCX SCP = SFalse + (%==) SCX SCQ = SFalse + (%==) SCX SCR = SFalse + (%==) SCX SCS = SFalse + (%==) SCX SCT = SFalse + (%==) SCX SCU = SFalse + (%==) SCX SCV = SFalse + (%==) SCX SCW = SFalse + (%==) SCX SCX = STrue + (%==) SCX SCY = SFalse + (%==) SCX SCZ = SFalse + (%==) SCY SCA = SFalse + (%==) SCY SCB = SFalse + (%==) SCY SCC = SFalse + (%==) SCY SCD = SFalse + (%==) SCY SCE = SFalse + (%==) SCY SCF = SFalse + (%==) SCY SCG = SFalse + (%==) SCY SCH = SFalse + (%==) SCY SCI = SFalse + (%==) SCY SCJ = SFalse + (%==) SCY SCK = SFalse + (%==) SCY SCL = SFalse + (%==) SCY SCM = SFalse + (%==) SCY SCN = SFalse + (%==) SCY SCO = SFalse + (%==) SCY SCP = SFalse + (%==) SCY SCQ = SFalse + (%==) SCY SCR = SFalse + (%==) SCY SCS = SFalse + (%==) SCY SCT = SFalse + (%==) SCY SCU = SFalse + (%==) SCY SCV = SFalse + (%==) SCY SCW = SFalse + (%==) SCY SCX = SFalse + (%==) SCY SCY = STrue + (%==) SCY SCZ = SFalse + (%==) SCZ SCA = SFalse + (%==) SCZ SCB = SFalse + (%==) SCZ SCC = SFalse + (%==) SCZ SCD = SFalse + (%==) SCZ SCE = SFalse + (%==) SCZ SCF = SFalse + (%==) SCZ SCG = SFalse + (%==) SCZ SCH = SFalse + (%==) SCZ SCI = SFalse + (%==) SCZ SCJ = SFalse + (%==) SCZ SCK = SFalse + (%==) SCZ SCL = SFalse + (%==) SCZ SCM = SFalse + (%==) SCZ SCN = SFalse + (%==) SCZ SCO = SFalse + (%==) SCZ SCP = SFalse + (%==) SCZ SCQ = SFalse + (%==) SCZ SCR = SFalse + (%==) SCZ SCS = SFalse + (%==) SCZ SCT = SFalse + (%==) SCZ SCU = SFalse + (%==) SCZ SCV = SFalse + (%==) SCZ SCW = SFalse + (%==) SCZ SCX = SFalse + (%==) SCZ SCY = SFalse + (%==) SCZ SCZ = STrue + instance SDecide AChar where + (%~) SCA SCA = Proved Refl + (%~) SCA SCB = Disproved (\ x -> case x of) + (%~) SCA SCC = Disproved (\ x -> case x of) + (%~) SCA SCD = Disproved (\ x -> case x of) + (%~) SCA SCE = Disproved (\ x -> case x of) + (%~) SCA SCF = Disproved (\ x -> case x of) + (%~) SCA SCG = Disproved (\ x -> case x of) + (%~) SCA SCH = Disproved (\ x -> case x of) + (%~) SCA SCI = Disproved (\ x -> case x of) + (%~) SCA SCJ = Disproved (\ x -> case x of) + (%~) SCA SCK = Disproved (\ x -> case x of) + (%~) SCA SCL = Disproved (\ x -> case x of) + (%~) SCA SCM = Disproved (\ x -> case x of) + (%~) SCA SCN = Disproved (\ x -> case x of) + (%~) SCA SCO = Disproved (\ x -> case x of) + (%~) SCA SCP = Disproved (\ x -> case x of) + (%~) SCA SCQ = Disproved (\ x -> case x of) + (%~) SCA SCR = Disproved (\ x -> case x of) + (%~) SCA SCS = Disproved (\ x -> case x of) + (%~) SCA SCT = Disproved (\ x -> case x of) + (%~) SCA SCU = Disproved (\ x -> case x of) + (%~) SCA SCV = Disproved (\ x -> case x of) + (%~) SCA SCW = Disproved (\ x -> case x of) + (%~) SCA SCX = Disproved (\ x -> case x of) + (%~) SCA SCY = Disproved (\ x -> case x of) + (%~) SCA SCZ = Disproved (\ x -> case x of) + (%~) SCB SCA = Disproved (\ x -> case x of) + (%~) SCB SCB = Proved Refl + (%~) SCB SCC = Disproved (\ x -> case x of) + (%~) SCB SCD = Disproved (\ x -> case x of) + (%~) SCB SCE = Disproved (\ x -> case x of) + (%~) SCB SCF = Disproved (\ x -> case x of) + (%~) SCB SCG = Disproved (\ x -> case x of) + (%~) SCB SCH = Disproved (\ x -> case x of) + (%~) SCB SCI = Disproved (\ x -> case x of) + (%~) SCB SCJ = Disproved (\ x -> case x of) + (%~) SCB SCK = Disproved (\ x -> case x of) + (%~) SCB SCL = Disproved (\ x -> case x of) + (%~) SCB SCM = Disproved (\ x -> case x of) + (%~) SCB SCN = Disproved (\ x -> case x of) + (%~) SCB SCO = Disproved (\ x -> case x of) + (%~) SCB SCP = Disproved (\ x -> case x of) + (%~) SCB SCQ = Disproved (\ x -> case x of) + (%~) SCB SCR = Disproved (\ x -> case x of) + (%~) SCB SCS = Disproved (\ x -> case x of) + (%~) SCB SCT = Disproved (\ x -> case x of) + (%~) SCB SCU = Disproved (\ x -> case x of) + (%~) SCB SCV = Disproved (\ x -> case x of) + (%~) SCB SCW = Disproved (\ x -> case x of) + (%~) SCB SCX = Disproved (\ x -> case x of) + (%~) SCB SCY = Disproved (\ x -> case x of) + (%~) SCB SCZ = Disproved (\ x -> case x of) + (%~) SCC SCA = Disproved (\ x -> case x of) + (%~) SCC SCB = Disproved (\ x -> case x of) + (%~) SCC SCC = Proved Refl + (%~) SCC SCD = Disproved (\ x -> case x of) + (%~) SCC SCE = Disproved (\ x -> case x of) + (%~) SCC SCF = Disproved (\ x -> case x of) + (%~) SCC SCG = Disproved (\ x -> case x of) + (%~) SCC SCH = Disproved (\ x -> case x of) + (%~) SCC SCI = Disproved (\ x -> case x of) + (%~) SCC SCJ = Disproved (\ x -> case x of) + (%~) SCC SCK = Disproved (\ x -> case x of) + (%~) SCC SCL = Disproved (\ x -> case x of) + (%~) SCC SCM = Disproved (\ x -> case x of) + (%~) SCC SCN = Disproved (\ x -> case x of) + (%~) SCC SCO = Disproved (\ x -> case x of) + (%~) SCC SCP = Disproved (\ x -> case x of) + (%~) SCC SCQ = Disproved (\ x -> case x of) + (%~) SCC SCR = Disproved (\ x -> case x of) + (%~) SCC SCS = Disproved (\ x -> case x of) + (%~) SCC SCT = Disproved (\ x -> case x of) + (%~) SCC SCU = Disproved (\ x -> case x of) + (%~) SCC SCV = Disproved (\ x -> case x of) + (%~) SCC SCW = Disproved (\ x -> case x of) + (%~) SCC SCX = Disproved (\ x -> case x of) + (%~) SCC SCY = Disproved (\ x -> case x of) + (%~) SCC SCZ = Disproved (\ x -> case x of) + (%~) SCD SCA = Disproved (\ x -> case x of) + (%~) SCD SCB = Disproved (\ x -> case x of) + (%~) SCD SCC = Disproved (\ x -> case x of) + (%~) SCD SCD = Proved Refl + (%~) SCD SCE = Disproved (\ x -> case x of) + (%~) SCD SCF = Disproved (\ x -> case x of) + (%~) SCD SCG = Disproved (\ x -> case x of) + (%~) SCD SCH = Disproved (\ x -> case x of) + (%~) SCD SCI = Disproved (\ x -> case x of) + (%~) SCD SCJ = Disproved (\ x -> case x of) + (%~) SCD SCK = Disproved (\ x -> case x of) + (%~) SCD SCL = Disproved (\ x -> case x of) + (%~) SCD SCM = Disproved (\ x -> case x of) + (%~) SCD SCN = Disproved (\ x -> case x of) + (%~) SCD SCO = Disproved (\ x -> case x of) + (%~) SCD SCP = Disproved (\ x -> case x of) + (%~) SCD SCQ = Disproved (\ x -> case x of) + (%~) SCD SCR = Disproved (\ x -> case x of) + (%~) SCD SCS = Disproved (\ x -> case x of) + (%~) SCD SCT = Disproved (\ x -> case x of) + (%~) SCD SCU = Disproved (\ x -> case x of) + (%~) SCD SCV = Disproved (\ x -> case x of) + (%~) SCD SCW = Disproved (\ x -> case x of) + (%~) SCD SCX = Disproved (\ x -> case x of) + (%~) SCD SCY = Disproved (\ x -> case x of) + (%~) SCD SCZ = Disproved (\ x -> case x of) + (%~) SCE SCA = Disproved (\ x -> case x of) + (%~) SCE SCB = Disproved (\ x -> case x of) + (%~) SCE SCC = Disproved (\ x -> case x of) + (%~) SCE SCD = Disproved (\ x -> case x of) + (%~) SCE SCE = Proved Refl + (%~) SCE SCF = Disproved (\ x -> case x of) + (%~) SCE SCG = Disproved (\ x -> case x of) + (%~) SCE SCH = Disproved (\ x -> case x of) + (%~) SCE SCI = Disproved (\ x -> case x of) + (%~) SCE SCJ = Disproved (\ x -> case x of) + (%~) SCE SCK = Disproved (\ x -> case x of) + (%~) SCE SCL = Disproved (\ x -> case x of) + (%~) SCE SCM = Disproved (\ x -> case x of) + (%~) SCE SCN = Disproved (\ x -> case x of) + (%~) SCE SCO = Disproved (\ x -> case x of) + (%~) SCE SCP = Disproved (\ x -> case x of) + (%~) SCE SCQ = Disproved (\ x -> case x of) + (%~) SCE SCR = Disproved (\ x -> case x of) + (%~) SCE SCS = Disproved (\ x -> case x of) + (%~) SCE SCT = Disproved (\ x -> case x of) + (%~) SCE SCU = Disproved (\ x -> case x of) + (%~) SCE SCV = Disproved (\ x -> case x of) + (%~) SCE SCW = Disproved (\ x -> case x of) + (%~) SCE SCX = Disproved (\ x -> case x of) + (%~) SCE SCY = Disproved (\ x -> case x of) + (%~) SCE SCZ = Disproved (\ x -> case x of) + (%~) SCF SCA = Disproved (\ x -> case x of) + (%~) SCF SCB = Disproved (\ x -> case x of) + (%~) SCF SCC = Disproved (\ x -> case x of) + (%~) SCF SCD = Disproved (\ x -> case x of) + (%~) SCF SCE = Disproved (\ x -> case x of) + (%~) SCF SCF = Proved Refl + (%~) SCF SCG = Disproved (\ x -> case x of) + (%~) SCF SCH = Disproved (\ x -> case x of) + (%~) SCF SCI = Disproved (\ x -> case x of) + (%~) SCF SCJ = Disproved (\ x -> case x of) + (%~) SCF SCK = Disproved (\ x -> case x of) + (%~) SCF SCL = Disproved (\ x -> case x of) + (%~) SCF SCM = Disproved (\ x -> case x of) + (%~) SCF SCN = Disproved (\ x -> case x of) + (%~) SCF SCO = Disproved (\ x -> case x of) + (%~) SCF SCP = Disproved (\ x -> case x of) + (%~) SCF SCQ = Disproved (\ x -> case x of) + (%~) SCF SCR = Disproved (\ x -> case x of) + (%~) SCF SCS = Disproved (\ x -> case x of) + (%~) SCF SCT = Disproved (\ x -> case x of) + (%~) SCF SCU = Disproved (\ x -> case x of) + (%~) SCF SCV = Disproved (\ x -> case x of) + (%~) SCF SCW = Disproved (\ x -> case x of) + (%~) SCF SCX = Disproved (\ x -> case x of) + (%~) SCF SCY = Disproved (\ x -> case x of) + (%~) SCF SCZ = Disproved (\ x -> case x of) + (%~) SCG SCA = Disproved (\ x -> case x of) + (%~) SCG SCB = Disproved (\ x -> case x of) + (%~) SCG SCC = Disproved (\ x -> case x of) + (%~) SCG SCD = Disproved (\ x -> case x of) + (%~) SCG SCE = Disproved (\ x -> case x of) + (%~) SCG SCF = Disproved (\ x -> case x of) + (%~) SCG SCG = Proved Refl + (%~) SCG SCH = Disproved (\ x -> case x of) + (%~) SCG SCI = Disproved (\ x -> case x of) + (%~) SCG SCJ = Disproved (\ x -> case x of) + (%~) SCG SCK = Disproved (\ x -> case x of) + (%~) SCG SCL = Disproved (\ x -> case x of) + (%~) SCG SCM = Disproved (\ x -> case x of) + (%~) SCG SCN = Disproved (\ x -> case x of) + (%~) SCG SCO = Disproved (\ x -> case x of) + (%~) SCG SCP = Disproved (\ x -> case x of) + (%~) SCG SCQ = Disproved (\ x -> case x of) + (%~) SCG SCR = Disproved (\ x -> case x of) + (%~) SCG SCS = Disproved (\ x -> case x of) + (%~) SCG SCT = Disproved (\ x -> case x of) + (%~) SCG SCU = Disproved (\ x -> case x of) + (%~) SCG SCV = Disproved (\ x -> case x of) + (%~) SCG SCW = Disproved (\ x -> case x of) + (%~) SCG SCX = Disproved (\ x -> case x of) + (%~) SCG SCY = Disproved (\ x -> case x of) + (%~) SCG SCZ = Disproved (\ x -> case x of) + (%~) SCH SCA = Disproved (\ x -> case x of) + (%~) SCH SCB = Disproved (\ x -> case x of) + (%~) SCH SCC = Disproved (\ x -> case x of) + (%~) SCH SCD = Disproved (\ x -> case x of) + (%~) SCH SCE = Disproved (\ x -> case x of) + (%~) SCH SCF = Disproved (\ x -> case x of) + (%~) SCH SCG = Disproved (\ x -> case x of) + (%~) SCH SCH = Proved Refl + (%~) SCH SCI = Disproved (\ x -> case x of) + (%~) SCH SCJ = Disproved (\ x -> case x of) + (%~) SCH SCK = Disproved (\ x -> case x of) + (%~) SCH SCL = Disproved (\ x -> case x of) + (%~) SCH SCM = Disproved (\ x -> case x of) + (%~) SCH SCN = Disproved (\ x -> case x of) + (%~) SCH SCO = Disproved (\ x -> case x of) + (%~) SCH SCP = Disproved (\ x -> case x of) + (%~) SCH SCQ = Disproved (\ x -> case x of) + (%~) SCH SCR = Disproved (\ x -> case x of) + (%~) SCH SCS = Disproved (\ x -> case x of) + (%~) SCH SCT = Disproved (\ x -> case x of) + (%~) SCH SCU = Disproved (\ x -> case x of) + (%~) SCH SCV = Disproved (\ x -> case x of) + (%~) SCH SCW = Disproved (\ x -> case x of) + (%~) SCH SCX = Disproved (\ x -> case x of) + (%~) SCH SCY = Disproved (\ x -> case x of) + (%~) SCH SCZ = Disproved (\ x -> case x of) + (%~) SCI SCA = Disproved (\ x -> case x of) + (%~) SCI SCB = Disproved (\ x -> case x of) + (%~) SCI SCC = Disproved (\ x -> case x of) + (%~) SCI SCD = Disproved (\ x -> case x of) + (%~) SCI SCE = Disproved (\ x -> case x of) + (%~) SCI SCF = Disproved (\ x -> case x of) + (%~) SCI SCG = Disproved (\ x -> case x of) + (%~) SCI SCH = Disproved (\ x -> case x of) + (%~) SCI SCI = Proved Refl + (%~) SCI SCJ = Disproved (\ x -> case x of) + (%~) SCI SCK = Disproved (\ x -> case x of) + (%~) SCI SCL = Disproved (\ x -> case x of) + (%~) SCI SCM = Disproved (\ x -> case x of) + (%~) SCI SCN = Disproved (\ x -> case x of) + (%~) SCI SCO = Disproved (\ x -> case x of) + (%~) SCI SCP = Disproved (\ x -> case x of) + (%~) SCI SCQ = Disproved (\ x -> case x of) + (%~) SCI SCR = Disproved (\ x -> case x of) + (%~) SCI SCS = Disproved (\ x -> case x of) + (%~) SCI SCT = Disproved (\ x -> case x of) + (%~) SCI SCU = Disproved (\ x -> case x of) + (%~) SCI SCV = Disproved (\ x -> case x of) + (%~) SCI SCW = Disproved (\ x -> case x of) + (%~) SCI SCX = Disproved (\ x -> case x of) + (%~) SCI SCY = Disproved (\ x -> case x of) + (%~) SCI SCZ = Disproved (\ x -> case x of) + (%~) SCJ SCA = Disproved (\ x -> case x of) + (%~) SCJ SCB = Disproved (\ x -> case x of) + (%~) SCJ SCC = Disproved (\ x -> case x of) + (%~) SCJ SCD = Disproved (\ x -> case x of) + (%~) SCJ SCE = Disproved (\ x -> case x of) + (%~) SCJ SCF = Disproved (\ x -> case x of) + (%~) SCJ SCG = Disproved (\ x -> case x of) + (%~) SCJ SCH = Disproved (\ x -> case x of) + (%~) SCJ SCI = Disproved (\ x -> case x of) + (%~) SCJ SCJ = Proved Refl + (%~) SCJ SCK = Disproved (\ x -> case x of) + (%~) SCJ SCL = Disproved (\ x -> case x of) + (%~) SCJ SCM = Disproved (\ x -> case x of) + (%~) SCJ SCN = Disproved (\ x -> case x of) + (%~) SCJ SCO = Disproved (\ x -> case x of) + (%~) SCJ SCP = Disproved (\ x -> case x of) + (%~) SCJ SCQ = Disproved (\ x -> case x of) + (%~) SCJ SCR = Disproved (\ x -> case x of) + (%~) SCJ SCS = Disproved (\ x -> case x of) + (%~) SCJ SCT = Disproved (\ x -> case x of) + (%~) SCJ SCU = Disproved (\ x -> case x of) + (%~) SCJ SCV = Disproved (\ x -> case x of) + (%~) SCJ SCW = Disproved (\ x -> case x of) + (%~) SCJ SCX = Disproved (\ x -> case x of) + (%~) SCJ SCY = Disproved (\ x -> case x of) + (%~) SCJ SCZ = Disproved (\ x -> case x of) + (%~) SCK SCA = Disproved (\ x -> case x of) + (%~) SCK SCB = Disproved (\ x -> case x of) + (%~) SCK SCC = Disproved (\ x -> case x of) + (%~) SCK SCD = Disproved (\ x -> case x of) + (%~) SCK SCE = Disproved (\ x -> case x of) + (%~) SCK SCF = Disproved (\ x -> case x of) + (%~) SCK SCG = Disproved (\ x -> case x of) + (%~) SCK SCH = Disproved (\ x -> case x of) + (%~) SCK SCI = Disproved (\ x -> case x of) + (%~) SCK SCJ = Disproved (\ x -> case x of) + (%~) SCK SCK = Proved Refl + (%~) SCK SCL = Disproved (\ x -> case x of) + (%~) SCK SCM = Disproved (\ x -> case x of) + (%~) SCK SCN = Disproved (\ x -> case x of) + (%~) SCK SCO = Disproved (\ x -> case x of) + (%~) SCK SCP = Disproved (\ x -> case x of) + (%~) SCK SCQ = Disproved (\ x -> case x of) + (%~) SCK SCR = Disproved (\ x -> case x of) + (%~) SCK SCS = Disproved (\ x -> case x of) + (%~) SCK SCT = Disproved (\ x -> case x of) + (%~) SCK SCU = Disproved (\ x -> case x of) + (%~) SCK SCV = Disproved (\ x -> case x of) + (%~) SCK SCW = Disproved (\ x -> case x of) + (%~) SCK SCX = Disproved (\ x -> case x of) + (%~) SCK SCY = Disproved (\ x -> case x of) + (%~) SCK SCZ = Disproved (\ x -> case x of) + (%~) SCL SCA = Disproved (\ x -> case x of) + (%~) SCL SCB = Disproved (\ x -> case x of) + (%~) SCL SCC = Disproved (\ x -> case x of) + (%~) SCL SCD = Disproved (\ x -> case x of) + (%~) SCL SCE = Disproved (\ x -> case x of) + (%~) SCL SCF = Disproved (\ x -> case x of) + (%~) SCL SCG = Disproved (\ x -> case x of) + (%~) SCL SCH = Disproved (\ x -> case x of) + (%~) SCL SCI = Disproved (\ x -> case x of) + (%~) SCL SCJ = Disproved (\ x -> case x of) + (%~) SCL SCK = Disproved (\ x -> case x of) + (%~) SCL SCL = Proved Refl + (%~) SCL SCM = Disproved (\ x -> case x of) + (%~) SCL SCN = Disproved (\ x -> case x of) + (%~) SCL SCO = Disproved (\ x -> case x of) + (%~) SCL SCP = Disproved (\ x -> case x of) + (%~) SCL SCQ = Disproved (\ x -> case x of) + (%~) SCL SCR = Disproved (\ x -> case x of) + (%~) SCL SCS = Disproved (\ x -> case x of) + (%~) SCL SCT = Disproved (\ x -> case x of) + (%~) SCL SCU = Disproved (\ x -> case x of) + (%~) SCL SCV = Disproved (\ x -> case x of) + (%~) SCL SCW = Disproved (\ x -> case x of) + (%~) SCL SCX = Disproved (\ x -> case x of) + (%~) SCL SCY = Disproved (\ x -> case x of) + (%~) SCL SCZ = Disproved (\ x -> case x of) + (%~) SCM SCA = Disproved (\ x -> case x of) + (%~) SCM SCB = Disproved (\ x -> case x of) + (%~) SCM SCC = Disproved (\ x -> case x of) + (%~) SCM SCD = Disproved (\ x -> case x of) + (%~) SCM SCE = Disproved (\ x -> case x of) + (%~) SCM SCF = Disproved (\ x -> case x of) + (%~) SCM SCG = Disproved (\ x -> case x of) + (%~) SCM SCH = Disproved (\ x -> case x of) + (%~) SCM SCI = Disproved (\ x -> case x of) + (%~) SCM SCJ = Disproved (\ x -> case x of) + (%~) SCM SCK = Disproved (\ x -> case x of) + (%~) SCM SCL = Disproved (\ x -> case x of) + (%~) SCM SCM = Proved Refl + (%~) SCM SCN = Disproved (\ x -> case x of) + (%~) SCM SCO = Disproved (\ x -> case x of) + (%~) SCM SCP = Disproved (\ x -> case x of) + (%~) SCM SCQ = Disproved (\ x -> case x of) + (%~) SCM SCR = Disproved (\ x -> case x of) + (%~) SCM SCS = Disproved (\ x -> case x of) + (%~) SCM SCT = Disproved (\ x -> case x of) + (%~) SCM SCU = Disproved (\ x -> case x of) + (%~) SCM SCV = Disproved (\ x -> case x of) + (%~) SCM SCW = Disproved (\ x -> case x of) + (%~) SCM SCX = Disproved (\ x -> case x of) + (%~) SCM SCY = Disproved (\ x -> case x of) + (%~) SCM SCZ = Disproved (\ x -> case x of) + (%~) SCN SCA = Disproved (\ x -> case x of) + (%~) SCN SCB = Disproved (\ x -> case x of) + (%~) SCN SCC = Disproved (\ x -> case x of) + (%~) SCN SCD = Disproved (\ x -> case x of) + (%~) SCN SCE = Disproved (\ x -> case x of) + (%~) SCN SCF = Disproved (\ x -> case x of) + (%~) SCN SCG = Disproved (\ x -> case x of) + (%~) SCN SCH = Disproved (\ x -> case x of) + (%~) SCN SCI = Disproved (\ x -> case x of) + (%~) SCN SCJ = Disproved (\ x -> case x of) + (%~) SCN SCK = Disproved (\ x -> case x of) + (%~) SCN SCL = Disproved (\ x -> case x of) + (%~) SCN SCM = Disproved (\ x -> case x of) + (%~) SCN SCN = Proved Refl + (%~) SCN SCO = Disproved (\ x -> case x of) + (%~) SCN SCP = Disproved (\ x -> case x of) + (%~) SCN SCQ = Disproved (\ x -> case x of) + (%~) SCN SCR = Disproved (\ x -> case x of) + (%~) SCN SCS = Disproved (\ x -> case x of) + (%~) SCN SCT = Disproved (\ x -> case x of) + (%~) SCN SCU = Disproved (\ x -> case x of) + (%~) SCN SCV = Disproved (\ x -> case x of) + (%~) SCN SCW = Disproved (\ x -> case x of) + (%~) SCN SCX = Disproved (\ x -> case x of) + (%~) SCN SCY = Disproved (\ x -> case x of) + (%~) SCN SCZ = Disproved (\ x -> case x of) + (%~) SCO SCA = Disproved (\ x -> case x of) + (%~) SCO SCB = Disproved (\ x -> case x of) + (%~) SCO SCC = Disproved (\ x -> case x of) + (%~) SCO SCD = Disproved (\ x -> case x of) + (%~) SCO SCE = Disproved (\ x -> case x of) + (%~) SCO SCF = Disproved (\ x -> case x of) + (%~) SCO SCG = Disproved (\ x -> case x of) + (%~) SCO SCH = Disproved (\ x -> case x of) + (%~) SCO SCI = Disproved (\ x -> case x of) + (%~) SCO SCJ = Disproved (\ x -> case x of) + (%~) SCO SCK = Disproved (\ x -> case x of) + (%~) SCO SCL = Disproved (\ x -> case x of) + (%~) SCO SCM = Disproved (\ x -> case x of) + (%~) SCO SCN = Disproved (\ x -> case x of) + (%~) SCO SCO = Proved Refl + (%~) SCO SCP = Disproved (\ x -> case x of) + (%~) SCO SCQ = Disproved (\ x -> case x of) + (%~) SCO SCR = Disproved (\ x -> case x of) + (%~) SCO SCS = Disproved (\ x -> case x of) + (%~) SCO SCT = Disproved (\ x -> case x of) + (%~) SCO SCU = Disproved (\ x -> case x of) + (%~) SCO SCV = Disproved (\ x -> case x of) + (%~) SCO SCW = Disproved (\ x -> case x of) + (%~) SCO SCX = Disproved (\ x -> case x of) + (%~) SCO SCY = Disproved (\ x -> case x of) + (%~) SCO SCZ = Disproved (\ x -> case x of) + (%~) SCP SCA = Disproved (\ x -> case x of) + (%~) SCP SCB = Disproved (\ x -> case x of) + (%~) SCP SCC = Disproved (\ x -> case x of) + (%~) SCP SCD = Disproved (\ x -> case x of) + (%~) SCP SCE = Disproved (\ x -> case x of) + (%~) SCP SCF = Disproved (\ x -> case x of) + (%~) SCP SCG = Disproved (\ x -> case x of) + (%~) SCP SCH = Disproved (\ x -> case x of) + (%~) SCP SCI = Disproved (\ x -> case x of) + (%~) SCP SCJ = Disproved (\ x -> case x of) + (%~) SCP SCK = Disproved (\ x -> case x of) + (%~) SCP SCL = Disproved (\ x -> case x of) + (%~) SCP SCM = Disproved (\ x -> case x of) + (%~) SCP SCN = Disproved (\ x -> case x of) + (%~) SCP SCO = Disproved (\ x -> case x of) + (%~) SCP SCP = Proved Refl + (%~) SCP SCQ = Disproved (\ x -> case x of) + (%~) SCP SCR = Disproved (\ x -> case x of) + (%~) SCP SCS = Disproved (\ x -> case x of) + (%~) SCP SCT = Disproved (\ x -> case x of) + (%~) SCP SCU = Disproved (\ x -> case x of) + (%~) SCP SCV = Disproved (\ x -> case x of) + (%~) SCP SCW = Disproved (\ x -> case x of) + (%~) SCP SCX = Disproved (\ x -> case x of) + (%~) SCP SCY = Disproved (\ x -> case x of) + (%~) SCP SCZ = Disproved (\ x -> case x of) + (%~) SCQ SCA = Disproved (\ x -> case x of) + (%~) SCQ SCB = Disproved (\ x -> case x of) + (%~) SCQ SCC = Disproved (\ x -> case x of) + (%~) SCQ SCD = Disproved (\ x -> case x of) + (%~) SCQ SCE = Disproved (\ x -> case x of) + (%~) SCQ SCF = Disproved (\ x -> case x of) + (%~) SCQ SCG = Disproved (\ x -> case x of) + (%~) SCQ SCH = Disproved (\ x -> case x of) + (%~) SCQ SCI = Disproved (\ x -> case x of) + (%~) SCQ SCJ = Disproved (\ x -> case x of) + (%~) SCQ SCK = Disproved (\ x -> case x of) + (%~) SCQ SCL = Disproved (\ x -> case x of) + (%~) SCQ SCM = Disproved (\ x -> case x of) + (%~) SCQ SCN = Disproved (\ x -> case x of) + (%~) SCQ SCO = Disproved (\ x -> case x of) + (%~) SCQ SCP = Disproved (\ x -> case x of) + (%~) SCQ SCQ = Proved Refl + (%~) SCQ SCR = Disproved (\ x -> case x of) + (%~) SCQ SCS = Disproved (\ x -> case x of) + (%~) SCQ SCT = Disproved (\ x -> case x of) + (%~) SCQ SCU = Disproved (\ x -> case x of) + (%~) SCQ SCV = Disproved (\ x -> case x of) + (%~) SCQ SCW = Disproved (\ x -> case x of) + (%~) SCQ SCX = Disproved (\ x -> case x of) + (%~) SCQ SCY = Disproved (\ x -> case x of) + (%~) SCQ SCZ = Disproved (\ x -> case x of) + (%~) SCR SCA = Disproved (\ x -> case x of) + (%~) SCR SCB = Disproved (\ x -> case x of) + (%~) SCR SCC = Disproved (\ x -> case x of) + (%~) SCR SCD = Disproved (\ x -> case x of) + (%~) SCR SCE = Disproved (\ x -> case x of) + (%~) SCR SCF = Disproved (\ x -> case x of) + (%~) SCR SCG = Disproved (\ x -> case x of) + (%~) SCR SCH = Disproved (\ x -> case x of) + (%~) SCR SCI = Disproved (\ x -> case x of) + (%~) SCR SCJ = Disproved (\ x -> case x of) + (%~) SCR SCK = Disproved (\ x -> case x of) + (%~) SCR SCL = Disproved (\ x -> case x of) + (%~) SCR SCM = Disproved (\ x -> case x of) + (%~) SCR SCN = Disproved (\ x -> case x of) + (%~) SCR SCO = Disproved (\ x -> case x of) + (%~) SCR SCP = Disproved (\ x -> case x of) + (%~) SCR SCQ = Disproved (\ x -> case x of) + (%~) SCR SCR = Proved Refl + (%~) SCR SCS = Disproved (\ x -> case x of) + (%~) SCR SCT = Disproved (\ x -> case x of) + (%~) SCR SCU = Disproved (\ x -> case x of) + (%~) SCR SCV = Disproved (\ x -> case x of) + (%~) SCR SCW = Disproved (\ x -> case x of) + (%~) SCR SCX = Disproved (\ x -> case x of) + (%~) SCR SCY = Disproved (\ x -> case x of) + (%~) SCR SCZ = Disproved (\ x -> case x of) + (%~) SCS SCA = Disproved (\ x -> case x of) + (%~) SCS SCB = Disproved (\ x -> case x of) + (%~) SCS SCC = Disproved (\ x -> case x of) + (%~) SCS SCD = Disproved (\ x -> case x of) + (%~) SCS SCE = Disproved (\ x -> case x of) + (%~) SCS SCF = Disproved (\ x -> case x of) + (%~) SCS SCG = Disproved (\ x -> case x of) + (%~) SCS SCH = Disproved (\ x -> case x of) + (%~) SCS SCI = Disproved (\ x -> case x of) + (%~) SCS SCJ = Disproved (\ x -> case x of) + (%~) SCS SCK = Disproved (\ x -> case x of) + (%~) SCS SCL = Disproved (\ x -> case x of) + (%~) SCS SCM = Disproved (\ x -> case x of) + (%~) SCS SCN = Disproved (\ x -> case x of) + (%~) SCS SCO = Disproved (\ x -> case x of) + (%~) SCS SCP = Disproved (\ x -> case x of) + (%~) SCS SCQ = Disproved (\ x -> case x of) + (%~) SCS SCR = Disproved (\ x -> case x of) + (%~) SCS SCS = Proved Refl + (%~) SCS SCT = Disproved (\ x -> case x of) + (%~) SCS SCU = Disproved (\ x -> case x of) + (%~) SCS SCV = Disproved (\ x -> case x of) + (%~) SCS SCW = Disproved (\ x -> case x of) + (%~) SCS SCX = Disproved (\ x -> case x of) + (%~) SCS SCY = Disproved (\ x -> case x of) + (%~) SCS SCZ = Disproved (\ x -> case x of) + (%~) SCT SCA = Disproved (\ x -> case x of) + (%~) SCT SCB = Disproved (\ x -> case x of) + (%~) SCT SCC = Disproved (\ x -> case x of) + (%~) SCT SCD = Disproved (\ x -> case x of) + (%~) SCT SCE = Disproved (\ x -> case x of) + (%~) SCT SCF = Disproved (\ x -> case x of) + (%~) SCT SCG = Disproved (\ x -> case x of) + (%~) SCT SCH = Disproved (\ x -> case x of) + (%~) SCT SCI = Disproved (\ x -> case x of) + (%~) SCT SCJ = Disproved (\ x -> case x of) + (%~) SCT SCK = Disproved (\ x -> case x of) + (%~) SCT SCL = Disproved (\ x -> case x of) + (%~) SCT SCM = Disproved (\ x -> case x of) + (%~) SCT SCN = Disproved (\ x -> case x of) + (%~) SCT SCO = Disproved (\ x -> case x of) + (%~) SCT SCP = Disproved (\ x -> case x of) + (%~) SCT SCQ = Disproved (\ x -> case x of) + (%~) SCT SCR = Disproved (\ x -> case x of) + (%~) SCT SCS = Disproved (\ x -> case x of) + (%~) SCT SCT = Proved Refl + (%~) SCT SCU = Disproved (\ x -> case x of) + (%~) SCT SCV = Disproved (\ x -> case x of) + (%~) SCT SCW = Disproved (\ x -> case x of) + (%~) SCT SCX = Disproved (\ x -> case x of) + (%~) SCT SCY = Disproved (\ x -> case x of) + (%~) SCT SCZ = Disproved (\ x -> case x of) + (%~) SCU SCA = Disproved (\ x -> case x of) + (%~) SCU SCB = Disproved (\ x -> case x of) + (%~) SCU SCC = Disproved (\ x -> case x of) + (%~) SCU SCD = Disproved (\ x -> case x of) + (%~) SCU SCE = Disproved (\ x -> case x of) + (%~) SCU SCF = Disproved (\ x -> case x of) + (%~) SCU SCG = Disproved (\ x -> case x of) + (%~) SCU SCH = Disproved (\ x -> case x of) + (%~) SCU SCI = Disproved (\ x -> case x of) + (%~) SCU SCJ = Disproved (\ x -> case x of) + (%~) SCU SCK = Disproved (\ x -> case x of) + (%~) SCU SCL = Disproved (\ x -> case x of) + (%~) SCU SCM = Disproved (\ x -> case x of) + (%~) SCU SCN = Disproved (\ x -> case x of) + (%~) SCU SCO = Disproved (\ x -> case x of) + (%~) SCU SCP = Disproved (\ x -> case x of) + (%~) SCU SCQ = Disproved (\ x -> case x of) + (%~) SCU SCR = Disproved (\ x -> case x of) + (%~) SCU SCS = Disproved (\ x -> case x of) + (%~) SCU SCT = Disproved (\ x -> case x of) + (%~) SCU SCU = Proved Refl + (%~) SCU SCV = Disproved (\ x -> case x of) + (%~) SCU SCW = Disproved (\ x -> case x of) + (%~) SCU SCX = Disproved (\ x -> case x of) + (%~) SCU SCY = Disproved (\ x -> case x of) + (%~) SCU SCZ = Disproved (\ x -> case x of) + (%~) SCV SCA = Disproved (\ x -> case x of) + (%~) SCV SCB = Disproved (\ x -> case x of) + (%~) SCV SCC = Disproved (\ x -> case x of) + (%~) SCV SCD = Disproved (\ x -> case x of) + (%~) SCV SCE = Disproved (\ x -> case x of) + (%~) SCV SCF = Disproved (\ x -> case x of) + (%~) SCV SCG = Disproved (\ x -> case x of) + (%~) SCV SCH = Disproved (\ x -> case x of) + (%~) SCV SCI = Disproved (\ x -> case x of) + (%~) SCV SCJ = Disproved (\ x -> case x of) + (%~) SCV SCK = Disproved (\ x -> case x of) + (%~) SCV SCL = Disproved (\ x -> case x of) + (%~) SCV SCM = Disproved (\ x -> case x of) + (%~) SCV SCN = Disproved (\ x -> case x of) + (%~) SCV SCO = Disproved (\ x -> case x of) + (%~) SCV SCP = Disproved (\ x -> case x of) + (%~) SCV SCQ = Disproved (\ x -> case x of) + (%~) SCV SCR = Disproved (\ x -> case x of) + (%~) SCV SCS = Disproved (\ x -> case x of) + (%~) SCV SCT = Disproved (\ x -> case x of) + (%~) SCV SCU = Disproved (\ x -> case x of) + (%~) SCV SCV = Proved Refl + (%~) SCV SCW = Disproved (\ x -> case x of) + (%~) SCV SCX = Disproved (\ x -> case x of) + (%~) SCV SCY = Disproved (\ x -> case x of) + (%~) SCV SCZ = Disproved (\ x -> case x of) + (%~) SCW SCA = Disproved (\ x -> case x of) + (%~) SCW SCB = Disproved (\ x -> case x of) + (%~) SCW SCC = Disproved (\ x -> case x of) + (%~) SCW SCD = Disproved (\ x -> case x of) + (%~) SCW SCE = Disproved (\ x -> case x of) + (%~) SCW SCF = Disproved (\ x -> case x of) + (%~) SCW SCG = Disproved (\ x -> case x of) + (%~) SCW SCH = Disproved (\ x -> case x of) + (%~) SCW SCI = Disproved (\ x -> case x of) + (%~) SCW SCJ = Disproved (\ x -> case x of) + (%~) SCW SCK = Disproved (\ x -> case x of) + (%~) SCW SCL = Disproved (\ x -> case x of) + (%~) SCW SCM = Disproved (\ x -> case x of) + (%~) SCW SCN = Disproved (\ x -> case x of) + (%~) SCW SCO = Disproved (\ x -> case x of) + (%~) SCW SCP = Disproved (\ x -> case x of) + (%~) SCW SCQ = Disproved (\ x -> case x of) + (%~) SCW SCR = Disproved (\ x -> case x of) + (%~) SCW SCS = Disproved (\ x -> case x of) + (%~) SCW SCT = Disproved (\ x -> case x of) + (%~) SCW SCU = Disproved (\ x -> case x of) + (%~) SCW SCV = Disproved (\ x -> case x of) + (%~) SCW SCW = Proved Refl + (%~) SCW SCX = Disproved (\ x -> case x of) + (%~) SCW SCY = Disproved (\ x -> case x of) + (%~) SCW SCZ = Disproved (\ x -> case x of) + (%~) SCX SCA = Disproved (\ x -> case x of) + (%~) SCX SCB = Disproved (\ x -> case x of) + (%~) SCX SCC = Disproved (\ x -> case x of) + (%~) SCX SCD = Disproved (\ x -> case x of) + (%~) SCX SCE = Disproved (\ x -> case x of) + (%~) SCX SCF = Disproved (\ x -> case x of) + (%~) SCX SCG = Disproved (\ x -> case x of) + (%~) SCX SCH = Disproved (\ x -> case x of) + (%~) SCX SCI = Disproved (\ x -> case x of) + (%~) SCX SCJ = Disproved (\ x -> case x of) + (%~) SCX SCK = Disproved (\ x -> case x of) + (%~) SCX SCL = Disproved (\ x -> case x of) + (%~) SCX SCM = Disproved (\ x -> case x of) + (%~) SCX SCN = Disproved (\ x -> case x of) + (%~) SCX SCO = Disproved (\ x -> case x of) + (%~) SCX SCP = Disproved (\ x -> case x of) + (%~) SCX SCQ = Disproved (\ x -> case x of) + (%~) SCX SCR = Disproved (\ x -> case x of) + (%~) SCX SCS = Disproved (\ x -> case x of) + (%~) SCX SCT = Disproved (\ x -> case x of) + (%~) SCX SCU = Disproved (\ x -> case x of) + (%~) SCX SCV = Disproved (\ x -> case x of) + (%~) SCX SCW = Disproved (\ x -> case x of) + (%~) SCX SCX = Proved Refl + (%~) SCX SCY = Disproved (\ x -> case x of) + (%~) SCX SCZ = Disproved (\ x -> case x of) + (%~) SCY SCA = Disproved (\ x -> case x of) + (%~) SCY SCB = Disproved (\ x -> case x of) + (%~) SCY SCC = Disproved (\ x -> case x of) + (%~) SCY SCD = Disproved (\ x -> case x of) + (%~) SCY SCE = Disproved (\ x -> case x of) + (%~) SCY SCF = Disproved (\ x -> case x of) + (%~) SCY SCG = Disproved (\ x -> case x of) + (%~) SCY SCH = Disproved (\ x -> case x of) + (%~) SCY SCI = Disproved (\ x -> case x of) + (%~) SCY SCJ = Disproved (\ x -> case x of) + (%~) SCY SCK = Disproved (\ x -> case x of) + (%~) SCY SCL = Disproved (\ x -> case x of) + (%~) SCY SCM = Disproved (\ x -> case x of) + (%~) SCY SCN = Disproved (\ x -> case x of) + (%~) SCY SCO = Disproved (\ x -> case x of) + (%~) SCY SCP = Disproved (\ x -> case x of) + (%~) SCY SCQ = Disproved (\ x -> case x of) + (%~) SCY SCR = Disproved (\ x -> case x of) + (%~) SCY SCS = Disproved (\ x -> case x of) + (%~) SCY SCT = Disproved (\ x -> case x of) + (%~) SCY SCU = Disproved (\ x -> case x of) + (%~) SCY SCV = Disproved (\ x -> case x of) + (%~) SCY SCW = Disproved (\ x -> case x of) + (%~) SCY SCX = Disproved (\ x -> case x of) + (%~) SCY SCY = Proved Refl + (%~) SCY SCZ = Disproved (\ x -> case x of) + (%~) SCZ SCA = Disproved (\ x -> case x of) + (%~) SCZ SCB = Disproved (\ x -> case x of) + (%~) SCZ SCC = Disproved (\ x -> case x of) + (%~) SCZ SCD = Disproved (\ x -> case x of) + (%~) SCZ SCE = Disproved (\ x -> case x of) + (%~) SCZ SCF = Disproved (\ x -> case x of) + (%~) SCZ SCG = Disproved (\ x -> case x of) + (%~) SCZ SCH = Disproved (\ x -> case x of) + (%~) SCZ SCI = Disproved (\ x -> case x of) + (%~) SCZ SCJ = Disproved (\ x -> case x of) + (%~) SCZ SCK = Disproved (\ x -> case x of) + (%~) SCZ SCL = Disproved (\ x -> case x of) + (%~) SCZ SCM = Disproved (\ x -> case x of) + (%~) SCZ SCN = Disproved (\ x -> case x of) + (%~) SCZ SCO = Disproved (\ x -> case x of) + (%~) SCZ SCP = Disproved (\ x -> case x of) + (%~) SCZ SCQ = Disproved (\ x -> case x of) + (%~) SCZ SCR = Disproved (\ x -> case x of) + (%~) SCZ SCS = Disproved (\ x -> case x of) + (%~) SCZ SCT = Disproved (\ x -> case x of) + (%~) SCZ SCU = Disproved (\ x -> case x of) + (%~) SCZ SCV = Disproved (\ x -> case x of) + (%~) SCZ SCW = Disproved (\ x -> case x of) + (%~) SCZ SCX = Disproved (\ x -> case x of) + (%~) SCZ SCY = Disproved (\ x -> case x of) + (%~) SCZ SCZ = Proved Refl + deriving instance (Data.Singletons.ShowSing.ShowSing U, + Data.Singletons.ShowSing.ShowSing Nat) => + Show (Sing (z :: U)) + deriving instance Show (Sing (z :: AChar)) + instance SingI BOOL where + sing = SBOOL + instance SingI STRING where + sing = SSTRING + instance SingI NAT where + sing = SNAT + instance (SingI n, SingI n) => + SingI (VEC (n :: U) (n :: Nat)) where + sing = (SVEC sing) sing + instance SingI (VECSym0 :: (~>) U ((~>) Nat U)) where + sing = (singFun2 @VECSym0) SVEC + instance SingI (TyCon2 VEC :: (~>) U ((~>) Nat U)) where + sing = (singFun2 @(TyCon2 VEC)) SVEC + instance SingI d => SingI (VECSym1 (d :: U) :: (~>) Nat U) where + sing = (singFun1 @(VECSym1 (d :: U))) (SVEC (sing @d)) + instance SingI d => + SingI (TyCon1 (VEC (d :: U)) :: (~>) Nat U) where + sing = (singFun1 @(TyCon1 (VEC (d :: U)))) (SVEC (sing @d)) + instance SingI CA where + sing = SCA + instance SingI CB where + sing = SCB + instance SingI CC where + sing = SCC + instance SingI CD where + sing = SCD + instance SingI CE where + sing = SCE + instance SingI CF where + sing = SCF + instance SingI CG where + sing = SCG + instance SingI CH where + sing = SCH + instance SingI CI where + sing = SCI + instance SingI CJ where + sing = SCJ + instance SingI CK where + sing = SCK + instance SingI CL where + sing = SCL + instance SingI CM where + sing = SCM + instance SingI CN where + sing = SCN + instance SingI CO where + sing = SCO + instance SingI CP where + sing = SCP + instance SingI CQ where + sing = SCQ + instance SingI CR where + sing = SCR + instance SingI CS where + sing = SCS + instance SingI CT where + sing = SCT + instance SingI CU where + sing = SCU + instance SingI CV where + sing = SCV + instance SingI CW where + sing = SCW + instance SingI CX where + sing = SCX + instance SingI CY where + sing = SCY + instance SingI CZ where + sing = SCZ + instance (SingI n, SingI n) => + SingI (Attr (n :: [AChar]) (n :: U)) where + sing = (SAttr sing) sing + instance SingI (AttrSym0 :: (~>) [AChar] ((~>) U Attribute)) where + sing = (singFun2 @AttrSym0) SAttr + instance SingI (TyCon2 Attr :: (~>) [AChar] ((~>) U Attribute)) where + sing = (singFun2 @(TyCon2 Attr)) SAttr + instance SingI d => + SingI (AttrSym1 (d :: [AChar]) :: (~>) U Attribute) where + sing = (singFun1 @(AttrSym1 (d :: [AChar]))) (SAttr (sing @d)) + instance SingI d => + SingI (TyCon1 (Attr (d :: [AChar])) :: (~>) U Attribute) where + sing = (singFun1 @(TyCon1 (Attr (d :: [AChar])))) (SAttr (sing @d)) + instance SingI n => SingI (Sch (n :: [Attribute])) where + sing = SSch sing + instance SingI (SchSym0 :: (~>) [Attribute] Schema) where + sing = (singFun1 @SchSym0) SSch + instance SingI (TyCon1 Sch :: (~>) [Attribute] Schema) where + sing = (singFun1 @(TyCon1 Sch)) SSch +GradingClient/Database.hs:0:0:: Splicing declarations + return [] ======> +GradingClient/Database.hs:(0,0)-(0,0): Splicing expression + cases ''Row [| r |] [| changeId (n ++ (getId r)) r |] + ======> + case r of + EmptyRow _ -> (changeId (((++) n) (getId r))) r + ConsRow _ _ -> (changeId (((++) n) (getId r))) r 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 @@ -30,7 +30,7 @@ import Control.Monad import Control.Monad.Except ( throwError ) import Data.List hiding ( tail ) -import Data.Kind +import Data.Kind (Type) $(singletons [d| -- Basic Nat type diff --git a/tests/compile-and-dump/GradingClient/Main.ghc84.template b/tests/compile-and-dump/GradingClient/Main.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/GradingClient/Main.ghc84.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 - 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/GradingClient/Main.ghc86.template b/tests/compile-and-dump/GradingClient/Main.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Main.ghc86.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.ghc84.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc84.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) - 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.ghc86.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template @@ -0,0 +1,212 @@ +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Nat = Zero | Succ Nat |] + ======> + data Nat = Zero | Succ Nat + type ZeroSym0 = Zero + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) + data SuccSym0 :: (~>) Nat Nat + where + SuccSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0 t0123456789876543210 + type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 + data instance Sing :: Nat -> Type + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance SingI (SuccSym0 :: (~>) Nat Nat) where + sing = (singFun1 @SuccSym0) SSucc + instance SingI (TyCon1 Succ :: (~>) Nat Nat) where + sing = (singFun1 @(TyCon1 Succ)) SSucc +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = leq a b + insert :: Nat -> [Nat] -> [Nat] + insert n [] = [n] + insert n (h : t) + = if leq n h then (n : h : t) else h : (insert n t) + insertionSort :: [Nat] -> [Nat] + insertionSort [] = [] + insertionSort (h : t) = insert h (insertionSort t) |] + ======> + leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = (leq a) b + insert :: Nat -> [Nat] -> [Nat] + insert n [] = [n] + insert n (h : t) + = if (leq n) h then (n : (h : t)) else (h : (insert n) t) + insertionSort :: [Nat] -> [Nat] + insertionSort [] = [] + insertionSort (h : t) = (insert h) (insertionSort t) + type Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall n0123456789876543210 + h0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 h0123456789876543210 n0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall n0123456789876543210 + h0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) h0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall n0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where + Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h + type family Case_0123456789876543210 n h t t where + Case_0123456789876543210 n h t 'True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t) + Case_0123456789876543210 n h t 'False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t) + type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Leq a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ()) + data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool + where + LeqSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => + LeqSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings LeqSym0 where + suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ()) + data LeqSym0 :: (~>) Nat ((~>) Nat Bool) + where + LeqSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => + LeqSym0 a0123456789876543210 + type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 + type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) = + Insert a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) InsertSym1KindInference) ()) + data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat] + where + InsertSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) => + InsertSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (InsertSym1 a0123456789876543210) a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings InsertSym0 where + suppressUnusedWarnings = snd (((,) InsertSym0KindInference) ()) + data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) + where + InsertSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => + InsertSym0 a0123456789876543210 + type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 + type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = + InsertionSort a0123456789876543210 + instance SuppressUnusedWarnings InsertionSortSym0 where + suppressUnusedWarnings + = snd (((,) InsertionSortSym0KindInference) ()) + data InsertionSortSym0 :: (~>) [Nat] [Nat] + where + InsertionSortSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => + InsertionSortSym0 a0123456789876543210 + type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210 + type family Leq (a :: Nat) (a :: Nat) :: Bool where + Leq 'Zero _ = TrueSym0 + Leq ( 'Succ _) 'Zero = FalseSym0 + Leq ( 'Succ a) ( 'Succ b) = Apply (Apply LeqSym0 a) b + type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where + Insert n '[] = Apply (Apply (:@#@$) n) '[] + Insert n ( '(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) + type family InsertionSort (a :: [Nat]) :: [Nat] where + InsertionSort '[] = '[] + InsertionSort ( '(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) + sLeq :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + sInsert :: + forall (t :: Nat) (t :: [Nat]). + Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) + sInsertionSort :: + forall (t :: [Nat]). + Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) + sLeq SZero _ = STrue + sLeq (SSucc _) SZero = SFalse + sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) + = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB + sInsert (sN :: Sing n) SNil + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) SNil + sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t)) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sN)) sH + in (case sScrutinee_0123456789876543210 of + STrue + -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) sT) + SFalse + -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) + ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN)) + sT)) :: + Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) :: [Nat]) + sInsertionSort SNil = SNil + sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) + ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) + instance SingI (LeqSym0 :: (~>) Nat ((~>) Nat Bool)) where + sing = (singFun2 @LeqSym0) sLeq + instance SingI d => + SingI (LeqSym1 (d :: Nat) :: (~>) Nat Bool) where + sing = (singFun1 @(LeqSym1 (d :: Nat))) (sLeq (sing @d)) + instance SingI (InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])) where + sing = (singFun2 @InsertSym0) sInsert + instance SingI d => + SingI (InsertSym1 (d :: Nat) :: (~>) [Nat] [Nat]) where + sing = (singFun1 @(InsertSym1 (d :: Nat))) (sInsert (sing @d)) + instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where + sing = (singFun1 @InsertionSortSym0) sInsertionSort diff --git a/tests/compile-and-dump/Promote/Constructors.ghc84.template b/tests/compile-and-dump/Promote/Constructors.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Constructors.ghc84.template +++ /dev/null @@ -1,70 +0,0 @@ -Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations - promote - [d| data Foo = Foo | Foo :+ Foo - data Bar = Bar Bar Bar Bar Bar Foo |] - ======> - data Foo = Foo | Foo :+ Foo - data Bar = Bar Bar Bar Bar Bar Foo - type FooSym0 = Foo - type (:+@#@$$$) (t :: Foo) (t :: Foo) = (:+) t t - instance SuppressUnusedWarnings (:+@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::+@#@$$###)) GHC.Tuple.()) - data (:+@#@$$) (l :: Foo) (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ((:+@#@$$) l) arg) ((:+@#@$$$) l arg) => - (::+@#@$$###) - type instance Apply ((:+@#@$$) l) l = (:+) l l - instance SuppressUnusedWarnings (:+@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::+@#@$###)) GHC.Tuple.()) - data (:+@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => - (::+@#@$###) - type instance Apply (:+@#@$) l = (:+@#@$$) l - type BarSym5 (t :: Bar) (t :: Bar) (t :: Bar) (t :: Bar) (t :: Foo) = - Bar t t t t t - instance SuppressUnusedWarnings BarSym4 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym4KindInference) GHC.Tuple.()) - data BarSym4 (l :: Bar) (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Foo Bar) - = forall arg. SameKind (Apply (BarSym4 l l l l) arg) (BarSym5 l l l l arg) => - BarSym4KindInference - type instance Apply (BarSym4 l l l l) l = Bar l l l l l - instance SuppressUnusedWarnings BarSym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym3KindInference) GHC.Tuple.()) - data BarSym3 (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym3 l l l) arg) (BarSym4 l l l arg) => - BarSym3KindInference - type instance Apply (BarSym3 l l l) l = BarSym4 l l l l - instance SuppressUnusedWarnings BarSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym2KindInference) GHC.Tuple.()) - data BarSym2 (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym2 l l) arg) (BarSym3 l l arg) => - BarSym2KindInference - type instance Apply (BarSym2 l l) l = BarSym3 l l l - instance SuppressUnusedWarnings BarSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) - data BarSym1 (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => - BarSym1KindInference - type instance Apply (BarSym1 l) l = BarSym2 l l - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = BarSym1 l diff --git a/tests/compile-and-dump/Promote/Constructors.ghc86.template b/tests/compile-and-dump/Promote/Constructors.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Constructors.ghc86.template @@ -0,0 +1,79 @@ +Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations + promote + [d| data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo |] + ======> + data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo + type FooSym0 = Foo + type (:+@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = + (:+) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:+@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) + data (:+@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo + where + (::+@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:+@#@$$) t0123456789876543210) arg) ((:+@#@$$$) t0123456789876543210 arg) => + (:+@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:+@#@$$) t0123456789876543210) t0123456789876543210 = (:+) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) + data (:+@#@$) :: (~>) Foo ((~>) Foo Foo) + where + (::+@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (:+@#@$) t0123456789876543210 + type instance Apply (:+@#@$) t0123456789876543210 = (:+@#@$$) t0123456789876543210 + type BarSym5 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Foo) = + Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym4KindInference) ()) + data BarSym4 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Foo Bar + where + BarSym4KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym3KindInference) ()) + data BarSym3 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar) + where + BarSym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym2KindInference) ()) + data BarSym2 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar)) + where + BarSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym2 t0123456789876543210 t0123456789876543210) arg) (BarSym3 t0123456789876543210 t0123456789876543210 arg) => + BarSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) + data BarSym1 (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) + where + BarSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => + BarSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) + where + BarSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 t0123456789876543210 + type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 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,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Promote.Constructors where import Data.Singletons.SuppressUnusedWarnings diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc84.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.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.ghc86.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template @@ -0,0 +1,54 @@ +Promote/GenDefunSymbols.hs:0:0:: Splicing declarations + genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] + ======> + type LiftMaybeSym2 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) = + LiftMaybe f0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (LiftMaybeSym1 f0123456789876543210) where + suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) + data LiftMaybeSym1 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) + where + LiftMaybeSym1KindInference :: forall f0123456789876543210 + x0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 f0123456789876543210) arg) (LiftMaybeSym2 f0123456789876543210 arg) => + LiftMaybeSym1 f0123456789876543210 x0123456789876543210 + type instance Apply (LiftMaybeSym1 f0123456789876543210) x0123456789876543210 = LiftMaybe f0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) + data LiftMaybeSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)) + where + LiftMaybeSym0KindInference :: forall f0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => + LiftMaybeSym0 f0123456789876543210 + type instance Apply LiftMaybeSym0 f0123456789876543210 = LiftMaybeSym1 f0123456789876543210 + type ZeroSym0 = 'Zero + type SuccSym1 (t0123456789876543210 :: NatT) = + 'Succ t0123456789876543210 + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) + data SuccSym0 :: (~>) NatT NatT + where + SuccSym0KindInference :: forall t0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0 t0123456789876543210 + type instance Apply SuccSym0 t0123456789876543210 = 'Succ t0123456789876543210 + type (:+@#@$$$) (a0123456789876543210 :: Nat) (b0123456789876543210 :: Nat) = + (:+) a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) + data (:+@#@$$) (a0123456789876543210 :: Nat) b0123456789876543210 + where + (::+@#@$$###) :: forall a0123456789876543210 + b0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) => + (:+@#@$$) a0123456789876543210 b0123456789876543210 + type instance Apply ((:+@#@$$) a0123456789876543210) b0123456789876543210 = (:+) a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) + data (:+@#@$) a0123456789876543210 + where + (::+@#@$###) :: forall a0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (:+@#@$) a0123456789876543210 + type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 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,14 +1,12 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Promote.GenDefunSymbols where -import Data.Singletons (Apply, TyFun) -import Data.Singletons.Promote +import Data.Singletons (Apply, type (~>)) import Data.Singletons.SuppressUnusedWarnings +import Data.Singletons.TH (genDefunSymbols) import GHC.TypeLits hiding (type (*)) -import Data.Kind +import Data.Kind (Type) -type family LiftMaybe (f :: TyFun a b -> *) (x :: Maybe a) :: Maybe b where +type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where LiftMaybe f Nothing = Nothing LiftMaybe f (Just a) = Just (Apply f a) diff --git a/tests/compile-and-dump/Promote/Newtypes.ghc84.template b/tests/compile-and-dump/Promote/Newtypes.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Newtypes.ghc84.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 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.ghc86.template b/tests/compile-and-dump/Promote/Newtypes.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Newtypes.ghc86.template @@ -0,0 +1,48 @@ +Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| newtype Foo + = Foo Nat + deriving Eq + newtype Bar = Bar {unBar :: Nat} |] + ======> + newtype Foo + = Foo Nat + deriving Eq + newtype Bar = Bar {unBar :: Nat} + type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where + Equals_0123456789876543210 (Foo a) (Foo b) = (==) a b + Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 + instance PEq Foo where + type (==) a b = Equals_0123456789876543210 a b + type UnBarSym1 (a0123456789876543210 :: Bar) = + UnBar a0123456789876543210 + instance SuppressUnusedWarnings UnBarSym0 where + suppressUnusedWarnings = snd (((,) UnBarSym0KindInference) ()) + data UnBarSym0 :: (~>) Bar Nat + where + UnBarSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => + UnBarSym0 a0123456789876543210 + type instance Apply UnBarSym0 a0123456789876543210 = UnBar a0123456789876543210 + type family UnBar (a :: Bar) :: Nat where + UnBar (Bar field) = field + type FooSym1 (t0123456789876543210 :: Nat) = + Foo t0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) Nat Foo + where + FooSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 t0123456789876543210 + type instance Apply FooSym0 t0123456789876543210 = Foo t0123456789876543210 + type BarSym1 (t0123456789876543210 :: Nat) = + Bar t0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Nat Bar + where + BarSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 t0123456789876543210 + type instance Apply BarSym0 t0123456789876543210 = Bar t0123456789876543210 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,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Promote.Newtypes where import Data.Singletons.SuppressUnusedWarnings diff --git a/tests/compile-and-dump/Promote/Pragmas.ghc84.template b/tests/compile-and-dump/Promote/Pragmas.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Pragmas.ghc84.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 - Foo = TrueSym0 diff --git a/tests/compile-and-dump/Promote/Pragmas.ghc86.template b/tests/compile-and-dump/Promote/Pragmas.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Pragmas.ghc86.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/Pragmas.hs b/tests/compile-and-dump/Promote/Pragmas.hs --- a/tests/compile-and-dump/Promote/Pragmas.hs +++ b/tests/compile-and-dump/Promote/Pragmas.hs @@ -1,7 +1,7 @@ module Promote.Pragmas where import Data.Singletons.TH -import Data.Promotion.Prelude +import Data.Singletons.Prelude $(promote [d| {-# INLINE foo #-} diff --git a/tests/compile-and-dump/Promote/Prelude.ghc84.template b/tests/compile-and-dump/Promote/Prelude.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/Prelude.ghc84.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.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.ghc86.template b/tests/compile-and-dump/Promote/Prelude.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Prelude.ghc86.template @@ -0,0 +1,19 @@ +Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations + promoteOnly + [d| odd :: Nat -> Bool + odd 0 = False + odd n = not . odd $ n - 1 |] + ======> + type OddSym1 (a0123456789876543210 :: Nat) = + Odd a0123456789876543210 + instance SuppressUnusedWarnings OddSym0 where + suppressUnusedWarnings = snd (((,) OddSym0KindInference) ()) + data OddSym0 :: (~>) Nat Bool + where + OddSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply OddSym0 arg) (OddSym1 arg) => + OddSym0 a0123456789876543210 + type instance Apply OddSym0 a0123456789876543210 = Odd a0123456789876543210 + type family Odd (a :: Nat) :: Bool where + Odd 0 = FalseSym0 + Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1)) 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 @@ -1,8 +1,8 @@ module Promote.Prelude where -import Data.Promotion.TH -import Data.Promotion.Prelude -import Data.Promotion.Prelude.List +import Data.Singletons.TH +import Data.Singletons.Prelude +import Data.Singletons.Prelude.List import GHC.TypeLits lengthTest1a :: Proxy (Length '[True, True, True, True]) diff --git a/tests/compile-and-dump/Promote/T180.ghc84.template b/tests/compile-and-dump/Promote/T180.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Promote/T180.ghc84.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.ghc86.template b/tests/compile-and-dump/Promote/T180.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/T180.ghc86.template @@ -0,0 +1,54 @@ +Promote/T180.hs:(0,0)-(0,0): Splicing declarations + promote + [d| z (X1 x) = x + z (X2 x) = x + + data X = X1 {y :: Symbol} | X2 {y :: Symbol} |] + ======> + data X = X1 {y :: Symbol} | X2 {y :: Symbol} + z (X1 x) = x + z (X2 x) = x + type ZSym1 a0123456789876543210 = Z a0123456789876543210 + instance SuppressUnusedWarnings ZSym0 where + suppressUnusedWarnings = snd (((,) ZSym0KindInference) ()) + data ZSym0 a0123456789876543210 + where + ZSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) => + ZSym0 a0123456789876543210 + type instance Apply ZSym0 a0123456789876543210 = Z a0123456789876543210 + type family Z a where + Z (X1 x) = x + Z (X2 x) = x + type YSym1 (a0123456789876543210 :: X) = Y a0123456789876543210 + instance SuppressUnusedWarnings YSym0 where + suppressUnusedWarnings = snd (((,) YSym0KindInference) ()) + data YSym0 :: (~>) X Symbol + where + YSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply YSym0 arg) (YSym1 arg) => + YSym0 a0123456789876543210 + type instance Apply YSym0 a0123456789876543210 = Y a0123456789876543210 + type family Y (a :: X) :: Symbol where + Y (X1 field) = field + Y (X2 field) = field + type X1Sym1 (t0123456789876543210 :: Symbol) = + X1 t0123456789876543210 + instance SuppressUnusedWarnings X1Sym0 where + suppressUnusedWarnings = snd (((,) X1Sym0KindInference) ()) + data X1Sym0 :: (~>) Symbol X + where + X1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => + X1Sym0 t0123456789876543210 + type instance Apply X1Sym0 t0123456789876543210 = X1 t0123456789876543210 + type X2Sym1 (t0123456789876543210 :: Symbol) = + X2 t0123456789876543210 + instance SuppressUnusedWarnings X2Sym0 where + suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ()) + data X2Sym0 :: (~>) Symbol X + where + X2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => + X2Sym0 t0123456789876543210 + type instance Apply X2Sym0 t0123456789876543210 = X2 t0123456789876543210 diff --git a/tests/compile-and-dump/Promote/T361.ghc86.template b/tests/compile-and-dump/Promote/T361.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/T361.ghc86.template @@ -0,0 +1,21 @@ +Promote/T361.hs:0:0:: Splicing declarations + genDefunSymbols [''Proxy] ======> type ProxySym0 = 'Proxy +Promote/T361.hs:(0,0)-(0,0): Splicing declarations + promote + [d| f :: Proxy 1 -> Proxy 2 + f Proxy = Proxy |] + ======> + f :: Proxy 1 -> Proxy 2 + f Proxy = Proxy + type FSym1 (a0123456789876543210 :: Proxy 1) = + F a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 :: (~>) (Proxy 1) (Proxy 2) + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 + type family F (a :: Proxy 1) :: Proxy 2 where + F 'Proxy = ProxySym0 diff --git a/tests/compile-and-dump/Promote/T361.hs b/tests/compile-and-dump/Promote/T361.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/T361.hs @@ -0,0 +1,11 @@ +module T361 where + +import Data.Proxy +import Data.Singletons.TH + +$(genDefunSymbols [''Proxy]) + +$(promote [d| + f :: Proxy 1 -> Proxy 2 + f Proxy = Proxy + |]) diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc84.template b/tests/compile-and-dump/Singletons/AsPattern.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/AsPattern.ghc84.template +++ /dev/null @@ -1,352 +0,0 @@ -Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| maybePlus :: Maybe Nat -> Maybe Nat - maybePlus (Just n) = Just (plus (Succ Zero) n) - maybePlus p@Nothing = p - bar :: Maybe Nat -> Maybe Nat - bar x@(Just _) = x - bar Nothing = Nothing - baz_ :: Maybe Baz -> Maybe Baz - baz_ p@Nothing = p - baz_ p@(Just (Baz _ _ _)) = p - tup :: (Nat, Nat) -> (Nat, Nat) - tup p@(_, _) = p - foo :: [Nat] -> [Nat] - foo p@[] = p - foo p@[_] = p - foo p@(_ : _ : _) = p - - data Baz = Baz Nat Nat Nat |] - ======> - maybePlus :: Maybe Nat -> Maybe Nat - maybePlus (Just n) = Just ((plus (Succ Zero)) n) - maybePlus p@Nothing = p - bar :: Maybe Nat -> Maybe Nat - bar x@Just _ = x - bar Nothing = Nothing - data Baz = Baz Nat Nat Nat - baz_ :: Maybe Baz -> Maybe Baz - baz_ p@Nothing = p - baz_ p@Just (Baz _ _ _) = p - tup :: (Nat, Nat) -> (Nat, Nat) - tup p@(_, _) = p - foo :: [Nat] -> [Nat] - foo p@GHC.Types.[] = p - foo p@[_] = p - foo p@(_ GHC.Types.: (_ GHC.Types.: _)) = p - type BazSym3 (t :: Nat) (t :: Nat) (t :: Nat) = Baz t t t - instance SuppressUnusedWarnings BazSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BazSym2KindInference) GHC.Tuple.()) - data BazSym2 (l :: Nat) (l :: Nat) (l :: TyFun Nat Baz) - = forall arg. SameKind (Apply (BazSym2 l l) arg) (BazSym3 l l arg) => - BazSym2KindInference - type instance Apply (BazSym2 l l) l = Baz l l l - instance SuppressUnusedWarnings BazSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BazSym1KindInference) GHC.Tuple.()) - data BazSym1 (l :: Nat) (l :: TyFun Nat (TyFun Nat Baz - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BazSym1 l) arg) (BazSym2 l arg) => - BazSym1KindInference - type instance Apply (BazSym1 l) l = BazSym2 l l - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) - data BazSym0 (l :: TyFun Nat (TyFun Nat (TyFun Nat Baz - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0KindInference - type instance Apply BazSym0 l = BazSym1 l - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = '[] - type Let0123456789876543210PSym1 t = Let0123456789876543210P t - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210P l - type family Let0123456789876543210P wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[] - type Let0123456789876543210PSym3 t t t = - Let0123456789876543210P t t t - instance SuppressUnusedWarnings Let0123456789876543210PSym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => - Let0123456789876543210PSym2KindInference - type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210PSym2 t t = Let0123456789876543210P t t - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210P l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NothingSym0 - type Let0123456789876543210PSym3 t t t = - Let0123456789876543210P t t t - instance SuppressUnusedWarnings Let0123456789876543210PSym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym2 l l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) => - Let0123456789876543210PSym2KindInference - type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l - instance SuppressUnusedWarnings Let0123456789876543210PSym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) => - Let0123456789876543210PSym1KindInference - type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210PSym0 l - = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0KindInference - type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210XSym1 t = Let0123456789876543210X t - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210XSym0 l - = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0KindInference - type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l - type family Let0123456789876543210X wild_0123456789876543210 where - Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NothingSym0 - type FooSym1 (t :: [Nat]) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun [Nat] [Nat]) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type TupSym1 (t :: (Nat, Nat)) = Tup t - instance SuppressUnusedWarnings TupSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) TupSym0KindInference) GHC.Tuple.()) - data TupSym0 (l :: TyFun (Nat, Nat) (Nat, Nat)) - = forall arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => - TupSym0KindInference - type instance Apply TupSym0 l = Tup l - type Baz_Sym1 (t :: Maybe Baz) = Baz_ t - instance SuppressUnusedWarnings Baz_Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Baz_Sym0KindInference) GHC.Tuple.()) - data Baz_Sym0 (l :: TyFun (Maybe Baz) (Maybe Baz)) - = forall arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => - Baz_Sym0KindInference - type instance Apply Baz_Sym0 l = Baz_ l - type BarSym1 (t :: Maybe Nat) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l - type MaybePlusSym1 (t :: Maybe Nat) = MaybePlus t - instance SuppressUnusedWarnings MaybePlusSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MaybePlusSym0KindInference) GHC.Tuple.()) - data MaybePlusSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) - = forall arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => - MaybePlusSym0KindInference - type instance Apply MaybePlusSym0 l = MaybePlus l - type family Foo (a :: [Nat]) :: [Nat] where - Foo '[] = Let0123456789876543210PSym0 - Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 - Foo ((:) wild_0123456789876543210 ((:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 - type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where - Tup '(wild_0123456789876543210, - wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 - type family Baz_ (a :: Maybe Baz) :: Maybe Baz where - Baz_ Nothing = Let0123456789876543210PSym0 - Baz_ (Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 - type family Bar (a :: Maybe Nat) :: Maybe Nat where - Bar (Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 - Bar Nothing = NothingSym0 - type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where - MaybePlus (Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) - MaybePlus Nothing = Let0123456789876543210PSym0 - sFoo :: - forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) - sTup :: - forall (t :: (Nat, Nat)). - Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) - sBaz_ :: - forall (t :: Maybe Baz). - Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) - sBar :: - forall (t :: Maybe Nat). - Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) - sMaybePlus :: - forall (t :: Maybe Nat). - Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) - sFoo SNil - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNil - in sP - sFoo - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - SNil) - = let - sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - sWild_0123456789876543210)) - SNil - in sP - sFoo - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) - = let - sP :: - Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - sWild_0123456789876543210)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - sWild_0123456789876543210)) - sWild_0123456789876543210) - in sP - sTup - (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) - = let - sP :: - Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - sWild_0123456789876543210)) - sWild_0123456789876543210 - in sP - sBaz_ SNothing - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNothing - in sP - sBaz_ - (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210) - (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) - = let - sP :: - Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) - sP - = (applySing ((singFun1 @JustSym0) SJust)) - ((applySing - ((applySing - ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210)) - sWild_0123456789876543210)) - sWild_0123456789876543210) - in sP - sBar - (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) - = let - sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) - sX - = (applySing ((singFun1 @JustSym0) SJust)) - sWild_0123456789876543210 - in sX - sBar SNothing = SNothing - sMaybePlus (SJust (sN :: Sing n)) - = (applySing ((singFun1 @JustSym0) SJust)) - ((applySing - ((applySing ((singFun2 @PlusSym0) sPlus)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - sN) - sMaybePlus SNothing - = let - sP :: Sing Let0123456789876543210PSym0 - sP = SNothing - in sP - data instance Sing (z :: Baz) - where - SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat). - (Sing (n :: Nat)) - -> (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> Sing (Baz n n n) - type SBaz = (Sing :: Baz -> GHC.Types.Type) - instance SingKind Baz where - type Demote Baz = Baz - fromSing (SBaz b b b) - = ((Baz (fromSing b)) (fromSing b)) (fromSing b) - toSing (Baz (b :: Demote Nat) (b :: Demote Nat) (b :: Demote Nat)) - = case - ((GHC.Tuple.(,,) (toSing b :: SomeSing Nat)) - (toSing b :: SomeSing Nat)) - (toSing b :: SomeSing Nat) - of { - GHC.Tuple.(,,) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing (((SBaz c) c) c) } - instance (SingI n, SingI n, SingI n) => - SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where - sing = ((SBaz sing) sing) sing diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc86.template b/tests/compile-and-dump/Singletons/AsPattern.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/AsPattern.ghc86.template @@ -0,0 +1,405 @@ +Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just (plus (Succ Zero) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@(Just _) = x + bar Nothing = Nothing + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@(Just (Baz _ _ _)) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@[] = p + foo p@[_] = p + foo p@(_ : _ : _) = p + + data Baz = Baz Nat Nat Nat |] + ======> + maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just ((plus (Succ Zero)) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@(Just _) = x + bar Nothing = Nothing + data Baz = Baz Nat Nat Nat + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@(Just (Baz _ _ _)) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@[] = p + foo p@[_] = p + foo p@(_ : (_ : _)) = p + type BazSym3 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) = + Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BazSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BazSym2KindInference) ()) + data BazSym2 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) :: (~>) Nat Baz + where + BazSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BazSym2 t0123456789876543210 t0123456789876543210) arg) (BazSym3 t0123456789876543210 t0123456789876543210 arg) => + BazSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BazSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BazSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) + data BazSym1 (t0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz) + where + BazSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BazSym1 t0123456789876543210) arg) (BazSym2 t0123456789876543210 arg) => + BazSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BazSym1 t0123456789876543210) t0123456789876543210 = BazSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) + data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) + where + BazSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0 t0123456789876543210 + type instance Apply BazSym0 t0123456789876543210 = BazSym1 t0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = '[] + type Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym0KindInference) ()) + data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[] + type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym2KindInference) ()) + data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym1KindInference) ()) + data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym0KindInference) ()) + data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) + type Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym1KindInference) ()) + data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym0KindInference) ()) + data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = NothingSym0 + type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym2KindInference) ()) + data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym1KindInference) ()) + data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym0KindInference) ()) + data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) + type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210X wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210XSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210XSym0KindInference) ()) + data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => + Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 + type family Let0123456789876543210X wild_0123456789876543210 where + Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = NothingSym0 + type FooSym1 (a0123456789876543210 :: [Nat]) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) [Nat] [Nat] + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type TupSym1 (a0123456789876543210 :: (Nat, Nat)) = + Tup a0123456789876543210 + instance SuppressUnusedWarnings TupSym0 where + suppressUnusedWarnings = snd (((,) TupSym0KindInference) ()) + data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat) + where + TupSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => + TupSym0 a0123456789876543210 + type instance Apply TupSym0 a0123456789876543210 = Tup a0123456789876543210 + type Baz_Sym1 (a0123456789876543210 :: Maybe Baz) = + Baz_ a0123456789876543210 + instance SuppressUnusedWarnings Baz_Sym0 where + suppressUnusedWarnings = snd (((,) Baz_Sym0KindInference) ()) + data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz) + where + Baz_Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => + Baz_Sym0 a0123456789876543210 + type instance Apply Baz_Sym0 a0123456789876543210 = Baz_ a0123456789876543210 + type BarSym1 (a0123456789876543210 :: Maybe Nat) = + Bar a0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat) + where + BarSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 a0123456789876543210 + type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 + type MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) = + MaybePlus a0123456789876543210 + instance SuppressUnusedWarnings MaybePlusSym0 where + suppressUnusedWarnings = snd (((,) MaybePlusSym0KindInference) ()) + data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat) + where + MaybePlusSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => + MaybePlusSym0 a0123456789876543210 + type instance Apply MaybePlusSym0 a0123456789876543210 = MaybePlus a0123456789876543210 + type family Foo (a :: [Nat]) :: [Nat] where + Foo '[] = Let0123456789876543210PSym0 + Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 + Foo ( '(:) wild_0123456789876543210 ( '(:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 + type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where + Tup '(wild_0123456789876543210, + wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 + type family Baz_ (a :: Maybe Baz) :: Maybe Baz where + Baz_ 'Nothing = Let0123456789876543210PSym0 + Baz_ ( 'Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 + type family Bar (a :: Maybe Nat) :: Maybe Nat where + Bar ( 'Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 + Bar 'Nothing = NothingSym0 + type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where + MaybePlus ( 'Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) + MaybePlus 'Nothing = Let0123456789876543210PSym0 + sFoo :: + forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) + sTup :: + forall (t :: (Nat, Nat)). + Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) + sBaz_ :: + forall (t :: Maybe Baz). + Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) + sBar :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) + sMaybePlus :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) + sFoo SNil + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNil + in sP + sFoo + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + SNil) + = let + sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + SNil + in sP + sFoo + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) + = let + sP :: + Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + sWild_0123456789876543210)) + sWild_0123456789876543210) + in sP + sTup + (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + = let + sP :: + Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + sWild_0123456789876543210)) + sWild_0123456789876543210 + in sP + sBaz_ SNothing + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNothing + in sP + sBaz_ + (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) + = let + sP :: + Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) + sP + = (applySing ((singFun1 @JustSym0) SJust)) + ((applySing + ((applySing + ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210)) + sWild_0123456789876543210)) + sWild_0123456789876543210) + in sP + sBar + (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + = let + sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) + sX + = (applySing ((singFun1 @JustSym0) SJust)) + sWild_0123456789876543210 + in sX + sBar SNothing = SNothing + sMaybePlus (SJust (sN :: Sing n)) + = (applySing ((singFun1 @JustSym0) SJust)) + ((applySing + ((applySing ((singFun2 @PlusSym0) sPlus)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sN) + sMaybePlus SNothing + = let + sP :: Sing Let0123456789876543210PSym0 + sP = SNothing + in sP + instance SingI (FooSym0 :: (~>) [Nat] [Nat]) where + sing = (singFun1 @FooSym0) sFoo + instance SingI (TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)) where + sing = (singFun1 @TupSym0) sTup + instance SingI (Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)) where + sing = (singFun1 @Baz_Sym0) sBaz_ + instance SingI (BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where + sing = (singFun1 @BarSym0) sBar + instance SingI (MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where + sing = (singFun1 @MaybePlusSym0) sMaybePlus + data instance Sing :: Baz -> GHC.Types.Type + where + SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat). + (Sing (n :: Nat)) + -> (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> Sing (Baz n n n) + type SBaz = (Sing :: Baz -> GHC.Types.Type) + instance SingKind Baz where + type Demote Baz = Baz + fromSing (SBaz b b b) + = ((Baz (fromSing b)) (fromSing b)) (fromSing b) + toSing (Baz (b :: Demote Nat) (b :: Demote Nat) (b :: Demote Nat)) + = case + (((,,) (toSing b :: SomeSing Nat)) (toSing b :: SomeSing Nat)) + (toSing b :: SomeSing Nat) + of { + (,,) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (((SBaz c) c) c) } + instance (SingI n, SingI n, SingI n) => + SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where + sing = ((SBaz sing) sing) sing + instance SingI (BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where + sing = (singFun3 @BazSym0) SBaz + instance SingI (TyCon3 Baz :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where + sing = (singFun3 @(TyCon3 Baz)) SBaz + instance SingI d => + SingI (BazSym1 (d :: Nat) :: (~>) Nat ((~>) Nat Baz)) where + sing = (singFun2 @(BazSym1 (d :: Nat))) (SBaz (sing @d)) + instance SingI d => + SingI (TyCon2 (Baz (d :: Nat)) :: (~>) Nat ((~>) Nat Baz)) where + sing = (singFun2 @(TyCon2 (Baz (d :: Nat)))) (SBaz (sing @d)) + instance (SingI d, SingI d) => + SingI (BazSym2 (d :: Nat) (d :: Nat) :: (~>) Nat Baz) where + sing + = (singFun1 @(BazSym2 (d :: Nat) (d :: Nat))) + ((SBaz (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon1 (Baz (d :: Nat) (d :: Nat)) :: (~>) Nat Baz) where + sing + = (singFun1 @(TyCon1 (Baz (d :: Nat) (d :: Nat)))) + ((SBaz (sing @d)) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc84.template +++ /dev/null @@ -1,6 +0,0 @@ - -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.ghc86.template b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.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/BadEnumDeriving.ghc84.template b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.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.ghc84.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc84.template +++ /dev/null @@ -1,229 +0,0 @@ -Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Foo1 - = Foo1 - deriving Bounded - data Foo2 - = A | B | C | D | E - deriving Bounded - data Foo3 a - = Foo3 a - deriving Bounded - data Foo4 (a :: Type) (b :: Type) - = Foo41 | Foo42 - deriving Bounded - data Pair - = Pair Bool Bool - deriving Bounded |] - ======> - data Foo1 - = Foo1 - deriving Bounded - data Foo2 - = A | B | C | D | E - deriving Bounded - data Foo3 a - = Foo3 a - deriving Bounded - data Foo4 (a :: Type) (b :: Type) - = Foo41 | Foo42 - deriving Bounded - data Pair - = Pair Bool Bool - deriving Bounded - type Foo1Sym0 = Foo1 - type ASym0 = A - type BSym0 = B - type CSym0 = C - type DSym0 = D - type ESym0 = E - type Foo3Sym1 (t :: a0123456789876543210) = Foo3 t - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 (Foo3 a0123456789876543210)) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3 l - type Foo41Sym0 = Foo41 - type Foo42Sym0 = Foo42 - type PairSym2 (t :: Bool) (t :: Bool) = Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: Bool) (l :: TyFun Bool Pair) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type family MinBound_0123456789876543210 :: Foo1 where - MinBound_0123456789876543210 = Foo1Sym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo1 where - MaxBound_0123456789876543210 = Foo1Sym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Foo1 where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo2 where - MinBound_0123456789876543210 = ASym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo2 where - MaxBound_0123456789876543210 = ESym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Foo2 where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo3 a where - MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo3 a where - MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded (Foo3 a) where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Foo4 a b where - MinBound_0123456789876543210 = Foo41Sym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Foo4 a b where - MaxBound_0123456789876543210 = Foo42Sym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded (Foo4 a b) where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family MinBound_0123456789876543210 :: Pair where - MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: Pair where - MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded Pair where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - data instance Sing (z :: Foo1) where SFoo1 :: Sing Foo1 - type SFoo1 = (Sing :: Foo1 -> Type) - instance SingKind Foo1 where - type Demote Foo1 = Foo1 - fromSing SFoo1 = Foo1 - toSing Foo1 = SomeSing SFoo1 - data instance Sing (z :: Foo2) - where - SA :: Sing A - SB :: Sing B - SC :: Sing C - SD :: Sing D - SE :: Sing E - type SFoo2 = (Sing :: Foo2 -> Type) - instance SingKind Foo2 where - type Demote Foo2 = Foo2 - fromSing SA = A - fromSing SB = B - fromSing SC = C - fromSing SD = D - fromSing SE = E - toSing A = SomeSing SA - toSing B = SomeSing SB - toSing C = SomeSing SC - toSing D = SomeSing SD - toSing E = SomeSing SE - data instance Sing (z :: Foo3 a) - where SFoo3 :: forall (n :: a). (Sing (n :: a)) -> Sing (Foo3 n) - type SFoo3 = (Sing :: Foo3 a -> Type) - instance SingKind a => SingKind (Foo3 a) where - type Demote (Foo3 a) = Foo3 (Demote a) - fromSing (SFoo3 b) = Foo3 (fromSing b) - toSing (Foo3 (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SFoo3 c) } - data instance Sing (z :: Foo4 a b) - where - SFoo41 :: Sing Foo41 - SFoo42 :: Sing Foo42 - type SFoo4 = (Sing :: Foo4 a b -> Type) - instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where - type Demote (Foo4 a b) = Foo4 (Demote a) (Demote b) - fromSing SFoo41 = Foo41 - fromSing SFoo42 = Foo42 - toSing Foo41 = SomeSing SFoo41 - toSing Foo42 = SomeSing SFoo42 - data instance Sing (z :: Pair) - where - SPair :: forall (n :: Bool) (n :: Bool). - (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Pair n n) - type SPair = (Sing :: Pair -> Type) - instance SingKind Pair where - type Demote Pair = Pair - fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) - toSing (Pair (b :: Demote Bool) (b :: Demote Bool)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) - (toSing b :: SomeSing Bool) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } - instance SBounded Foo1 where - sMinBound :: Sing (MinBoundSym0 :: Foo1) - sMaxBound :: Sing (MaxBoundSym0 :: Foo1) - sMinBound = SFoo1 - sMaxBound = SFoo1 - instance SBounded Foo2 where - sMinBound :: Sing (MinBoundSym0 :: Foo2) - sMaxBound :: Sing (MaxBoundSym0 :: Foo2) - sMinBound = SA - sMaxBound = SE - instance SBounded a => SBounded (Foo3 a) where - sMinBound :: Sing (MinBoundSym0 :: Foo3 a) - sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) - sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound - sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound - instance SBounded (Foo4 a b) where - sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) - sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) - sMinBound = SFoo41 - sMaxBound = SFoo42 - instance SBounded Bool => SBounded Pair where - sMinBound :: Sing (MinBoundSym0 :: Pair) - sMaxBound :: Sing (MaxBoundSym0 :: Pair) - sMinBound - = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound)) - sMinBound - sMaxBound - = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound)) - sMaxBound - instance SingI Foo1 where - sing = SFoo1 - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI C where - sing = SC - instance SingI D where - sing = SD - instance SingI E where - sing = SE - instance SingI n => SingI (Foo3 (n :: a)) where - sing = SFoo3 sing - instance SingI Foo41 where - sing = SFoo41 - instance SingI Foo42 where - sing = SFoo42 - instance (SingI n, SingI n) => - SingI (Pair (n :: Bool) (n :: Bool)) where - sing = (SPair sing) sing diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template @@ -0,0 +1,249 @@ +Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo1 + = Foo1 + deriving Bounded + data Foo2 + = A | B | C | D | E + deriving Bounded + data Foo3 a + = Foo3 a + deriving Bounded + data Foo4 (a :: Type) (b :: Type) + = Foo41 | Foo42 + deriving Bounded + data Pair + = Pair Bool Bool + deriving Bounded |] + ======> + data Foo1 + = Foo1 + deriving Bounded + data Foo2 + = A | B | C | D | E + deriving Bounded + data Foo3 a + = Foo3 a + deriving Bounded + data Foo4 (a :: Type) (b :: Type) + = Foo41 | Foo42 + deriving Bounded + data Pair + = Pair Bool Bool + deriving Bounded + type Foo1Sym0 = Foo1 + type ASym0 = A + type BSym0 = B + type CSym0 = C + type DSym0 = D + type ESym0 = E + type Foo3Sym1 (t0123456789876543210 :: a0123456789876543210) = + Foo3 t0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 (Foo3 a0123456789876543210) + where + Foo3Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 t0123456789876543210 + type instance Apply Foo3Sym0 t0123456789876543210 = Foo3 t0123456789876543210 + type Foo41Sym0 = Foo41 + type Foo42Sym0 = Foo42 + type PairSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) + data PairSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Pair + where + PairSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => + PairSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: (~>) Bool ((~>) Bool Pair) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type family MinBound_0123456789876543210 :: Foo1 where + MinBound_0123456789876543210 = Foo1Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo1 where + MaxBound_0123456789876543210 = Foo1Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Foo1 where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo2 where + MinBound_0123456789876543210 = ASym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo2 where + MaxBound_0123456789876543210 = ESym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Foo2 where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo3 a where + MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo3 a where + MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded (Foo3 a) where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Foo4 a b where + MinBound_0123456789876543210 = Foo41Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Foo4 a b where + MaxBound_0123456789876543210 = Foo42Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded (Foo4 a b) where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family MinBound_0123456789876543210 :: Pair where + MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: Pair where + MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded Pair where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + data instance Sing :: Foo1 -> Type where SFoo1 :: Sing Foo1 + type SFoo1 = (Sing :: Foo1 -> Type) + instance SingKind Foo1 where + type Demote Foo1 = Foo1 + fromSing SFoo1 = Foo1 + toSing Foo1 = SomeSing SFoo1 + data instance Sing :: Foo2 -> Type + where + SA :: Sing A + SB :: Sing B + SC :: Sing C + SD :: Sing D + SE :: Sing E + type SFoo2 = (Sing :: Foo2 -> Type) + instance SingKind Foo2 where + type Demote Foo2 = Foo2 + fromSing SA = A + fromSing SB = B + fromSing SC = C + fromSing SD = D + fromSing SE = E + toSing A = SomeSing SA + toSing B = SomeSing SB + toSing C = SomeSing SC + toSing D = SomeSing SD + toSing E = SomeSing SE + data instance Sing :: Foo3 a -> Type + where SFoo3 :: forall a (n :: a). (Sing (n :: a)) -> Sing (Foo3 n) + type SFoo3 = (Sing :: Foo3 a -> Type) + instance SingKind a => SingKind (Foo3 a) where + type Demote (Foo3 a) = Foo3 (Demote a) + fromSing (SFoo3 b) = Foo3 (fromSing b) + toSing (Foo3 (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SFoo3 c) } + data instance Sing :: Foo4 a b -> Type + where + SFoo41 :: Sing Foo41 + SFoo42 :: Sing Foo42 + type SFoo4 = (Sing :: Foo4 a b -> Type) + instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where + type Demote (Foo4 a b) = Foo4 (Demote a) (Demote b) + fromSing SFoo41 = Foo41 + fromSing SFoo42 = Foo42 + toSing Foo41 = SomeSing SFoo41 + toSing Foo42 = SomeSing SFoo42 + data instance Sing :: Pair -> Type + where + SPair :: forall (n :: Bool) (n :: Bool). + (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Pair n n) + type SPair = (Sing :: Pair -> Type) + instance SingKind Pair where + type Demote Pair = Pair + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote Bool) (b :: Demote Bool)) + = case + ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance SBounded Foo1 where + sMinBound :: Sing (MinBoundSym0 :: Foo1) + sMaxBound :: Sing (MaxBoundSym0 :: Foo1) + sMinBound = SFoo1 + sMaxBound = SFoo1 + instance SBounded Foo2 where + sMinBound :: Sing (MinBoundSym0 :: Foo2) + sMaxBound :: Sing (MaxBoundSym0 :: Foo2) + sMinBound = SA + sMaxBound = SE + instance SBounded a => SBounded (Foo3 a) where + sMinBound :: Sing (MinBoundSym0 :: Foo3 a) + sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) + sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound + sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound + instance SBounded (Foo4 a b) where + sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) + sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) + sMinBound = SFoo41 + sMaxBound = SFoo42 + instance SBounded Bool => SBounded Pair where + sMinBound :: Sing (MinBoundSym0 :: Pair) + sMaxBound :: Sing (MaxBoundSym0 :: Pair) + sMinBound + = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound)) + sMinBound + sMaxBound + = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound)) + sMaxBound + instance SingI Foo1 where + sing = SFoo1 + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI C where + sing = SC + instance SingI D where + sing = SD + instance SingI E where + sing = SE + instance SingI n => SingI (Foo3 (n :: a)) where + sing = SFoo3 sing + instance SingI (Foo3Sym0 :: (~>) a (Foo3 a)) where + sing = (singFun1 @Foo3Sym0) SFoo3 + instance SingI (TyCon1 Foo3 :: (~>) a (Foo3 a)) where + sing = (singFun1 @(TyCon1 Foo3)) SFoo3 + instance SingI Foo41 where + sing = SFoo41 + instance SingI Foo42 where + sing = SFoo42 + instance (SingI n, SingI n) => + SingI (Pair (n :: Bool) (n :: Bool)) where + sing = (SPair sing) sing + instance SingI (PairSym0 :: (~>) Bool ((~>) Bool Pair)) where + sing = (singFun2 @PairSym0) SPair + instance SingI (TyCon2 Pair :: (~>) Bool ((~>) Bool Pair)) where + sing = (singFun2 @(TyCon2 Pair)) SPair + instance SingI d => + SingI (PairSym1 (d :: Bool) :: (~>) Bool Pair) where + sing = (singFun1 @(PairSym1 (d :: Bool))) (SPair (sing @d)) + instance SingI d => + SingI (TyCon1 (Pair (d :: Bool)) :: (~>) Bool Pair) where + sing = (singFun1 @(TyCon1 (Pair (d :: Bool)))) (SPair (sing @d)) 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 @@ -2,7 +2,7 @@ import Data.Singletons.Prelude import Data.Singletons.TH -import Data.Kind +import Data.Kind (Type) $(singletons [d| data Foo1 = Foo1 deriving (Bounded) diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/BoxUnBox.ghc84.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) - 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.ghc86.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template @@ -0,0 +1,54 @@ +Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| unBox :: Box a -> a + unBox (FBox a) = a + + data Box a = FBox a |] + ======> + data Box a = FBox a + unBox :: Box a -> a + unBox (FBox a) = a + type FBoxSym1 (t0123456789876543210 :: a0123456789876543210) = + FBox t0123456789876543210 + instance SuppressUnusedWarnings FBoxSym0 where + suppressUnusedWarnings = snd (((,) FBoxSym0KindInference) ()) + data FBoxSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 (Box a0123456789876543210) + where + FBoxSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => + FBoxSym0 t0123456789876543210 + type instance Apply FBoxSym0 t0123456789876543210 = FBox t0123456789876543210 + type UnBoxSym1 (a0123456789876543210 :: Box a0123456789876543210) = + UnBox a0123456789876543210 + instance SuppressUnusedWarnings UnBoxSym0 where + suppressUnusedWarnings = snd (((,) UnBoxSym0KindInference) ()) + data UnBoxSym0 :: forall a0123456789876543210. + (~>) (Box a0123456789876543210) a0123456789876543210 + where + UnBoxSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => + UnBoxSym0 a0123456789876543210 + type instance Apply UnBoxSym0 a0123456789876543210 = UnBox a0123456789876543210 + type family UnBox (a :: Box a) :: a where + UnBox (FBox a) = a + sUnBox :: + forall a (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a) + sUnBox (SFBox (sA :: Sing a)) = sA + instance SingI (UnBoxSym0 :: (~>) (Box a) a) where + sing = (singFun1 @UnBoxSym0) sUnBox + data instance Sing :: Box a -> GHC.Types.Type + where SFBox :: forall a (n :: a). (Sing (n :: a)) -> Sing (FBox n) + type SBox = (Sing :: Box a -> GHC.Types.Type) + instance SingKind a => SingKind (Box a) where + type Demote (Box a) = Box (Demote a) + fromSing (SFBox b) = FBox (fromSing b) + toSing (FBox (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SFBox c) } + instance SingI n => SingI (FBox (n :: a)) where + sing = SFBox sing + instance SingI (FBoxSym0 :: (~>) a (Box a)) where + sing = (singFun1 @FBoxSym0) SFBox + instance SingI (TyCon1 FBox :: (~>) a (Box a)) where + sing = (singFun1 @(TyCon1 FBox)) SFBox 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,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Singletons.BoxUnBox where import Data.Singletons.TH diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/CaseExpressions.ghc84.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 _ = 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.ghc86.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template @@ -0,0 +1,319 @@ +Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = case x of + Just y -> y + Nothing -> d + foo2 :: a -> Maybe a -> a + foo2 d _ = case (Just d) of { Just y -> y } + foo3 :: a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: a -> a + foo5 x = case x of { y -> (\ _ -> x) y } |] + ======> + foo1 :: a -> Maybe a -> a + foo1 d x + = case x of + Just y -> y + Nothing -> d + foo2 :: a -> Maybe a -> a + foo2 d _ = case Just d of { Just y -> y } + foo3 :: a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: a -> a + foo5 x = case x of { y -> (\ _ -> x) y } + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym1KindInference) ()) + data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + where + Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => + Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type family Let0123456789876543210Z x y :: a where + Let0123456789876543210Z x y = y + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y + type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 a b where + Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b + type family Case_0123456789876543210 a b t where + Case_0123456789876543210 a b '(p, _) = p + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall d0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 d where + Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d + type family Case_0123456789876543210 d t where + Case_0123456789876543210 d ( 'Just y) = y + type family Case_0123456789876543210 d x t where + Case_0123456789876543210 d x ( 'Just y) = y + Case_0123456789876543210 d x 'Nothing = d + type Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo5 a0123456789876543210 + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) + data Foo5Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo5Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0 a0123456789876543210 + type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo4 a0123456789876543210 + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) + data Foo4Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0 a0123456789876543210 + type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 + type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo3 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) + data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo3Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => + Foo3Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 a0123456789876543210 + type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) + data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo2Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => + Foo2Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) + data Foo2Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) + where + Foo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0 a0123456789876543210 + type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) + data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo1Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => + Foo1Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + type family Foo5 (a :: a) :: a where + Foo5 x = Case_0123456789876543210 x x + type family Foo4 (a :: a) :: a where + Foo4 x = Case_0123456789876543210 x x + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _ = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Case_0123456789876543210 d x x + sFoo5 :: forall a (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) + sFoo4 :: forall a (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) + sFoo3 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall a (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall a (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo5 (sX :: Sing x) + = (case sX of { + (sY :: Sing y) + -> (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sX }) :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY }) :: + Sing (Case_0123456789876543210 x x :: a) + sFoo4 (sX :: Sing x) + = (case sX of { + (sY :: Sing y) + -> let + sZ :: Sing (Let0123456789876543210ZSym2 x y :: a) + sZ = sY + in sZ }) :: + Sing (Case_0123456789876543210 x x :: a) + sFoo3 (sA :: Sing a) (sB :: Sing b) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB + in (case sScrutinee_0123456789876543210 of { + STuple2 (sP :: Sing p) _ -> sP }) :: + Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) :: a) + sFoo2 (sD :: Sing d) _ + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) + sScrutinee_0123456789876543210 + = (applySing ((singFun1 @JustSym0) SJust)) sD + in (case sScrutinee_0123456789876543210 of { + SJust (sY :: Sing y) -> sY }) :: + Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) :: a) + sFoo1 (sD :: Sing d) (sX :: Sing x) + = (case sX of + SJust (sY :: Sing y) -> sY + SNothing -> sD) :: + Sing (Case_0123456789876543210 d x x :: a) + instance SingI (Foo5Sym0 :: (~>) a a) where + sing = (singFun1 @Foo5Sym0) sFoo5 + instance SingI (Foo4Sym0 :: (~>) a a) where + sing = (singFun1 @Foo4Sym0) sFoo4 + instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo3Sym0) sFoo3 + instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d)) + instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where + sing = (singFun2 @Foo2Sym0) sFoo2 + instance SingI d => + SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where + sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) + instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where + sing = (singFun2 @Foo1Sym0) sFoo1 + instance SingI d => + SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where + sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) 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,4 @@ {-# OPTIONS_GHC -Wno-incomplete-patterns #-} -{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.CaseExpressions where diff --git a/tests/compile-and-dump/Singletons/Classes.ghc84.template b/tests/compile-and-dump/Singletons/Classes.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Classes.ghc84.template +++ /dev/null @@ -1,533 +0,0 @@ -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infix 4 <=> - - const :: a -> b -> a - const x _ = x - fooCompare :: Foo -> Foo -> Ordering - fooCompare A A = EQ - fooCompare A B = LT - fooCompare B B = GT - fooCompare B A = EQ - - class MyOrd a where - mycompare :: a -> a -> Ordering - (<=>) :: a -> a -> Ordering - (<=>) = mycompare - infix 4 <=> - data Foo = A | B - data Foo2 = F | G - - instance MyOrd () where - mycompare _ = const EQ - instance MyOrd Nat where - Zero `mycompare` Zero = EQ - Zero `mycompare` (Succ _) = LT - (Succ _) `mycompare` Zero = GT - (Succ n) `mycompare` (Succ m) = m `mycompare` n - instance MyOrd Foo where - mycompare = fooCompare - instance Eq Foo2 where - F == F = True - G == G = True - F == G = False - G == F = False |] - ======> - const :: a -> b -> a - const x _ = x - class MyOrd a where - mycompare :: a -> a -> Ordering - (<=>) :: a -> a -> Ordering - (<=>) = mycompare - infix 4 <=> - instance MyOrd Nat where - mycompare Zero Zero = EQ - mycompare Zero (Succ _) = LT - mycompare (Succ _) Zero = GT - mycompare (Succ n) (Succ m) = (m `mycompare` n) - instance MyOrd () where - mycompare _ = const EQ - data Foo = A | B - fooCompare :: Foo -> Foo -> Ordering - fooCompare A A = EQ - fooCompare A B = LT - fooCompare B B = GT - fooCompare B A = EQ - instance MyOrd Foo where - mycompare = fooCompare - data Foo2 = F | G - instance Eq Foo2 where - (==) F F = True - (==) G G = True - (==) F G = False - (==) G F = False - type ASym0 = A - type BSym0 = B - type FSym0 = F - type GSym0 = G - type FooCompareSym2 (t :: Foo) (t :: Foo) = FooCompare t t - instance SuppressUnusedWarnings FooCompareSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooCompareSym1KindInference) GHC.Tuple.()) - data FooCompareSym1 (l :: Foo) (l :: TyFun Foo Ordering) - = forall arg. SameKind (Apply (FooCompareSym1 l) arg) (FooCompareSym2 l arg) => - FooCompareSym1KindInference - type instance Apply (FooCompareSym1 l) l = FooCompare l l - instance SuppressUnusedWarnings FooCompareSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooCompareSym0KindInference) GHC.Tuple.()) - data FooCompareSym0 (l :: TyFun Foo (TyFun Foo Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => - FooCompareSym0KindInference - type instance Apply FooCompareSym0 l = FooCompareSym1 l - type ConstSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Const t t - instance SuppressUnusedWarnings ConstSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ConstSym1KindInference) GHC.Tuple.()) - data ConstSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (ConstSym1 l) arg) (ConstSym2 l arg) => - ConstSym1KindInference - type instance Apply (ConstSym1 l) l = Const l l - instance SuppressUnusedWarnings ConstSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ConstSym0KindInference) GHC.Tuple.()) - data ConstSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => - ConstSym0KindInference - type instance Apply ConstSym0 l = ConstSym1 l - type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where - FooCompare A A = EQSym0 - FooCompare A B = LTSym0 - FooCompare B B = GTSym0 - FooCompare B A = EQSym0 - type family Const (a :: a) (a :: b) :: a where - Const x _ = x - type MycompareSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - Mycompare t t - instance SuppressUnusedWarnings MycompareSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MycompareSym1KindInference) GHC.Tuple.()) - data MycompareSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply (MycompareSym1 l) arg) (MycompareSym2 l arg) => - MycompareSym1KindInference - type instance Apply (MycompareSym1 l) l = Mycompare l l - instance SuppressUnusedWarnings MycompareSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MycompareSym0KindInference) GHC.Tuple.()) - data MycompareSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => - MycompareSym0KindInference - type instance Apply MycompareSym0 l = MycompareSym1 l - type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (<=>) t t - instance SuppressUnusedWarnings (<=>@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.()) - data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) => - (:<=>@#@$$###) - type instance Apply ((<=>@#@$$) l) l = (<=>) l l - instance SuppressUnusedWarnings (<=>@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.()) - data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => - (:<=>@#@$###) - type instance Apply (<=>@#@$) l = (<=>@#@$$) l - type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where - TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 - type TFHelper_0123456789876543210Sym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - TFHelper_0123456789876543210 t t - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => - TFHelper_0123456789876543210Sym1KindInference - type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0KindInference - type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l - class PMyOrd (a :: GHC.Types.Type) where - type Mycompare (arg :: a) (arg :: a) :: Ordering - type (<=>) (arg :: a) (arg :: a) :: Ordering - type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Mycompare_0123456789876543210 Zero Zero = EQSym0 - Mycompare_0123456789876543210 Zero (Succ _) = LTSym0 - Mycompare_0123456789876543210 (Succ _) Zero = GTSym0 - Mycompare_0123456789876543210 (Succ n) (Succ m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Nat where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where - Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (t :: ()) (t :: ()) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: ()) (l :: TyFun () Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun () (TyFun () Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd () where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where - Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (t :: Foo) (t :: Foo) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Foo) (l :: TyFun Foo Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo (TyFun Foo Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Foo where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where - TFHelper_0123456789876543210 F F = TrueSym0 - TFHelper_0123456789876543210 G G = TrueSym0 - TFHelper_0123456789876543210 F G = FalseSym0 - TFHelper_0123456789876543210 G F = FalseSym0 - type TFHelper_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - TFHelper_0123456789876543210 t t - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool) - = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) => - TFHelper_0123456789876543210Sym1KindInference - type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data TFHelper_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool - -> GHC.Types.Type)) - = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0KindInference - type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l - instance PEq Foo2 where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - infix 4 %<=> - sFooCompare :: - forall (t :: Foo) (t :: Foo). - Sing t - -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) - sConst :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) - sFooCompare SA SA = SEQ - sFooCompare SA SB = SLT - sFooCompare SB SB = SGT - sFooCompare SB SA = SEQ - sConst (sX :: Sing x) _ = sX - data instance Sing (z :: Foo) - where - SA :: Sing A - SB :: Sing B - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing SA = A - fromSing SB = B - toSing A = SomeSing SA - toSing B = SomeSing SB - data instance Sing (z :: Foo2) - where - SF :: Sing F - SG :: Sing G - type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) - instance SingKind Foo2 where - type Demote Foo2 = Foo2 - fromSing SF = F - fromSing SG = G - toSing F = SomeSing SF - toSing G = SomeSing SG - class SMyOrd a where - sMycompare :: - forall (t :: a) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - (%<=>) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) - default (%<=>) :: - forall (t :: a) (t :: a). - (Apply (Apply (<=>@#@$) t) t :: Ordering) ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t => - Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) - (%<=>) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) - sA_0123456789876543210)) - sA_0123456789876543210 - instance SMyOrd Nat where - sMycompare :: - forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare SZero SZero = SEQ - sMycompare SZero (SSucc _) = SLT - sMycompare (SSucc _) SZero = SGT - sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m)) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) - sN - instance SMyOrd () where - sMycompare :: - forall (t :: ()) (t :: ()). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ)) - sA_0123456789876543210 - instance SMyOrd Foo where - sMycompare :: - forall (t :: Foo) (t :: Foo). - Sing t - -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) - sMycompare - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @FooCompareSym0) sFooCompare)) - sA_0123456789876543210)) - sA_0123456789876543210 - instance SEq Foo2 where - (%==) :: - forall (a :: Foo2) (b :: Foo2). Sing a -> Sing b -> Sing ((==) a b) - (%==) SF SF = STrue - (%==) SG SG = STrue - (%==) SF SG = SFalse - (%==) SG SF = SFalse - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI F where - sing = SF - instance SingI G where - sing = SG -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - promote - [d| instance Ord Foo2 where - F `compare` F = EQ - F `compare` _ = LT - _ `compare` _ = GT - instance MyOrd Foo2 where - F `mycompare` F = EQ - F `mycompare` _ = LT - _ `mycompare` _ = GT |] - ======> - instance MyOrd Foo2 where - mycompare F F = EQ - mycompare F _ = LT - mycompare _ _ = GT - instance Ord Foo2 where - compare F F = EQ - compare F _ = LT - compare _ _ = GT - type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Mycompare_0123456789876543210 F F = EQSym0 - Mycompare_0123456789876543210 F _ = LTSym0 - Mycompare_0123456789876543210 _ _ = GTSym0 - type Mycompare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Foo2 where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Compare_0123456789876543210 F F = EQSym0 - Compare_0123456789876543210 F _ = LTSym0 - Compare_0123456789876543210 _ _ = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Foo2) (t :: Foo2) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Foo2 where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a -Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Nat' = Zero' | Succ' Nat' - - instance MyOrd Nat' where - Zero' `mycompare` Zero' = EQ - Zero' `mycompare` (Succ' _) = LT - (Succ' _) `mycompare` Zero' = GT - (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] - ======> - data Nat' = Zero' | Succ' Nat' - instance MyOrd Nat' where - mycompare Zero' Zero' = EQ - mycompare Zero' (Succ' _) = LT - mycompare (Succ' _) Zero' = GT - mycompare (Succ' n) (Succ' m) = (m `mycompare` n) - type Zero'Sym0 = Zero' - type Succ'Sym1 (t :: Nat') = Succ' t - instance SuppressUnusedWarnings Succ'Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Succ'Sym0KindInference) GHC.Tuple.()) - data Succ'Sym0 (l :: TyFun Nat' Nat') - = forall arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => - Succ'Sym0KindInference - type instance Apply Succ'Sym0 l = Succ' l - type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where - Mycompare_0123456789876543210 Zero' Zero' = EQSym0 - Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0 - Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0 - Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (t :: Nat') (t :: Nat') = - Mycompare_0123456789876543210 t t - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym1 (l :: Nat') (l :: TyFun Nat' Ordering) - = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) => - Mycompare_0123456789876543210Sym1KindInference - type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0KindInference - type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l - instance PMyOrd Nat' where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - data instance Sing (z :: Nat') - where - SZero' :: Sing Zero' - SSucc' :: forall (n :: Nat'). (Sing (n :: Nat')) -> Sing (Succ' n) - type SNat' = (Sing :: Nat' -> GHC.Types.Type) - instance SingKind Nat' where - type Demote Nat' = Nat' - fromSing SZero' = Zero' - fromSing (SSucc' b) = Succ' (fromSing b) - toSing Zero' = SomeSing SZero' - toSing (Succ' (b :: Demote Nat')) - = case toSing b :: SomeSing Nat' of { - SomeSing c -> SomeSing (SSucc' c) } - instance SMyOrd Nat' where - sMycompare :: - forall (t :: Nat') (t :: Nat'). - Sing t - -> Sing t - -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' (TyFun Nat' Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t) t) - sMycompare SZero' SZero' = SEQ - sMycompare SZero' (SSucc' _) = SLT - sMycompare (SSucc' _) SZero' = SGT - sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m)) - = (applySing - ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) - sN - instance SingI Zero' where - sing = SZero' - instance SingI n => SingI (Succ' (n :: Nat')) where - sing = SSucc' sing diff --git a/tests/compile-and-dump/Singletons/Classes.ghc86.template b/tests/compile-and-dump/Singletons/Classes.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes.ghc86.template @@ -0,0 +1,577 @@ +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 <=> + + const :: a -> b -> a + const x _ = x + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + data Foo = A | B + data Foo2 = F | G + + instance MyOrd () where + mycompare _ = const EQ + instance MyOrd Nat where + Zero `mycompare` Zero = EQ + Zero `mycompare` (Succ _) = LT + (Succ _) `mycompare` Zero = GT + (Succ n) `mycompare` (Succ m) = m `mycompare` n + instance MyOrd Foo where + mycompare = fooCompare + instance Eq Foo2 where + F == F = True + G == G = True + F == G = False + G == F = False |] + ======> + const :: a -> b -> a + const x _ = x + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + instance MyOrd Nat where + mycompare Zero Zero = EQ + mycompare Zero (Succ _) = LT + mycompare (Succ _) Zero = GT + mycompare (Succ n) (Succ m) = (m `mycompare` n) + instance MyOrd () where + mycompare _ = const EQ + data Foo = A | B + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + instance MyOrd Foo where + mycompare = fooCompare + data Foo2 = F | G + instance Eq Foo2 where + (==) F F = True + (==) G G = True + (==) F G = False + (==) G F = False + type ASym0 = A + type BSym0 = B + type FSym0 = F + type GSym0 = G + type FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = + FooCompare a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooCompareSym1KindInference) ()) + data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering + where + FooCompareSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) => + FooCompareSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FooCompareSym0 where + suppressUnusedWarnings = snd (((,) FooCompareSym0KindInference) ()) + data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) + where + FooCompareSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => + FooCompareSym0 a0123456789876543210 + type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210 + type ConstSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Const a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ConstSym1KindInference) ()) + data ConstSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + ConstSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) => + ConstSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ConstSym1 a0123456789876543210) a0123456789876543210 = Const a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ConstSym0 where + suppressUnusedWarnings = snd (((,) ConstSym0KindInference) ()) + data ConstSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + ConstSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => + ConstSym0 a0123456789876543210 + type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210 + type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where + FooCompare A A = EQSym0 + FooCompare A B = LTSym0 + FooCompare B B = GTSym0 + FooCompare B A = EQSym0 + type family Const (a :: a) (a :: b) :: a where + Const x _ = x + type MycompareSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + Mycompare arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (MycompareSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) MycompareSym1KindInference) ()) + data MycompareSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + MycompareSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (MycompareSym1 arg0123456789876543210) arg) (MycompareSym2 arg0123456789876543210 arg) => + MycompareSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (MycompareSym1 arg0123456789876543210) arg0123456789876543210 = Mycompare arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings MycompareSym0 where + suppressUnusedWarnings = snd (((,) MycompareSym0KindInference) ()) + data MycompareSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) + where + MycompareSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => + MycompareSym0 arg0123456789876543210 + type instance Apply MycompareSym0 arg0123456789876543210 = MycompareSym1 arg0123456789876543210 + type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<=>) arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) + data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + (:<=>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => + (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$ + instance SuppressUnusedWarnings (<=>@#@$) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) + data (<=>@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) + where + (:<=>@#@$###) :: forall arg0123456789876543210 + arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => + (<=>@#@$) arg0123456789876543210 + type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 + infix 4 <=>@#@$ + type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where + TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + class PMyOrd (a :: GHC.Types.Type) where + type Mycompare (arg :: a) (arg :: a) :: Ordering + type (<=>) (arg :: a) (arg :: a) :: Ordering + type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Mycompare_0123456789876543210 'Zero 'Zero = EQSym0 + Mycompare_0123456789876543210 'Zero ( 'Succ _) = LTSym0 + Mycompare_0123456789876543210 ( 'Succ _) 'Zero = GTSym0 + Mycompare_0123456789876543210 ( 'Succ n) ( 'Succ m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd Nat where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where + Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: ()) :: (~>) () Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd () where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where + Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd Foo where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where + TFHelper_0123456789876543210 F F = TrueSym0 + TFHelper_0123456789876543210 G G = TrueSym0 + TFHelper_0123456789876543210 F G = FalseSym0 + TFHelper_0123456789876543210 G F = FalseSym0 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Bool + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance PEq Foo2 where + type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + infix 4 %<=> + sFooCompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + sConst :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) + sFooCompare SA SA = SEQ + sFooCompare SA SB = SLT + sFooCompare SB SB = SGT + sFooCompare SB SA = SEQ + sConst (sX :: Sing x) _ = sX + instance SingI (FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)) where + sing = (singFun2 @FooCompareSym0) sFooCompare + instance SingI d => + SingI (FooCompareSym1 (d :: Foo) :: (~>) Foo Ordering) where + sing + = (singFun1 @(FooCompareSym1 (d :: Foo))) (sFooCompare (sing @d)) + instance SingI (ConstSym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @ConstSym0) sConst + instance SingI d => SingI (ConstSym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(ConstSym1 (d :: a))) (sConst (sing @d)) + data instance Sing :: Foo -> GHC.Types.Type + where + SA :: Sing A + SB :: Sing B + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SA = A + fromSing SB = B + toSing A = SomeSing SA + toSing B = SomeSing SB + data instance Sing :: Foo2 -> GHC.Types.Type + where + SF :: Sing F + SG :: Sing G + type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) + instance SingKind Foo2 where + type Demote Foo2 = Foo2 + fromSing SF = F + fromSing SG = G + toSing F = SomeSing SF + toSing G = SomeSing SG + class SMyOrd a where + sMycompare :: + forall (t :: a) (t :: a). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + (%<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) + default (%<=>) :: + forall (t :: a) (t :: a). + (Apply (Apply (<=>@#@$) t) t :: Ordering) + ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) + (%<=>) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SMyOrd Nat where + sMycompare :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare SZero SZero = SEQ + sMycompare SZero (SSucc _) = SLT + sMycompare (SSucc _) SZero = SGT + sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SMyOrd () where + sMycompare :: + forall (t :: ()) (t :: ()). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ)) + sA_0123456789876543210 + instance SMyOrd Foo where + sMycompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @FooCompareSym0) sFooCompare)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SEq Foo2 where + (%==) :: + forall (a :: Foo2) (b :: Foo2). Sing a -> Sing b -> Sing ((==) a b) + (%==) SF SF = STrue + (%==) SG SG = STrue + (%==) SF SG = SFalse + (%==) SG SF = SFalse + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI F where + sing = SF + instance SingI G where + sing = SG + instance SMyOrd a => + SingI (MycompareSym0 :: (~>) a ((~>) a Ordering)) where + sing = (singFun2 @MycompareSym0) sMycompare + instance (SMyOrd a, SingI d) => + SingI (MycompareSym1 (d :: a) :: (~>) a Ordering) where + sing = (singFun1 @(MycompareSym1 (d :: a))) (sMycompare (sing @d)) + instance SMyOrd a => + SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where + sing = (singFun2 @(<=>@#@$)) (%<=>) + instance (SMyOrd a, SingI d) => + SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where + sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d)) +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| instance Ord Foo2 where + F `compare` F = EQ + F `compare` _ = LT + _ `compare` _ = GT + instance MyOrd Foo2 where + F `mycompare` F = EQ + F `mycompare` _ = LT + _ `mycompare` _ = GT |] + ======> + instance MyOrd Foo2 where + mycompare F F = EQ + mycompare F _ = LT + mycompare _ _ = GT + instance Ord Foo2 where + compare F F = EQ + compare F _ = LT + compare _ _ = GT + type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where + Mycompare_0123456789876543210 'F 'F = EQSym0 + Mycompare_0123456789876543210 'F _ = LTSym0 + Mycompare_0123456789876543210 _ _ = GTSym0 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd Foo2 where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where + Compare_0123456789876543210 'F 'F = EQSym0 + Compare_0123456789876543210 'F _ = LTSym0 + Compare_0123456789876543210 _ _ = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Foo2 where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat' = Zero' | Succ' Nat' + + instance MyOrd Nat' where + Zero' `mycompare` Zero' = EQ + Zero' `mycompare` (Succ' _) = LT + (Succ' _) `mycompare` Zero' = GT + (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] + ======> + data Nat' = Zero' | Succ' Nat' + instance MyOrd Nat' where + mycompare Zero' Zero' = EQ + mycompare Zero' (Succ' _) = LT + mycompare (Succ' _) Zero' = GT + mycompare (Succ' n) (Succ' m) = (m `mycompare` n) + type Zero'Sym0 = Zero' + type Succ'Sym1 (t0123456789876543210 :: Nat') = + Succ' t0123456789876543210 + instance SuppressUnusedWarnings Succ'Sym0 where + suppressUnusedWarnings = snd (((,) Succ'Sym0KindInference) ()) + data Succ'Sym0 :: (~>) Nat' Nat' + where + Succ'Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => + Succ'Sym0 t0123456789876543210 + type instance Apply Succ'Sym0 t0123456789876543210 = Succ' t0123456789876543210 + type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where + Mycompare_0123456789876543210 Zero' Zero' = EQSym0 + Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0 + Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0 + Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat') :: (~>) Nat' Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd Nat' where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + data instance Sing :: Nat' -> GHC.Types.Type + where + SZero' :: Sing Zero' + SSucc' :: forall (n :: Nat'). (Sing (n :: Nat')) -> Sing (Succ' n) + type SNat' = (Sing :: Nat' -> GHC.Types.Type) + instance SingKind Nat' where + type Demote Nat' = Nat' + fromSing SZero' = Zero' + fromSing (SSucc' b) = Succ' (fromSing b) + toSing Zero' = SomeSing SZero' + toSing (Succ' (b :: Demote Nat')) + = case toSing b :: SomeSing Nat' of { + SomeSing c -> SomeSing (SSucc' c) } + instance SMyOrd Nat' where + sMycompare :: + forall (t :: Nat') (t :: Nat'). + Sing t + -> Sing t + -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' ((~>) Nat' Ordering) + -> GHC.Types.Type) t) t) + sMycompare SZero' SZero' = SEQ + sMycompare SZero' (SSucc' _) = SLT + sMycompare (SSucc' _) SZero' = SGT + sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SingI Zero' where + sing = SZero' + instance SingI n => SingI (Succ' (n :: Nat')) where + sing = SSucc' sing + instance SingI (Succ'Sym0 :: (~>) Nat' Nat') where + sing = (singFun1 @Succ'Sym0) SSucc' + instance SingI (TyCon1 Succ' :: (~>) Nat' Nat') where + sing = (singFun1 @(TyCon1 Succ')) SSucc' diff --git a/tests/compile-and-dump/Singletons/Classes2.ghc84.template b/tests/compile-and-dump/Singletons/Classes2.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Classes2.ghc84.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 _) = 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/Classes2.ghc86.template b/tests/compile-and-dump/Singletons/Classes2.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes2.ghc86.template @@ -0,0 +1,91 @@ +Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data NatFoo = ZeroFoo | SuccFoo NatFoo + + instance MyOrd NatFoo where + ZeroFoo `mycompare` ZeroFoo = EQ + ZeroFoo `mycompare` (SuccFoo _) = LT + (SuccFoo _) `mycompare` ZeroFoo = GT + (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |] + ======> + data NatFoo = ZeroFoo | SuccFoo NatFoo + instance MyOrd NatFoo where + mycompare ZeroFoo ZeroFoo = EQ + mycompare ZeroFoo (SuccFoo _) = LT + mycompare (SuccFoo _) ZeroFoo = GT + mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) + type ZeroFooSym0 = ZeroFoo + type SuccFooSym1 (t0123456789876543210 :: NatFoo) = + SuccFoo t0123456789876543210 + instance SuppressUnusedWarnings SuccFooSym0 where + suppressUnusedWarnings = snd (((,) SuccFooSym0KindInference) ()) + data SuccFooSym0 :: (~>) NatFoo NatFoo + where + SuccFooSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => + SuccFooSym0 t0123456789876543210 + type instance Apply SuccFooSym0 t0123456789876543210 = SuccFoo t0123456789876543210 + type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where + Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0 + Mycompare_0123456789876543210 ZeroFoo (SuccFoo _) = LTSym0 + Mycompare_0123456789876543210 (SuccFoo _) ZeroFoo = GTSym0 + Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) + data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: NatFoo) :: (~>) NatFoo Ordering + where + Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => + Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + instance PMyOrd NatFoo where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + data instance Sing :: NatFoo -> GHC.Types.Type + where + SZeroFoo :: Sing ZeroFoo + SSuccFoo :: forall (n :: NatFoo). + (Sing (n :: NatFoo)) -> Sing (SuccFoo n) + type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type) + instance SingKind NatFoo where + type Demote NatFoo = NatFoo + fromSing SZeroFoo = ZeroFoo + fromSing (SSuccFoo b) = SuccFoo (fromSing b) + toSing ZeroFoo = SomeSing SZeroFoo + toSing (SuccFoo (b :: Demote NatFoo)) + = case toSing b :: SomeSing NatFoo of { + SomeSing c -> SomeSing (SSuccFoo c) } + instance SMyOrd NatFoo where + sMycompare :: + forall (t1 :: NatFoo) (t2 :: NatFoo). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo ((~>) NatFoo Ordering) + -> GHC.Types.Type) t1) t2) + sMycompare SZeroFoo SZeroFoo = SEQ + sMycompare SZeroFoo (SSuccFoo _) = SLT + sMycompare (SSuccFoo _) SZeroFoo = SGT + sMycompare (SSuccFoo (sN :: Sing n)) (SSuccFoo (sM :: Sing m)) + = (applySing + ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) + sN + instance SingI ZeroFoo where + sing = SZeroFoo + instance SingI n => SingI (SuccFoo (n :: NatFoo)) where + sing = SSuccFoo sing + instance SingI (SuccFooSym0 :: (~>) NatFoo NatFoo) where + sing = (singFun1 @SuccFooSym0) SSuccFoo + instance SingI (TyCon1 SuccFoo :: (~>) NatFoo NatFoo) where + sing = (singFun1 @(TyCon1 SuccFoo)) SSuccFoo diff --git a/tests/compile-and-dump/Singletons/Contains.ghc84.template b/tests/compile-and-dump/Singletons/Contains.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Contains.ghc84.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 _ '[] = 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.ghc86.template b/tests/compile-and-dump/Singletons/Contains.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Contains.ghc86.template @@ -0,0 +1,50 @@ +Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| contains :: Eq a => a -> [a] -> Bool + contains _ [] = False + contains elt (h : t) = (elt == h) || (contains elt t) |] + ======> + contains :: Eq a => a -> [a] -> Bool + contains _ [] = False + contains elt (h : t) = ((elt == h) || (contains elt) t) + type ContainsSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = + Contains a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ContainsSym1KindInference) ()) + data ContainsSym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [a0123456789876543210] Bool + where + ContainsSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) => + ContainsSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ContainsSym0 where + suppressUnusedWarnings = snd (((,) ContainsSym0KindInference) ()) + data ContainsSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) [a0123456789876543210] Bool) + where + ContainsSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => + ContainsSym0 a0123456789876543210 + type instance Apply ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210 + type family Contains (a :: a) (a :: [a]) :: Bool where + Contains _ '[] = FalseSym0 + Contains elt ( '(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t) + sContains :: + forall a (t :: a) (t :: [a]). + SEq a => + Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) + sContains _ SNil = SFalse + sContains (sElt :: Sing elt) (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing + ((applySing ((singFun2 @(||@#@$)) (%||))) + ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sElt)) sH))) + ((applySing + ((applySing ((singFun2 @ContainsSym0) sContains)) sElt)) + sT) + instance SEq a => + SingI (ContainsSym0 :: (~>) a ((~>) [a] Bool)) where + sing = (singFun2 @ContainsSym0) sContains + instance (SEq a, SingI d) => + SingI (ContainsSym1 (d :: a) :: (~>) [a] Bool) where + sing = (singFun1 @(ContainsSym1 (d :: a))) (sContains (sing @d)) diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc84.template b/tests/compile-and-dump/Singletons/DataValues.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/DataValues.ghc84.template +++ /dev/null @@ -1,187 +0,0 @@ -Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| pr = Pair (Succ Zero) ([Zero]) - complex = Pair (Pair (Just Zero) Zero) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - - data Pair a b - = Pair a b - deriving Show |] - ======> - data Pair a b - = Pair a b - deriving Show - pr = (Pair (Succ Zero)) [Zero] - complex = (Pair ((Pair (Just Zero)) Zero)) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type AListSym0 = AList - type TupleSym0 = Tuple - type ComplexSym0 = Complex - type PrSym0 = Pr - type family AList where - AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) - type family Tuple where - Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 - type family Complex where - Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 - type family Pr where - Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow (Pair a b) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - sAList :: Sing AListSym0 - sTuple :: Sing TupleSym0 - sComplex :: Sing ComplexSym0 - sPr :: Sing PrSym0 - sAList - = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) - sTuple - = (applySing - ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - STrue - sComplex - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - SZero))) - SFalse - sPr - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) - data instance Sing (z :: Pair a b) - where - SPair :: forall (n :: a) (n :: b). - (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) - type SPair = (Sing :: Pair a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind (Pair a b) where - type Demote (Pair a b) = Pair (Demote a) (Demote b) - fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) - toSing (Pair (b :: Demote a) (b :: Demote b)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } - instance (SShow a, SShow b) => SShow (Pair a b) where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Pair a b) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Pair ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - instance (Data.Singletons.ShowSing.ShowSing a, - Data.Singletons.ShowSing.ShowSing b) => - Data.Singletons.ShowSing.ShowSing (Pair a b) where - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SPair arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SPair ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - (((.) GHC.Show.showSpace) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)))) - instance (Data.Singletons.ShowSing.ShowSing a, - Data.Singletons.ShowSing.ShowSing b) => - Show (Sing (z :: Pair a b)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where - sing = (SPair sing) sing diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc86.template b/tests/compile-and-dump/Singletons/DataValues.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/DataValues.ghc86.template @@ -0,0 +1,186 @@ +Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving Show |] + ======> + data Pair a b + = Pair a b + deriving Show + pr = (Pair (Succ Zero)) [Zero] + complex = (Pair ((Pair (Just Zero)) Zero)) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) + data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + where + PairSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => + PairSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210 + b0123456789876543210. + (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow (Pair a b) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sTuple + = (applySing + ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + STrue + sComplex + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + SZero))) + SFalse + sPr + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) + data instance Sing :: Pair a b -> GHC.Types.Type + where + SPair :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance (SShow a, SShow b) => SShow (Pair a b) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Pair ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + deriving instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Show (Sing (z :: Pair a b)) + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = (SPair sing) sing + instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @PairSym0) SPair + instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @(TyCon2 Pair)) SPair + instance SingI d => + SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where + sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d)) + instance SingI d => + SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where + sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d)) diff --git a/tests/compile-and-dump/Singletons/Empty.ghc84.template b/tests/compile-and-dump/Singletons/Empty.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Empty.ghc84.template +++ /dev/null @@ -1,10 +0,0 @@ -Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations - singletons [d| data Empty |] - ======> - data Empty - data instance Sing (z :: Empty) - type SEmpty = (Sing :: Empty -> GHC.Types.Type) - instance SingKind Empty where - type Demote Empty = Empty - fromSing x = case x of - toSing x = SomeSing (case x of) diff --git a/tests/compile-and-dump/Singletons/Empty.ghc86.template b/tests/compile-and-dump/Singletons/Empty.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Empty.ghc86.template @@ -0,0 +1,10 @@ +Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Empty |] + ======> + data Empty + data instance Sing :: Empty -> GHC.Types.Type + type SEmpty = (Sing :: Empty -> GHC.Types.Type) + instance SingKind Empty where + type Demote Empty = Empty + fromSing x = case x of + toSing x = SomeSing (case x of) diff --git a/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template b/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc84.template +++ /dev/null @@ -1,74 +0,0 @@ -Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Foo - - deriving instance Show Foo |] - ======> - data Foo - deriving instance Show Foo - type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo) (t :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Foo where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data instance Sing (z :: Foo) - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing x = case x of - toSing x = SomeSing (case x of) - instance SShow Foo where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Foo) (t3 :: GHC.Types.Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - (sV_0123456789876543210 :: Sing v_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sV_0123456789876543210 of :: - Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210))) - sA_0123456789876543210 - instance Data.Singletons.ShowSing.ShowSing Foo where - Data.Singletons.ShowSing.showsSingPrec _ v_0123456789876543210 - = case v_0123456789876543210 of - instance Show (Sing (z :: Foo)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec diff --git a/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template b/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template @@ -0,0 +1,68 @@ +Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo + + deriving instance Show Foo |] + ======> + data Foo + deriving instance Show Foo + type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Foo where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + data instance Sing :: Foo -> GHC.Types.Type + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing x = case x of + toSing x = SomeSing (case x of) + instance SShow Foo where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + (sV_0123456789876543210 :: Sing v_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((case sV_0123456789876543210 of) :: + Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210))) + sA_0123456789876543210 + deriving instance Show (Sing (z :: Foo)) diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/EnumDeriving.ghc84.template +++ /dev/null @@ -1,199 +0,0 @@ -Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Foo - = Bar | Baz | Bum - deriving Enum - data Quux = Q1 | Q2 |] - ======> - data Foo - = Bar | Baz | Bum - deriving Enum - data Quux = Q1 | Q2 - type BarSym0 = Bar - type BazSym0 = Baz - type BumSym0 = Bum - type Q1Sym0 = Q1 - type Q2Sym0 = Q2 - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BumSym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BazSym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)) - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = BarSym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Foo) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where - FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0 - FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1 - FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2 - type FromEnum_0123456789876543210Sym1 (t :: Foo) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun Foo GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum Foo where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - data instance Sing (z :: Foo) - where - SBar :: Sing Bar - SBaz :: Sing Baz - SBum :: Sing Bum - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing SBar = Bar - fromSing SBaz = Baz - fromSing SBum = Bum - toSing Bar = SomeSing SBar - toSing Baz = SomeSing SBaz - toSing Bum = SomeSing SBum - data instance Sing (z :: Quux) - where - SQ1 :: Sing Q1 - SQ2 :: Sing Q2 - type SQuux = (Sing :: Quux -> GHC.Types.Type) - instance SingKind Quux where - type Demote Quux = Quux - fromSing SQ1 = Q1 - fromSing SQ2 = Q2 - toSing Q1 = SomeSing SQ1 - toSing Q2 = SomeSing SQ2 - instance SEnum Foo where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Foo - -> GHC.Types.Type) t) - sFromEnum :: - forall (t :: Foo). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Foo GHC.Types.Nat - -> GHC.Types.Type) t) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) - of - STrue -> SBar - SFalse - -> case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) - of - STrue -> SBaz - SFalse - -> case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2)) - of - STrue -> SBum - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2))) :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))) :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) - sFromEnum SBar - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) - sFromEnum SBaz - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) - sFromEnum SBum - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2) - instance SingI Bar where - sing = SBar - instance SingI Baz where - sing = SBaz - instance SingI Bum where - sing = SBum - instance SingI Q1 where - sing = SQ1 - instance SingI Q2 where - sing = SQ2 -Singletons/EnumDeriving.hs:0:0:: Splicing declarations - singEnumInstance ''Quux - ======> - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = Q2Sym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = Q1Sym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Quux) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where - FromEnum_0123456789876543210 Q1 = Data.Singletons.Prelude.Num.FromInteger 0 - FromEnum_0123456789876543210 Q2 = Data.Singletons.Prelude.Num.FromInteger 1 - type FromEnum_0123456789876543210Sym1 (t :: Quux) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun Quux GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum Quux where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - instance SEnum Quux where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Quux - -> GHC.Types.Type) t) - sFromEnum :: - forall (t :: Quux). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Quux GHC.Types.Nat - -> GHC.Types.Type) t) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) - of - STrue -> SQ1 - SFalse - -> case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) - of - STrue -> SQ2 - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))) :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) - sFromEnum SQ1 - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) - sFromEnum SQ2 - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EnumDeriving.ghc86.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 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) + data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Foo + where + ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 + type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where + FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0 + FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1 + FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) = + FromEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) + data FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Types.Nat + where + FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 + instance PEnum Foo where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + data instance Sing :: Foo -> GHC.Types.Type + where + SBar :: Sing Bar + SBaz :: Sing Baz + SBum :: Sing Bum + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SBar = Bar + fromSing SBaz = Baz + fromSing SBum = Bum + toSing Bar = SomeSing SBar + toSing Baz = SomeSing SBaz + toSing Bum = SomeSing SBum + data instance Sing :: Quux -> GHC.Types.Type + where + SQ1 :: Sing Q1 + SQ2 :: Sing Q2 + type SQuux = (Sing :: Quux -> GHC.Types.Type) + instance SingKind Quux where + type Demote Quux = Quux + fromSing SQ1 = Q1 + fromSing SQ2 = Q2 + toSing Q1 = SomeSing SQ1 + toSing Q2 = SomeSing SQ2 + instance SEnum Foo where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Foo + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: Foo). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Foo GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> SBar + SFalse + -> (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) + of + STrue -> SBaz + SFalse + -> (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2)) + of + STrue -> SBum + SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum SBar + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + sFromEnum SBaz + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) + sFromEnum SBum + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2) + instance SingI Bar where + sing = SBar + instance SingI Baz where + sing = SBaz + instance SingI Bum where + sing = SBum + instance SingI Q1 where + sing = SQ1 + instance SingI Q2 where + sing = SQ2 +Singletons/EnumDeriving.hs:0:0:: Splicing declarations + singEnumInstance ''Quux + ======> + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n 'True = Q2Sym0 + Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n 'True = Q1Sym0 + Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) + data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Quux + where + ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 + type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where + FromEnum_0123456789876543210 'Q1 = Data.Singletons.Prelude.Num.FromInteger 0 + FromEnum_0123456789876543210 'Q2 = Data.Singletons.Prelude.Num.FromInteger 1 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) = + FromEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) + data FromEnum_0123456789876543210Sym0 :: (~>) Quux GHC.Types.Nat + where + FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 + instance PEnum Quux where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + instance SEnum Quux where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Quux + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: Quux). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Quux GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> SQ1 + SFalse + -> (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) + of + STrue -> SQ2 + SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum SQ1 + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + sFromEnum SQ2 + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) diff --git a/tests/compile-and-dump/Singletons/EqInstances.ghc84.template b/tests/compile-and-dump/Singletons/EqInstances.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/EqInstances.ghc84.template +++ /dev/null @@ -1,21 +0,0 @@ -Singletons/EqInstances.hs:0:0:: Splicing declarations - singEqInstances [''Foo, ''Empty] - ======> - instance SEq Foo => SEq Foo where - (%==) SFLeaf SFLeaf = STrue - (%==) SFLeaf ((:%+:) _ _) = SFalse - (%==) ((:%+:) _ _) SFLeaf = SFalse - (%==) ((:%+:) a a) ((:%+:) b b) - = ((%&&) (((%==) a) b)) (((%==) a) b) - type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where - Equals_0123456789876543210 FLeaf FLeaf = TrueSym0 - Equals_0123456789876543210 ((:+:) a a) ((:+:) b b) = (&&) ((==) a b) ((==) a b) - Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 - instance PEq Foo where - type (==) a b = Equals_0123456789876543210 a b - instance SEq Empty where - (%==) _ _ = STrue - type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where - Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 - instance PEq Empty where - type (==) a b = Equals_0123456789876543210 a b diff --git a/tests/compile-and-dump/Singletons/EqInstances.ghc86.template b/tests/compile-and-dump/Singletons/EqInstances.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EqInstances.ghc86.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.ghc84.template b/tests/compile-and-dump/Singletons/Error.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Error.ghc84.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 _) = 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.ghc86.template b/tests/compile-and-dump/Singletons/Error.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Error.ghc86.template @@ -0,0 +1,30 @@ +Singletons/Error.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| head :: [a] -> a + head (a : _) = a + head [] = error "Data.Singletons.List.head: empty list" |] + ======> + head :: [a] -> a + head (a : _) = a + head [] = error "Data.Singletons.List.head: empty list" + type HeadSym1 (a0123456789876543210 :: [a0123456789876543210]) = + Head a0123456789876543210 + instance SuppressUnusedWarnings HeadSym0 where + suppressUnusedWarnings = snd (((,) HeadSym0KindInference) ()) + data HeadSym0 :: forall a0123456789876543210. + (~>) [a0123456789876543210] a0123456789876543210 + where + HeadSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => + HeadSym0 a0123456789876543210 + type instance Apply HeadSym0 a0123456789876543210 = Head a0123456789876543210 + type family Head (a :: [a]) :: a where + Head ( '(:) a _) = a + Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" + sHead :: + forall a (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) + sHead (SCons (sA :: Sing a) _) = sA + sHead SNil + = sError (sing :: Sing "Data.Singletons.List.head: empty list") + instance SingI (HeadSym0 :: (~>) [a] a) where + sing = (singFun1 @HeadSym0) sHead diff --git a/tests/compile-and-dump/Singletons/Error.hs b/tests/compile-and-dump/Singletons/Error.hs --- a/tests/compile-and-dump/Singletons/Error.hs +++ b/tests/compile-and-dump/Singletons/Error.hs @@ -1,7 +1,7 @@ module Singletons.Error where import Data.Singletons -import Data.Singletons.Prelude hiding (Head, HeadSym0, HeadSym1) +import Data.Singletons.Prelude hiding (Head, HeadSym0, HeadSym1, sHead) import Data.Singletons.TH $(singletons [d| diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc84.template b/tests/compile-and-dump/Singletons/Fixity.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Fixity.ghc84.template +++ /dev/null @@ -1,66 +0,0 @@ -Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infix 4 ==== - infix 4 <=> - - (====) :: a -> a -> a - a ==== _ = a - - class MyOrd a where - (<=>) :: a -> a -> Ordering - infix 4 <=> |] - ======> - class MyOrd a where - (<=>) :: a -> a -> Ordering - infix 4 <=> - (====) :: a -> a -> a - (====) a _ = a - infix 4 ==== - type (====@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (====) t t - instance SuppressUnusedWarnings (====@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:====@#@$$###)) GHC.Tuple.()) - data (====@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply ((====@#@$$) l) arg) ((====@#@$$$) l arg) => - (:====@#@$$###) - type instance Apply ((====@#@$$) l) l = (====) l l - instance SuppressUnusedWarnings (====@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:====@#@$###)) GHC.Tuple.()) - data (====@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) => - (:====@#@$###) - type instance Apply (====@#@$) l = (====@#@$$) l - type family (====) (a :: a) (a :: a) :: a where - (====) a _ = a - type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (<=>) t t - instance SuppressUnusedWarnings (<=>@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.()) - data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering) - = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) => - (:<=>@#@$$###) - type instance Apply ((<=>@#@$$) l) l = (<=>) l l - instance SuppressUnusedWarnings (<=>@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.()) - data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => - (:<=>@#@$###) - type instance Apply (<=>@#@$) l = (<=>@#@$$) l - class PMyOrd (a :: GHC.Types.Type) where - type (<=>) (arg :: a) (arg :: a) :: Ordering - infix 4 %==== - infix 4 %<=> - (%====) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a) - (%====) (sA :: Sing a) _ = sA - class SMyOrd a where - (%<=>) :: - forall (t :: a) (t :: a). - Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc86.template b/tests/compile-and-dump/Singletons/Fixity.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Fixity.ghc86.template @@ -0,0 +1,86 @@ +Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 ==== + infix 4 <=> + + (====) :: a -> a -> a + a ==== _ = a + + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> |] + ======> + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> + (====) :: a -> a -> a + (====) a _ = a + infix 4 ==== + type (====@#@$$$) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + (====) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:====@#@$$###)) ()) + data (====@#@$$) (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 + where + (:====@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) => + (====@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210 + infix 4 ====@#@$$ + instance SuppressUnusedWarnings (====@#@$) where + suppressUnusedWarnings = snd (((,) (:====@#@$###)) ()) + data (====@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) + where + (:====@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) => + (====@#@$) a0123456789876543210 + type instance Apply (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210 + infix 4 ====@#@$ + type family (====) (a :: a) (a :: a) :: a where + (====) a _ = a + type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<=>) arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) + data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + (:<=>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => + (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$ + instance SuppressUnusedWarnings (<=>@#@$) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) + data (<=>@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) + where + (:<=>@#@$###) :: forall arg0123456789876543210 + arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => + (<=>@#@$) arg0123456789876543210 + type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 + infix 4 <=>@#@$ + class PMyOrd (a :: GHC.Types.Type) where + type (<=>) (arg :: a) (arg :: a) :: Ordering + infix 4 %==== + infix 4 %<=> + (%====) :: + forall a (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a) + (%====) (sA :: Sing a) _ = sA + instance SingI ((====@#@$) :: (~>) a ((~>) a a)) where + sing = (singFun2 @(====@#@$)) (%====) + instance SingI d => SingI ((====@#@$$) (d :: a) :: (~>) a a) where + sing = (singFun1 @((====@#@$$) (d :: a))) ((%====) (sing @d)) + class SMyOrd a where + (%<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) + instance SMyOrd a => + SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where + sing = (singFun2 @(<=>@#@$)) (%<=>) + instance (SMyOrd a, SingI d) => + SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where + sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/FunDeps.ghc84.template b/tests/compile-and-dump/Singletons/FunDeps.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/FunDeps.ghc84.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 - 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/FunDeps.ghc86.template b/tests/compile-and-dump/Singletons/FunDeps.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/FunDeps.ghc86.template @@ -0,0 +1,96 @@ +Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| t1 = meth True + + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 |] + ======> + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 + t1 = meth True + type T1Sym0 = T1 + type family T1 where + T1 = Apply MethSym0 TrueSym0 + type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = + Meth arg0123456789876543210 + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) + data MethSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + MethSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => + MethSym0 arg0123456789876543210 + type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210 + type L2rSym1 (arg0123456789876543210 :: a0123456789876543210) = + L2r arg0123456789876543210 + instance SuppressUnusedWarnings L2rSym0 where + suppressUnusedWarnings = snd (((,) L2rSym0KindInference) ()) + data L2rSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 b0123456789876543210 + where + L2rSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => + L2rSym0 arg0123456789876543210 + type instance Apply L2rSym0 arg0123456789876543210 = L2r arg0123456789876543210 + class PFD (a :: GHC.Types.Type) (b :: GHC.Types.Type) | a -> b where + type Meth (arg :: a) :: a + type L2r (arg :: a) :: b + type family Meth_0123456789876543210 (a :: Bool) :: Bool where + Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 + type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + Meth_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) + data Meth_0123456789876543210Sym0 :: (~>) Bool Bool + where + Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => + Meth_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 + type family L2r_0123456789876543210 (a :: Bool) :: Nat where + L2r_0123456789876543210 'False = FromInteger 0 + L2r_0123456789876543210 'True = FromInteger 1 + type L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + L2r_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) L2r_0123456789876543210Sym0KindInference) ()) + data L2r_0123456789876543210Sym0 :: (~>) Bool Nat + where + L2r_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => + L2r_0123456789876543210Sym0 a0123456789876543210 + type instance Apply L2r_0123456789876543210Sym0 a0123456789876543210 = L2r_0123456789876543210 a0123456789876543210 + instance PFD Bool Nat where + type Meth a = Apply Meth_0123456789876543210Sym0 a + type L2r a = Apply L2r_0123456789876543210Sym0 a + sT1 :: Sing T1Sym0 + sT1 = (applySing ((singFun1 @MethSym0) sMeth)) STrue + class SFD a b | a -> b where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) + sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) + instance SFD Bool Nat where + sMeth :: + forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool) + sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat) + sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 + sL2r SFalse = sFromInteger (sing :: Sing 0) + sL2r STrue = sFromInteger (sing :: Sing 1) + instance SFD a b => SingI (MethSym0 :: (~>) a a) where + sing = (singFun1 @MethSym0) sMeth + instance SFD a b => SingI (L2rSym0 :: (~>) a b) where + sing = (singFun1 @L2rSym0) sL2r diff --git a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template @@ -0,0 +1,1646 @@ +Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data T x a + = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) + deriving (Functor, Foldable, Traversable) + data Empty (a :: Type) deriving (Functor, Foldable, Traversable) |] + ======> + data T x a + = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) + deriving (Functor, Foldable, Traversable) + data Empty (a :: Type) deriving (Functor, Foldable, Traversable) + type MkT1Sym4 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) (t0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkT1Sym3KindInference) ()) + data MkT1Sym3 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210) + where + MkT1Sym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkT1Sym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkT1Sym2KindInference) ()) + data MkT1Sym2 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)) + where + MkT1Sym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym3 t0123456789876543210 t0123456789876543210 arg) => + MkT1Sym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkT1Sym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkT1Sym1KindInference) ()) + data MkT1Sym1 (t0123456789876543210 :: x0123456789876543210) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))) + where + MkT1Sym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkT1Sym1 t0123456789876543210) arg) (MkT1Sym2 t0123456789876543210 arg) => + MkT1Sym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkT1Sym0 where + suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ()) + data MkT1Sym0 :: forall a0123456789876543210 x0123456789876543210. + (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))) + where + MkT1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => + MkT1Sym0 t0123456789876543210 + type instance Apply MkT1Sym0 t0123456789876543210 = MkT1Sym1 t0123456789876543210 + type MkT2Sym1 (t0123456789876543210 :: Maybe x0123456789876543210) = + MkT2 t0123456789876543210 + instance SuppressUnusedWarnings MkT2Sym0 where + suppressUnusedWarnings = snd (((,) MkT2Sym0KindInference) ()) + data MkT2Sym0 :: forall a0123456789876543210 x0123456789876543210. + (~>) (Maybe x0123456789876543210) (T x0123456789876543210 a0123456789876543210) + where + MkT2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) => + MkT2Sym0 t0123456789876543210 + type instance Apply MkT2Sym0 t0123456789876543210 = MkT2 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 + type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 + type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: T x a) :: T x b where + Fmap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply FmapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply FmapSym0 _f_0123456789876543210)) a_0123456789876543210) + Fmap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) + type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = + Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) + data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210) + where + Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => + Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) + data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210)) + where + Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => + Fmap_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 + type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 + type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210 + type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 + type Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 + type family TFHelper_0123456789876543210 (a :: a) (a :: T x b) :: T x a where + TFHelper_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (<$@#@$) _z_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply (<$@#@$) _z_0123456789876543210)) a_0123456789876543210) + TFHelper_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + x0123456789876543210. + (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210. + (~>) a0123456789876543210 ((~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210)) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance PFunctor (T x) where + type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a + type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 + type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 + type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: T x a) :: m where + FoldMap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply MappendSym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply (Apply FoldMapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FoldMapSym0 (Apply FoldMapSym0 _f_0123456789876543210)) a_0123456789876543210))) + FoldMap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210 + type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = + FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) + data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210 + where + FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => + FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) + data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210 + m0123456789876543210 + x0123456789876543210. + (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210) + where + FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => + FoldMap_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 + type Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym9KindInference) ()) + data Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym9KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym8KindInference) ()) + data Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym8KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + n1_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 + type Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + type family Foldr_0123456789876543210 (a :: (~>) a ((~>) b b)) (a :: b) (a :: T x a) :: b where + Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply _f_0123456789876543210 a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210))) + Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210 + type Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = + Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Foldr_0123456789876543210Sym2KindInference) ()) + data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210 + where + Foldr_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Foldr_0123456789876543210Sym1KindInference) ()) + data Foldr_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210. + (~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210) + where + Foldr_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) arg) (Foldr_0123456789876543210Sym2 a0123456789876543210 arg) => + Foldr_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Foldr_0123456789876543210Sym0KindInference) ()) + data Foldr_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210. + (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) ((~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210)) + where + Foldr_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) => + Foldr_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210 + instance PFoldable (T x) where + type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a + type Foldr a a a = Apply (Apply (Apply Foldr_0123456789876543210Sym0 a) a) a + type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: T x a) :: f (T x b) where + Traverse_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (<*>@#@$) (Apply (Apply (<*>@#@$) (Apply (Apply (Apply LiftA2Sym0 MkT1Sym0) (Apply PureSym0 a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210))) (Apply (Apply TraverseSym0 _f_0123456789876543210) a_0123456789876543210))) (Apply (Apply TraverseSym0 (Apply TraverseSym0 _f_0123456789876543210)) a_0123456789876543210) + Traverse_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply FmapSym0 MkT2Sym0) (Apply PureSym0 a_0123456789876543210) + type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = + Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) + data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210)) + where + Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => + Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) + data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + f0123456789876543210 + x0123456789876543210. + (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210))) + where + Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => + Traverse_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 + instance PTraversable (T x) where + type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a + type family Case_0123456789876543210 v_0123456789876543210 t where + type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: Empty a) :: Empty b where + Fmap_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 + type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) = + Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) + data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Empty a0123456789876543210) (Empty b0123456789876543210) + where + Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => + Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) + data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Empty a0123456789876543210) (Empty b0123456789876543210)) + where + Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => + Fmap_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 + type family Case_0123456789876543210 v_0123456789876543210 t where + type family TFHelper_0123456789876543210 (a :: a) (a :: Empty b) :: Empty a where + TFHelper_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Empty b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) (Empty b0123456789876543210) (Empty a0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) (Empty b0123456789876543210) (Empty a0123456789876543210)) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance PFunctor Empty where + type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a + type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: Empty a) :: m where + FoldMap_0123456789876543210 _ _ = MemptySym0 + type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) = + FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) + data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: (~>) (Empty a0123456789876543210) m0123456789876543210 + where + FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => + FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) + data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210 + m0123456789876543210. + (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (Empty a0123456789876543210) m0123456789876543210) + where + FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => + FoldMap_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 + instance PFoldable Empty where + type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a + type family Case_0123456789876543210 v_0123456789876543210 t where + type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: Empty a) :: f (Empty b) where + Traverse_0123456789876543210 _ v_0123456789876543210 = Apply PureSym0 (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) + type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: Empty a0123456789876543210) = + Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) + data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: (~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210)) + where + Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => + Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) + data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + f0123456789876543210. + (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210))) + where + Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => + Traverse_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 + instance PTraversable Empty where + type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a + data instance Sing :: T x a -> Type + where + SMkT1 :: forall x + a + (n :: x) + (n :: a) + (n :: Maybe a) + (n :: Maybe (Maybe a)). + (Sing (n :: x)) + -> (Sing (n :: a)) + -> (Sing (n :: Maybe a)) + -> (Sing (n :: Maybe (Maybe a))) -> Sing (MkT1 n n n n) + SMkT2 :: forall x (n :: Maybe x). + (Sing (n :: Maybe x)) -> Sing (MkT2 n) + type ST = (Sing :: T x a -> Type) + instance (SingKind x, SingKind a) => SingKind (T x a) where + type Demote (T x a) = T (Demote x) (Demote a) + fromSing (SMkT1 b b b b) + = (((MkT1 (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SMkT2 b) = MkT2 (fromSing b) + toSing + (MkT1 (b :: Demote x) + (b :: Demote a) + (b :: Demote (Maybe a)) + (b :: Demote (Maybe (Maybe a)))) + = case + ((((,,,) (toSing b :: SomeSing x)) (toSing b :: SomeSing a)) + (toSing b :: SomeSing (Maybe a))) + (toSing b :: SomeSing (Maybe (Maybe a))) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SMkT1 c) c) c) c) } + toSing (MkT2 (b :: Demote (Maybe x))) + = case toSing b :: SomeSing (Maybe x) of { + SomeSing c -> SomeSing (SMkT2 c) } + data instance Sing :: Empty a -> Type + type SEmpty = (Sing :: Empty a -> Type) + instance SingKind a => SingKind (Empty a) where + type Demote (Empty a) = Empty (Demote a) + fromSing x = case x of + toSing x = SomeSing (case x of) + instance SFunctor (T x) where + sFmap :: + forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: T x a). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (T x a) (T x b)) + -> Type) t1) t2) + (%<$) :: + forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: T x b). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (T x b) (T x a)) + -> Type) t1) t2) + sFmap + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing + ((applySing + ((applySing ((singFun4 @MkT1Sym0) SMkT1)) + ((applySing + ((singFun1 + @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) + -> sN_0123456789876543210 }))) + sA_0123456789876543210))) + ((applySing _sf_0123456789876543210) sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @FmapSym0) sFmap)) _sf_0123456789876543210)) + sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @FmapSym0) sFmap)) + ((applySing ((singFun2 @FmapSym0) sFmap)) + _sf_0123456789876543210))) + sA_0123456789876543210) + sFmap + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing ((singFun1 @MkT2Sym0) SMkT2)) + ((applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) + sA_0123456789876543210) + (%<$) + (_sz_0123456789876543210 :: Sing _z_0123456789876543210) + (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing + ((applySing + ((applySing ((singFun4 @MkT1Sym0) SMkT1)) + ((applySing + ((singFun1 + @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) + -> sN_0123456789876543210 }))) + sA_0123456789876543210))) + ((applySing + ((singFun1 + @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) -> _sz_0123456789876543210 }))) + sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(<$@#@$)) (%<$))) _sz_0123456789876543210)) + sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @FmapSym0) sFmap)) + ((applySing ((singFun2 @(<$@#@$)) (%<$))) + _sz_0123456789876543210))) + sA_0123456789876543210) + (%<$) + (_sz_0123456789876543210 :: Sing _z_0123456789876543210) + (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing ((singFun1 @MkT2Sym0) SMkT2)) + ((applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) + sA_0123456789876543210) + instance SFoldable (T x) where + sFoldMap :: + forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: T x a). + SMonoid m => + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (T x a) m) + -> Type) t1) t2) + sFoldr :: + forall (a :: Type) + (b :: Type) + (t1 :: (~>) a ((~>) b b)) + (t2 :: b) + (t3 :: T x a). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (FoldrSym0 :: TyFun ((~>) a ((~>) b b)) ((~>) b ((~>) (T x a) b)) + -> Type) t1) t2) t3) + sFoldMap + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing ((singFun2 @MappendSym0) sMappend)) + ((applySing + ((singFun1 + @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) -> sMempty }))) + sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @MappendSym0) sMappend)) + ((applySing _sf_0123456789876543210) sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @MappendSym0) sMappend)) + ((applySing + ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) + _sf_0123456789876543210)) + sA_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) + ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) + _sf_0123456789876543210))) + sA_0123456789876543210))) + sFoldMap + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210)) + (\ sN_0123456789876543210 + -> case sN_0123456789876543210 of { + (_ :: Sing n_0123456789876543210) -> sMempty }))) + sA_0123456789876543210 + sFoldr + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (_sz_0123456789876543210 :: Sing _z_0123456789876543210) + (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN1_0123456789876543210 sN2_0123456789876543210 + -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { + (,) (_ :: Sing n1_0123456789876543210) + (_ :: Sing n2_0123456789876543210) + -> sN2_0123456789876543210 }))) + sA_0123456789876543210)) + ((applySing + ((applySing _sf_0123456789876543210) sA_0123456789876543210)) + ((applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN1_0123456789876543210 sN2_0123456789876543210 + -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { + (,) (_ :: Sing n1_0123456789876543210) + (_ :: Sing n2_0123456789876543210) + -> (applySing + ((applySing + ((applySing ((singFun3 @FoldrSym0) sFoldr)) + _sf_0123456789876543210)) + sN2_0123456789876543210)) + sN1_0123456789876543210 }))) + sA_0123456789876543210)) + ((applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN1_0123456789876543210 sN2_0123456789876543210 + -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { + (,) (_ :: Sing n1_0123456789876543210) + (_ :: Sing n2_0123456789876543210) + -> (applySing + ((applySing + ((applySing ((singFun3 @FoldrSym0) sFoldr)) + ((singFun2 + @(Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + (\ sN1_0123456789876543210 + sN2_0123456789876543210 + -> case + ((,) sN1_0123456789876543210) + sN2_0123456789876543210 + of { + (,) (_ :: Sing n1_0123456789876543210) + (_ :: Sing n2_0123456789876543210) + -> (applySing + ((applySing + ((applySing + ((singFun3 + @FoldrSym0) + sFoldr)) + _sf_0123456789876543210)) + sN2_0123456789876543210)) + sN1_0123456789876543210 })))) + sN2_0123456789876543210)) + sN1_0123456789876543210 }))) + sA_0123456789876543210)) + _sz_0123456789876543210))) + sFoldr + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (_sz_0123456789876543210 :: Sing _z_0123456789876543210) + (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210)) + (\ sN1_0123456789876543210 sN2_0123456789876543210 + -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { + (,) (_ :: Sing n1_0123456789876543210) + (_ :: Sing n2_0123456789876543210) + -> sN2_0123456789876543210 }))) + sA_0123456789876543210)) + _sz_0123456789876543210 + instance STraversable (T x) where + sTraverse :: + forall (f :: Type -> Type) + (a :: Type) + (b :: Type) + (t1 :: (~>) a (f b)) + (t2 :: T x a). + SApplicative f => + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (T x a) (f (T x b))) + -> Type) t1) t2) + sTraverse + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing ((singFun2 @(<*>@#@$)) (%<*>))) + ((applySing + ((applySing ((singFun2 @(<*>@#@$)) (%<*>))) + ((applySing + ((applySing + ((applySing ((singFun3 @LiftA2Sym0) sLiftA2)) + ((singFun4 @MkT1Sym0) SMkT1))) + ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210))) + ((applySing _sf_0123456789876543210) sA_0123456789876543210)))) + ((applySing + ((applySing ((singFun2 @TraverseSym0) sTraverse)) + _sf_0123456789876543210)) + sA_0123456789876543210)))) + ((applySing + ((applySing ((singFun2 @TraverseSym0) sTraverse)) + ((applySing ((singFun2 @TraverseSym0) sTraverse)) + _sf_0123456789876543210))) + sA_0123456789876543210) + sTraverse + (_sf_0123456789876543210 :: Sing _f_0123456789876543210) + (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) + = (applySing + ((applySing ((singFun2 @FmapSym0) sFmap)) + ((singFun1 @MkT2Sym0) SMkT2))) + ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210) + instance SFunctor Empty where + sFmap :: + forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: Empty a). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (Empty a) (Empty b)) + -> Type) t1) t2) + (%<$) :: + forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: Empty b). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (Empty b) (Empty a)) + -> Type) t1) t2) + sFmap _ (sV_0123456789876543210 :: Sing v_0123456789876543210) + = (case sV_0123456789876543210 of) :: + Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) + (%<$) _ (sV_0123456789876543210 :: Sing v_0123456789876543210) + = (case sV_0123456789876543210 of) :: + Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) + instance SFoldable Empty where + sFoldMap :: + forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: Empty a). + SMonoid m => + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (Empty a) m) + -> Type) t1) t2) + sFoldMap _ _ = sMempty + instance STraversable Empty where + sTraverse :: + forall (f :: Type -> Type) + (a :: Type) + (b :: Type) + (t1 :: (~>) a (f b)) + (t2 :: Empty a). + SApplicative f => + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (Empty a) (f (Empty b))) + -> Type) t1) t2) + sTraverse _ (sV_0123456789876543210 :: Sing v_0123456789876543210) + = (applySing ((singFun1 @PureSym0) sPure)) + ((case sV_0123456789876543210 of) :: + Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (MkT1 (n :: x) (n :: a) (n :: Maybe a) (n :: Maybe (Maybe a))) where + sing = (((SMkT1 sing) sing) sing) sing + instance SingI (MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where + sing = (singFun4 @MkT1Sym0) SMkT1 + instance SingI (TyCon4 MkT1 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where + sing = (singFun4 @(TyCon4 MkT1)) SMkT1 + instance SingI d => + SingI (MkT1Sym1 (d :: x) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where + sing = (singFun3 @(MkT1Sym1 (d :: x))) (SMkT1 (sing @d)) + instance SingI d => + SingI (TyCon3 (MkT1 (d :: x)) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where + sing = (singFun3 @(TyCon3 (MkT1 (d :: x)))) (SMkT1 (sing @d)) + instance (SingI d, SingI d) => + SingI (MkT1Sym2 (d :: x) (d :: a) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where + sing + = (singFun2 @(MkT1Sym2 (d :: x) (d :: a))) + ((SMkT1 (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (MkT1 (d :: x) (d :: a)) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where + sing + = (singFun2 @(TyCon2 (MkT1 (d :: x) (d :: a)))) + ((SMkT1 (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a) :: (~>) (Maybe (Maybe a)) (T x a)) where + sing + = (singFun1 @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a))) + (((SMkT1 (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a)) :: (~>) (Maybe (Maybe a)) (T x a)) where + sing + = (singFun1 @(TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a)))) + (((SMkT1 (sing @d)) (sing @d)) (sing @d)) + instance SingI n => SingI (MkT2 (n :: Maybe x)) where + sing = SMkT2 sing + instance SingI (MkT2Sym0 :: (~>) (Maybe x) (T x a)) where + sing = (singFun1 @MkT2Sym0) SMkT2 + instance SingI (TyCon1 MkT2 :: (~>) (Maybe x) (T x a)) where + sing = (singFun1 @(TyCon1 MkT2)) SMkT2 diff --git a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveTraversable #-} +-- Ensure that we can derive Functor, Foldable, and Traversable using only +-- an import of Data.Singletons.TH +module FunctorLikeDeriving where + +import Data.Kind +import Data.Singletons.TH + +$(singletons [d| + data T x a + = MkT1 x a (Maybe a) (Maybe (Maybe a)) + | MkT2 (Maybe x) + deriving (Functor, Foldable, Traversable) + + data Empty (a :: Type) + deriving (Functor, Foldable, Traversable) + |]) diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/HigherOrder.ghc84.template +++ /dev/null @@ -1,424 +0,0 @@ -Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| map :: (a -> b) -> [a] -> [b] - map _ [] = [] - map f (h : t) = (f h) : (map f t) - liftMaybe :: (a -> b) -> Maybe a -> Maybe b - liftMaybe f (Just x) = Just (f x) - liftMaybe _ Nothing = Nothing - zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys - zipWith _ [] [] = [] - zipWith _ (_ : _) [] = [] - zipWith _ [] (_ : _) = [] - foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b - foo f g a = f g a - splunge :: [Nat] -> [Bool] -> [Nat] - splunge ns bs - = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs - etad :: [Nat] -> [Bool] -> [Nat] - etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - - data Either a b = Left a | Right b |] - ======> - data Either a b = Left a | Right b - map :: (a -> b) -> [a] -> [b] - map _ GHC.Types.[] = [] - map f (h GHC.Types.: t) = ((f h) GHC.Types.: ((map f) t)) - liftMaybe :: (a -> b) -> Maybe a -> Maybe b - liftMaybe f (Just x) = Just (f x) - liftMaybe _ Nothing = Nothing - zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] - zipWith f (x GHC.Types.: xs) (y GHC.Types.: ys) - = (((f x) y) GHC.Types.: (((zipWith f) xs) ys)) - zipWith _ GHC.Types.[] GHC.Types.[] = [] - zipWith _ (_ GHC.Types.: _) GHC.Types.[] = [] - zipWith _ GHC.Types.[] (_ GHC.Types.: _) = [] - foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b - foo f g a = (f g) a - splunge :: [Nat] -> [Bool] -> [Nat] - splunge ns bs - = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs - etad :: [Nat] -> [Bool] -> [Nat] - etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - type LeftSym1 (t :: a0123456789876543210) = Left t - instance SuppressUnusedWarnings LeftSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LeftSym0KindInference) GHC.Tuple.()) - data LeftSym0 (l :: TyFun a0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => - LeftSym0KindInference - type instance Apply LeftSym0 l = Left l - type RightSym1 (t :: b0123456789876543210) = Right t - instance SuppressUnusedWarnings RightSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) RightSym0KindInference) GHC.Tuple.()) - data RightSym0 (l :: TyFun b0123456789876543210 (Either a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => - RightSym0KindInference - type instance Apply RightSym0 l = Right l - type family Case_0123456789876543210 ns bs n b t where - Case_0123456789876543210 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 ns bs n b False = n - type family Lambda_0123456789876543210 ns bs t t where - Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 False = n - type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b - type Lambda_0123456789876543210Sym4 t t t t = - Lambda_0123456789876543210 t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type FooSym3 (t :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: a0123456789876543210) = - Foo t t t - instance SuppressUnusedWarnings FooSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooSym2KindInference) GHC.Tuple.()) - data FooSym2 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210) - = forall arg. SameKind (Apply (FooSym2 l l) arg) (FooSym3 l l arg) => - FooSym2KindInference - type instance Apply (FooSym2 l l) l = Foo l l l - instance SuppressUnusedWarnings FooSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.()) - data FooSym1 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) => - FooSym1KindInference - type instance Apply (FooSym1 l) l = FooSym2 l l - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = FooSym1 l - type ZipWithSym3 (t :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (t :: [a0123456789876543210]) (t :: [b0123456789876543210]) = - ZipWith t t t - instance SuppressUnusedWarnings ZipWithSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ZipWithSym2KindInference) GHC.Tuple.()) - data ZipWithSym2 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: [a0123456789876543210]) (l :: TyFun [b0123456789876543210] [c0123456789876543210]) - = forall arg. SameKind (Apply (ZipWithSym2 l l) arg) (ZipWithSym3 l l arg) => - ZipWithSym2KindInference - type instance Apply (ZipWithSym2 l l) l = ZipWith l l l - instance SuppressUnusedWarnings ZipWithSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ZipWithSym1KindInference) GHC.Tuple.()) - data ZipWithSym1 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ZipWithSym1 l) arg) (ZipWithSym2 l arg) => - ZipWithSym1KindInference - type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l - instance SuppressUnusedWarnings ZipWithSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ZipWithSym0KindInference) GHC.Tuple.()) - data ZipWithSym0 (l :: TyFun (TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210 - -> GHC.Types.Type) - -> GHC.Types.Type) (TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210] - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => - ZipWithSym0KindInference - type instance Apply ZipWithSym0 l = ZipWithSym1 l - type SplungeSym2 (t :: [Nat]) (t :: [Bool]) = Splunge t t - instance SuppressUnusedWarnings SplungeSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SplungeSym1KindInference) GHC.Tuple.()) - data SplungeSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) - = forall arg. SameKind (Apply (SplungeSym1 l) arg) (SplungeSym2 l arg) => - SplungeSym1KindInference - type instance Apply (SplungeSym1 l) l = Splunge l l - instance SuppressUnusedWarnings SplungeSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SplungeSym0KindInference) GHC.Tuple.()) - data SplungeSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => - SplungeSym0KindInference - type instance Apply SplungeSym0 l = SplungeSym1 l - type EtadSym2 (t :: [Nat]) (t :: [Bool]) = Etad t t - instance SuppressUnusedWarnings EtadSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) EtadSym1KindInference) GHC.Tuple.()) - data EtadSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) - = forall arg. SameKind (Apply (EtadSym1 l) arg) (EtadSym2 l arg) => - EtadSym1KindInference - type instance Apply (EtadSym1 l) l = Etad l l - instance SuppressUnusedWarnings EtadSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) EtadSym0KindInference) GHC.Tuple.()) - data EtadSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => - EtadSym0KindInference - type instance Apply EtadSym0 l = EtadSym1 l - type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: Maybe a0123456789876543210) = - LiftMaybe t t - instance SuppressUnusedWarnings LiftMaybeSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.()) - data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)) - = forall arg. SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) => - LiftMaybeSym1KindInference - type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l - instance SuppressUnusedWarnings LiftMaybeSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.()) - data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => - LiftMaybeSym0KindInference - type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l - type MapSym2 (t :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (t :: [a0123456789876543210]) = - Map t t - instance SuppressUnusedWarnings MapSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MapSym1KindInference) GHC.Tuple.()) - data MapSym1 (l :: TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] [b0123456789876543210]) - = forall arg. SameKind (Apply (MapSym1 l) arg) (MapSym2 l arg) => - MapSym1KindInference - type instance Apply (MapSym1 l) l = Map l l - instance SuppressUnusedWarnings MapSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MapSym0KindInference) GHC.Tuple.()) - data MapSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210 - -> GHC.Types.Type) (TyFun [a0123456789876543210] [b0123456789876543210] - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => - MapSym0KindInference - type instance Apply MapSym0 l = MapSym1 l - type family Foo (a :: TyFun (TyFun a b - -> GHC.Types.Type) (TyFun a b -> GHC.Types.Type) - -> GHC.Types.Type) (a :: TyFun a b - -> GHC.Types.Type) (a :: a) :: b where - Foo f g a = Apply (Apply f g) a - type family ZipWith (a :: TyFun a (TyFun b c -> GHC.Types.Type) - -> GHC.Types.Type) (a :: [a]) (a :: [b]) :: [c] where - ZipWith f ((:) x xs) ((:) y ys) = Apply (Apply (:@#@$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) - ZipWith _ '[] '[] = '[] - ZipWith _ ((:) _ _) '[] = '[] - ZipWith _ '[] ((:) _ _) = '[] - type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where - Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs - type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where - Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 - type family LiftMaybe (a :: TyFun a b - -> GHC.Types.Type) (a :: Maybe a) :: Maybe b where - LiftMaybe f (Just x) = Apply JustSym0 (Apply f x) - LiftMaybe _ Nothing = NothingSym0 - type family Map (a :: TyFun a b - -> GHC.Types.Type) (a :: [a]) :: [b] where - Map _ '[] = '[] - Map f ((:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) - sFoo :: - forall (t :: TyFun (TyFun a b -> GHC.Types.Type) (TyFun a b - -> GHC.Types.Type) - -> GHC.Types.Type) - (t :: TyFun a b -> GHC.Types.Type) - (t :: a). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) - sZipWith :: - forall (t :: TyFun a (TyFun b c -> GHC.Types.Type) - -> GHC.Types.Type) - (t :: [a]) - (t :: [b]). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) - sSplunge :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) - sEtad :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) - sLiftMaybe :: - forall (t :: TyFun a b -> GHC.Types.Type) (t :: Maybe a). - Sing t - -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) - sMap :: - forall (t :: TyFun a b -> GHC.Types.Type) (t :: [a]). - Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) - sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) - = (applySing ((applySing sF) sG)) sA - sZipWith - (sF :: Sing f) - (SCons (sX :: Sing x) (sXs :: Sing xs)) - (SCons (sY :: Sing y) (sYs :: Sing ys)) - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing sF) sX)) sY))) - ((applySing - ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) - sXs)) - sYs) - sZipWith _ SNil SNil = SNil - sZipWith _ (SCons _ _) SNil = SNil - sZipWith _ SNil (SCons _ _) = SNil - sSplunge (sNs :: Sing ns) (sBs :: Sing bs) - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) - (\ sN sB - -> case (GHC.Tuple.(,) sN) sB of { - GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) - -> case sB of - STrue - -> (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) sN) - SFalse -> sN :: - Sing (Case_0123456789876543210 ns bs n b b) })))) - sNs)) - sBs - sEtad - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 - @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) - (\ sN sB - -> case (GHC.Tuple.(,) sN) sB of { - GHC.Tuple.(,) (_ :: Sing n) (_ :: Sing b) - -> case sB of - STrue - -> (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) sN) - SFalse -> sN :: - Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) })))) - sA_0123456789876543210)) - sA_0123456789876543210 - sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) - = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) - sLiftMaybe _ SNothing = SNothing - sMap _ SNil = SNil - sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t)) - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH))) - ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) - data instance Sing (z :: Either a b) - where - SLeft :: forall (n :: a). (Sing (n :: a)) -> Sing (Left n) - SRight :: forall (n :: b). (Sing (n :: b)) -> Sing (Right n) - type SEither = (Sing :: Either a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind (Either a b) where - type Demote (Either a b) = Either (Demote a) (Demote b) - fromSing (SLeft b) = Left (fromSing b) - fromSing (SRight b) = Right (fromSing b) - toSing (Left (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SLeft c) } - toSing (Right (b :: Demote b)) - = case toSing b :: SomeSing b of { - SomeSing c -> SomeSing (SRight c) } - instance SingI n => SingI (Left (n :: a)) where - sing = SLeft sing - instance SingI n => SingI (Right (n :: b)) where - sing = SRight sing diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template @@ -0,0 +1,480 @@ +Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| map :: (a -> b) -> [a] -> [b] + map _ [] = [] + map f (h : t) = (f h) : (map f t) + liftMaybe :: (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys + zipWith _ [] [] = [] + zipWith _ (_ : _) [] = [] + zipWith _ [] (_ : _) = [] + foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = f g a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + + data Either a b = Left a | Right b |] + ======> + data Either a b = Left a | Right b + map :: (a -> b) -> [a] -> [b] + map _ [] = [] + map f (h : t) = (f h : (map f) t) + liftMaybe :: (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x : xs) (y : ys) = ((f x) y : ((zipWith f) xs) ys) + zipWith _ [] [] = [] + zipWith _ (_ : _) [] = [] + zipWith _ [] (_ : _) = [] + foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = (f g) a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + type LeftSym1 (t0123456789876543210 :: a0123456789876543210) = + Left t0123456789876543210 + instance SuppressUnusedWarnings LeftSym0 where + suppressUnusedWarnings = snd (((,) LeftSym0KindInference) ()) + data LeftSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 (Either a0123456789876543210 b0123456789876543210) + where + LeftSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => + LeftSym0 t0123456789876543210 + type instance Apply LeftSym0 t0123456789876543210 = Left t0123456789876543210 + type RightSym1 (t0123456789876543210 :: b0123456789876543210) = + Right t0123456789876543210 + instance SuppressUnusedWarnings RightSym0 where + suppressUnusedWarnings = snd (((,) RightSym0KindInference) ()) + data RightSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) b0123456789876543210 (Either a0123456789876543210 b0123456789876543210) + where + RightSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => + RightSym0 t0123456789876543210 + type instance Apply RightSym0 t0123456789876543210 = Right t0123456789876543210 + type family Case_0123456789876543210 ns bs n b t where + Case_0123456789876543210 ns bs n b 'True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789876543210 ns bs n b 'False = n + type family Lambda_0123456789876543210 ns bs t t where + Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b + type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall ns0123456789876543210 + bs0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall ns0123456789876543210 + bs0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ns0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall ns0123456789876543210 + bs0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ns0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) bs0123456789876543210 = Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 ns0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall ns0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 ns0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210 + type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'False = n + type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b + type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 + type FooSym3 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooSym2KindInference) ()) + data FooSym2 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210 + where + FooSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) => + FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) + data FooSym1 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) + where + FooSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => + FooSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type ZipWithSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ZipWithSym2KindInference) ()) + data ZipWithSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [b0123456789876543210] [c0123456789876543210] + where + ZipWithSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) => + ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ZipWithSym1KindInference) ()) + data ZipWithSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) :: (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210]) + where + ZipWithSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) => + ZipWithSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ZipWithSym0 where + suppressUnusedWarnings = snd (((,) ZipWithSym0KindInference) ()) + data ZipWithSym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210. + (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) ((~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210])) + where + ZipWithSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => + ZipWithSym0 a0123456789876543210 + type instance Apply ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210 + type SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = + Splunge a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ()) + data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] + where + SplungeSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => + SplungeSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings SplungeSym0 where + suppressUnusedWarnings = snd (((,) SplungeSym0KindInference) ()) + data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) + where + SplungeSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => + SplungeSym0 a0123456789876543210 + type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210 + type EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = + Etad a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ()) + data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] + where + EtadSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => + EtadSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings EtadSym0 where + suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) + data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) + where + EtadSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => + EtadSym0 a0123456789876543210 + type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 + type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + LiftMaybe a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) + data LiftMaybeSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) + where + LiftMaybeSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => + LiftMaybeSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) + data LiftMaybeSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)) + where + LiftMaybeSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => + LiftMaybeSym0 a0123456789876543210 + type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210 + type MapSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = + Map a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) MapSym1KindInference) ()) + data MapSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) [a0123456789876543210] [b0123456789876543210] + where + MapSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) => + MapSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = Map a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings MapSym0 where + suppressUnusedWarnings = snd (((,) MapSym0KindInference) ()) + data MapSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) [a0123456789876543210] [b0123456789876543210]) + where + MapSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => + MapSym0 a0123456789876543210 + type instance Apply MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210 + type family Foo (a :: (~>) ((~>) a b) ((~>) a b)) (a :: (~>) a b) (a :: a) :: b where + Foo f g a = Apply (Apply f g) a + type family ZipWith (a :: (~>) a ((~>) b c)) (a :: [a]) (a :: [b]) :: [c] where + ZipWith f ( '(:) x xs) ( '(:) y ys) = Apply (Apply (:@#@$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) + ZipWith _ '[] '[] = '[] + ZipWith _ ( '(:) _ _) '[] = '[] + ZipWith _ '[] ( '(:) _ _) = '[] + type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs + type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 + type family LiftMaybe (a :: (~>) a b) (a :: Maybe a) :: Maybe b where + LiftMaybe f ( 'Just x) = Apply JustSym0 (Apply f x) + LiftMaybe _ 'Nothing = NothingSym0 + type family Map (a :: (~>) a b) (a :: [a]) :: [b] where + Map _ '[] = '[] + Map f ( '(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) + sFoo :: + forall a + b + (t :: (~>) ((~>) a b) ((~>) a b)) + (t :: (~>) a b) + (t :: a). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) + sZipWith :: + forall a b c (t :: (~>) a ((~>) b c)) (t :: [a]) (t :: [b]). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + sSplunge :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) + sEtad :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) + sLiftMaybe :: + forall a b (t :: (~>) a b) (t :: Maybe a). + Sing t + -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) + sMap :: + forall a b (t :: (~>) a b) (t :: [a]). + Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) + sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) + = (applySing ((applySing sF) sG)) sA + sZipWith + (sF :: Sing f) + (SCons (sX :: Sing x) (sXs :: Sing xs)) + (SCons (sY :: Sing y) (sYs :: Sing ys)) + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing sF) sX)) sY))) + ((applySing + ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) + sXs)) + sYs) + sZipWith _ SNil SNil = SNil + sZipWith _ (SCons _ _) SNil = SNil + sZipWith _ SNil (SCons _ _) = SNil + sSplunge (sNs :: Sing ns) (sBs :: Sing bs) + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) + (\ sN sB + -> case ((,) sN) sB of { + (,) (_ :: Sing n) (_ :: Sing b) + -> (case sB of + STrue + -> (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sN) + SFalse -> sN) :: + Sing (Case_0123456789876543210 ns bs n b b) })))) + sNs)) + sBs + sEtad + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) + (\ sN sB + -> case ((,) sN) sB of { + (,) (_ :: Sing n) (_ :: Sing b) + -> (case sB of + STrue + -> (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sN) + SFalse -> sN) :: + Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) })))) + sA_0123456789876543210)) + sA_0123456789876543210 + sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) + = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) + sLiftMaybe _ SNothing = SNothing + sMap _ SNil = SNil + sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH))) + ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) + instance SingI (FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))) where + sing = (singFun3 @FooSym0) sFoo + instance SingI d => + SingI (FooSym1 (d :: (~>) ((~>) a b) ((~>) a b)) :: (~>) ((~>) a b) ((~>) a b)) where + sing + = (singFun2 @(FooSym1 (d :: (~>) ((~>) a b) ((~>) a b)))) + (sFoo (sing @d)) + instance (SingI d, SingI d) => + SingI (FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b) :: (~>) a b) where + sing + = (singFun1 + @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b))) + ((sFoo (sing @d)) (sing @d)) + instance SingI (ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c]))) where + sing = (singFun3 @ZipWithSym0) sZipWith + instance SingI d => + SingI (ZipWithSym1 (d :: (~>) a ((~>) b c)) :: (~>) [a] ((~>) [b] [c])) where + sing + = (singFun2 @(ZipWithSym1 (d :: (~>) a ((~>) b c)))) + (sZipWith (sing @d)) + instance (SingI d, SingI d) => + SingI (ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]) :: (~>) [b] [c]) where + sing + = (singFun1 @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]))) + ((sZipWith (sing @d)) (sing @d)) + instance SingI (SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where + sing = (singFun2 @SplungeSym0) sSplunge + instance SingI d => + SingI (SplungeSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where + sing = (singFun1 @(SplungeSym1 (d :: [Nat]))) (sSplunge (sing @d)) + instance SingI (EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where + sing = (singFun2 @EtadSym0) sEtad + instance SingI d => + SingI (EtadSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where + sing = (singFun1 @(EtadSym1 (d :: [Nat]))) (sEtad (sing @d)) + instance SingI (LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))) where + sing = (singFun2 @LiftMaybeSym0) sLiftMaybe + instance SingI d => + SingI (LiftMaybeSym1 (d :: (~>) a b) :: (~>) (Maybe a) (Maybe b)) where + sing + = (singFun1 @(LiftMaybeSym1 (d :: (~>) a b))) + (sLiftMaybe (sing @d)) + instance SingI (MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b])) where + sing = (singFun2 @MapSym0) sMap + instance SingI d => + SingI (MapSym1 (d :: (~>) a b) :: (~>) [a] [b]) where + sing = (singFun1 @(MapSym1 (d :: (~>) a b))) (sMap (sing @d)) + data instance Sing :: Either a b -> GHC.Types.Type + where + SLeft :: forall a (n :: a). (Sing (n :: a)) -> Sing (Left n) + SRight :: forall b (n :: b). (Sing (n :: b)) -> Sing (Right n) + type SEither = (Sing :: Either a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Either a b) where + type Demote (Either a b) = Either (Demote a) (Demote b) + fromSing (SLeft b) = Left (fromSing b) + fromSing (SRight b) = Right (fromSing b) + toSing (Left (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SLeft c) } + toSing (Right (b :: Demote b)) + = case toSing b :: SomeSing b of { + SomeSing c -> SomeSing (SRight c) } + instance SingI n => SingI (Left (n :: a)) where + sing = SLeft sing + instance SingI (LeftSym0 :: (~>) a (Either a b)) where + sing = (singFun1 @LeftSym0) SLeft + instance SingI (TyCon1 Left :: (~>) a (Either a b)) where + sing = (singFun1 @(TyCon1 Left)) SLeft + instance SingI n => SingI (Right (n :: b)) where + sing = SRight sing + instance SingI (RightSym0 :: (~>) b (Either a b)) where + sing = (singFun1 @RightSym0) SRight + instance SingI (TyCon1 Right :: (~>) b (Either a b)) where + sing = (singFun1 @(TyCon1 Right)) SRight diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LambdaCase.ghc84.template +++ /dev/null @@ -1,221 +0,0 @@ -Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo1 :: a -> Maybe a -> a - foo1 d x - = (\case - Just y -> y - Nothing -> d) - x - foo2 :: a -> Maybe a -> a - foo2 d _ - = (\case - Just y -> y - Nothing -> d) - (Just d) - foo3 :: a -> b -> a - foo3 a b = (\case (p, _) -> p) (a, b) |] - ======> - foo1 :: a -> Maybe a -> a - foo1 d x - = (\case - \ (Just y) -> y - \ Nothing -> d) - x - foo2 :: a -> Maybe a -> a - foo2 d _ - = (\case - \ (Just y) -> y - \ Nothing -> d) - (Just d) - foo3 :: a -> b -> a - foo3 a b = (\case \ (p, _) -> p) (a, b) - type family Case_0123456789876543210 a b x_0123456789876543210 t where - Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p - type family Lambda_0123456789876543210 a b t where - Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 d x_0123456789876543210 t where - Case_0123456789876543210 d x_0123456789876543210 (Just y) = y - Case_0123456789876543210 d x_0123456789876543210 Nothing = d - type family Lambda_0123456789876543210 d t where - Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym2 t t = - Lambda_0123456789876543210 t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 d x x_0123456789876543210 t where - Case_0123456789876543210 d x x_0123456789876543210 (Just y) = y - Case_0123456789876543210 d x x_0123456789876543210 Nothing = d - type family Lambda_0123456789876543210 d x t where - Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Foo3 t t - instance SuppressUnusedWarnings Foo3Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.()) - data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) => - Foo3Sym1KindInference - type instance Apply (Foo3Sym1 l) l = Foo3 l l - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0KindInference - type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo2 t t - instance SuppressUnusedWarnings Foo2Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.()) - data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) => - Foo2Sym1KindInference - type instance Apply (Foo2Sym1 l) l = Foo2 l l - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) = - Foo1 t t - instance SuppressUnusedWarnings Foo1Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.()) - data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) => - Foo1Sym1KindInference - type instance Apply (Foo1Sym1 l) l = Foo1 l l - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1Sym1 l - type family Foo3 (a :: a) (a :: b) :: a where - Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) - type family Foo2 (a :: a) (a :: Maybe a) :: a where - Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) - type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x - sFoo3 :: - forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) - sFoo2 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) - sFoo1 :: - forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) - sFoo3 (sA :: Sing a) (sB :: Sing b) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of { - STuple2 (sP :: Sing p) _ -> sP } :: - Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) }))) - ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) - sFoo2 (sD :: Sing d) _ - = (applySing - ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD :: - Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) }))) - ((applySing ((singFun1 @JustSym0) SJust)) sD) - sFoo1 (sD :: Sing d) (sX :: Sing x) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x)) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of { - _ :: Sing x_0123456789876543210 - -> case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD :: - Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) }))) - sX diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template @@ -0,0 +1,252 @@ +Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = (\case + Just y -> y + Nothing -> d) + x + foo2 :: a -> Maybe a -> a + foo2 d _ + = (\case + Just y -> y + Nothing -> d) + (Just d) + foo3 :: a -> b -> a + foo3 a b = (\case (p, _) -> p) (a, b) |] + ======> + foo1 :: a -> Maybe a -> a + foo1 d x + = (\case + Just y -> y + Nothing -> d) + x + foo2 :: a -> Maybe a -> a + foo2 d _ + = (\case + Just y -> y + Nothing -> d) + (Just d) + foo3 :: a -> b -> a + foo3 a b = (\case (p, _) -> p) (a, b) + type family Case_0123456789876543210 a b x_0123456789876543210 t where + Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p + type family Lambda_0123456789876543210 a b t where + Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + b0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 + type family Case_0123456789876543210 d x_0123456789876543210 t where + Case_0123456789876543210 d x_0123456789876543210 ( 'Just y) = y + Case_0123456789876543210 d x_0123456789876543210 'Nothing = d + type family Lambda_0123456789876543210 d t where + Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 d0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 d0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 + type family Case_0123456789876543210 d x x_0123456789876543210 t where + Case_0123456789876543210 d x x_0123456789876543210 ( 'Just y) = y + Case_0123456789876543210 d x x_0123456789876543210 'Nothing = d + type family Lambda_0123456789876543210 d x t where + Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210 + type Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall d0123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 d0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 d0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 d0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 + type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo3 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) + data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo3Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => + Foo3Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 a0123456789876543210 + type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) + data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo2Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => + Foo2Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) + data Foo2Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) + where + Foo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0 a0123456789876543210 + type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) + data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo1Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => + Foo1Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x + sFoo3 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall a (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall a (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo3 (sA :: Sing a) (sB :: Sing b) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + (_ :: Sing x_0123456789876543210) + -> (case sX_0123456789876543210 of { + STuple2 (sP :: Sing p) _ -> sP }) :: + Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) }))) + ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) + sFoo2 (sD :: Sing d) _ + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + (_ :: Sing x_0123456789876543210) + -> (case sX_0123456789876543210 of + SJust (sY :: Sing y) -> sY + SNothing -> sD) :: + Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) }))) + ((applySing ((singFun1 @JustSym0) SJust)) sD) + sFoo1 (sD :: Sing d) (sX :: Sing x) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x)) + (\ sX_0123456789876543210 + -> case sX_0123456789876543210 of { + (_ :: Sing x_0123456789876543210) + -> (case sX_0123456789876543210 of + SJust (sY :: Sing y) -> sY + SNothing -> sD) :: + Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) }))) + sX + instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo3Sym0) sFoo3 + instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d)) + instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where + sing = (singFun2 @Foo2Sym0) sFoo2 + instance SingI d => + SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where + sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) + instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where + sing = (singFun2 @Foo1Sym0) sFoo1 + instance SingI d => + SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where + sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc84.template b/tests/compile-and-dump/Singletons/Lambdas.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Lambdas.ghc84.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 _) = 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.ghc86.template b/tests/compile-and-dump/Singletons/Lambdas.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Lambdas.ghc86.template @@ -0,0 +1,830 @@ +Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo0 :: a -> b -> a + foo0 = (\ x y -> x) + foo1 :: a -> b -> a + foo1 x = (\ _ -> x) + foo2 :: a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: a -> a + foo3 x = (\ y -> y) x + foo4 :: a -> b -> c -> a + foo4 x y z = (\ _ _ -> x) y z + foo5 :: a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: a -> b -> a + foo6 a b = (\ x -> \ _ -> x) a b + foo7 :: a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + foo8 :: Foo a b -> a + foo8 x = (\ (Foo a _) -> a) x + + data Foo a b = Foo a b |] + ======> + foo0 :: a -> b -> a + foo0 = \ x y -> x + foo1 :: a -> b -> a + foo1 x = \ _ -> x + foo2 :: a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: a -> a + foo3 x = (\ y -> y) x + foo4 :: a -> b -> c -> a + foo4 x y z = ((\ _ _ -> x) y) z + foo5 :: a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: a -> b -> a + foo6 a b = ((\ x -> \ _ -> x) a) b + foo7 :: a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + data Foo a b = Foo a b + foo8 :: Foo a b -> a + foo8 x = (\ (Foo a _) -> a) x + type FooSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Foo t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (FooSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) + data FooSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210) + where + FooSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (FooSym1 t0123456789876543210) arg) (FooSym2 t0123456789876543210 arg) => + FooSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (FooSym1 t0123456789876543210) t0123456789876543210 = Foo t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)) + where + FooSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 t0123456789876543210 + type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210 + type family Case_0123456789876543210 x arg_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 a b x arg_0123456789876543210 t where + Case_0123456789876543210 a b x arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 a b x t where + Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 + type family Lambda_0123456789876543210 a b t where + Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x + type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + b0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y x = x + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where + Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_, + _) = x + type family Lambda_0123456789876543210 x y z t t where + Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) + type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 + y0123456789876543210 + z0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + y0123456789876543210 + z0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + z0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 z0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x y = y + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x a_0123456789876543210 t where + Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x + type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) = + Foo8 a0123456789876543210 + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) + data Foo8Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210 + where + Foo8Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => + Foo8Sym0 a0123456789876543210 + type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 + type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo7 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) + data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Foo7Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => + Foo7Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) + data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Foo7Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0 a0123456789876543210 + type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 + type Foo6Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo6 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo6Sym1KindInference) ()) + data Foo6Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo6Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => + Foo6Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) + data Foo6Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo6Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => + Foo6Sym0 a0123456789876543210 + type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 + type Foo5Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo5 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo5Sym1KindInference) ()) + data Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Foo5Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => + Foo5Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) + data Foo5Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Foo5Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0 a0123456789876543210 + type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 + type Foo4Sym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) = + Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo4Sym2KindInference) ()) + data Foo4Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210. + (~>) c0123456789876543210 a0123456789876543210 + where + Foo4Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) => + Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo4Sym1KindInference) ()) + data Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210) + where + Foo4Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) => + Foo4Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) + data Foo4Sym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210)) + where + Foo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0 a0123456789876543210 + type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo3 a0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 a0123456789876543210 + type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) + data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo2Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => + Foo2Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) + data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0 a0123456789876543210 + type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) + data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo1Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => + Foo1Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + type Foo0Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo0 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo0Sym1KindInference) ()) + data Foo0Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo0Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) => + Foo0Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo0Sym0 where + suppressUnusedWarnings = snd (((,) Foo0Sym0KindInference) ()) + data Foo0Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo0Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => + Foo0Sym0 a0123456789876543210 + type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210 + type family Foo8 (a :: Foo a b) :: a where + Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x + type family Foo7 (a :: a) (a :: b) :: b where + Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) + type family Foo6 (a :: a) (a :: b) :: a where + Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b + type family Foo5 (a :: a) (a :: b) :: b where + Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Foo4 (a :: a) (a :: b) (a :: c) :: a where + Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z + type family Foo3 (a :: a) :: a where + Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x + type family Foo2 (a :: a) (a :: b) :: a where + Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Foo1 (a :: a) (a :: b) :: a where + Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 + type family Foo0 (a :: a) (a :: b) :: a where + Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 + sFoo8 :: + forall a b (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) + sFoo7 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) + sFoo6 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) + sFoo5 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) + sFoo4 :: + forall a b c (t :: a) (t :: b) (t :: c). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) + sFoo3 :: forall a (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) + sFoo2 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo0 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) + sFoo8 (sX :: Sing x) + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { + SFoo (sA :: Sing a) _ -> sA }) :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))) + sX + sFoo7 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { + STuple2 _ (sB :: Sing b) -> sB }) :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) + sFoo6 (sA :: Sing a) (sB :: Sing b) + = (applySing + ((applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (singFun1 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sX }) :: + Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) }))) + sA)) + sB + sFoo5 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sX -> case sX of { (_ :: Sing x) -> sX }))) + sY + sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z)) + (\ sArg_0123456789876543210 sArg_0123456789876543210 + -> case + ((,) sArg_0123456789876543210) sArg_0123456789876543210 + of { + (,) (_ :: Sing arg_0123456789876543210) + (_ :: Sing arg_0123456789876543210) + -> (case + (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + sArg_0123456789876543210)) + sArg_0123456789876543210 + of { + STuple2 _ _ -> sX }) :: + Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) }))) + sY)) + sZ + sFoo3 (sX :: Sing x) + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sY -> case sY of { (_ :: Sing y) -> sY }))) + sX + sFoo2 (sX :: Sing x) (sY :: Sing y) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sX }) :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY + sFoo1 + (sX :: Sing x) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sX }) :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) + sA_0123456789876543210 + sFoo0 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((singFun2 + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) + (\ sX sY + -> case ((,) sX) sY of { (,) (_ :: Sing x) (_ :: Sing y) -> sX }))) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SingI (Foo8Sym0 :: (~>) (Foo a b) a) where + sing = (singFun1 @Foo8Sym0) sFoo8 + instance SingI (Foo7Sym0 :: (~>) a ((~>) b b)) where + sing = (singFun2 @Foo7Sym0) sFoo7 + instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b b) where + sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d)) + instance SingI (Foo6Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo6Sym0) sFoo6 + instance SingI d => SingI (Foo6Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo6Sym1 (d :: a))) (sFoo6 (sing @d)) + instance SingI (Foo5Sym0 :: (~>) a ((~>) b b)) where + sing = (singFun2 @Foo5Sym0) sFoo5 + instance SingI d => SingI (Foo5Sym1 (d :: a) :: (~>) b b) where + sing = (singFun1 @(Foo5Sym1 (d :: a))) (sFoo5 (sing @d)) + instance SingI (Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))) where + sing = (singFun3 @Foo4Sym0) sFoo4 + instance SingI d => + SingI (Foo4Sym1 (d :: a) :: (~>) b ((~>) c a)) where + sing = (singFun2 @(Foo4Sym1 (d :: a))) (sFoo4 (sing @d)) + instance (SingI d, SingI d) => + SingI (Foo4Sym2 (d :: a) (d :: b) :: (~>) c a) where + sing + = (singFun1 @(Foo4Sym2 (d :: a) (d :: b))) + ((sFoo4 (sing @d)) (sing @d)) + instance SingI (Foo3Sym0 :: (~>) a a) where + sing = (singFun1 @Foo3Sym0) sFoo3 + instance SingI (Foo2Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo2Sym0) sFoo2 + instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) + instance SingI (Foo1Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo1Sym0) sFoo1 + instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) + instance SingI (Foo0Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo0Sym0) sFoo0 + instance SingI d => SingI (Foo0Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo0Sym1 (d :: a))) (sFoo0 (sing @d)) + data instance Sing :: Foo a b -> GHC.Types.Type + where + SFoo :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Foo n n) + type SFoo = (Sing :: Foo a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Foo a b) where + type Demote (Foo a b) = Foo (Demote a) (Demote b) + fromSing (SFoo b b) = (Foo (fromSing b)) (fromSing b) + toSing (Foo (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) } + instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where + sing = (SFoo sing) sing + instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where + sing = (singFun2 @FooSym0) SFoo + instance SingI (TyCon2 Foo :: (~>) a ((~>) b (Foo a b))) where + sing = (singFun2 @(TyCon2 Foo)) SFoo + instance SingI d => + SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where + sing = (singFun1 @(FooSym1 (d :: a))) (SFoo (sing @d)) + instance SingI d => + SingI (TyCon1 (Foo (d :: a)) :: (~>) b (Foo a b)) where + sing = (singFun1 @(TyCon1 (Foo (d :: a)))) (SFoo (sing @d)) 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 -Wno-unused-matches -Wno-name-shadowing -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing #-} {-# LANGUAGE UnboxedTuples #-} -- We expect unused binds and name shadowing in foo5 test. diff --git a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.template b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc84.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 - 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/LambdasComprehensive.ghc86.template b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.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 t0123456789876543210 = + Lambda_0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 t0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 t0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 + type BarSym0 = Bar + type FooSym0 = Foo + type family Bar :: [Nat] where + Bar = Apply (Apply MapSym0 (Apply (Apply Either_Sym0 PredSym0) SuccSym0)) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Foo :: [Nat] where + Foo = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + sBar :: Sing (BarSym0 :: [Nat]) + sFoo :: Sing (FooSym0 :: [Nat]) + sBar + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((applySing + ((applySing ((singFun3 @Either_Sym0) sEither_)) + ((singFun1 @PredSym0) sPred))) + ((singFun1 @SuccSym0) SSucc)))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @RightSym0) SRight)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sFoo + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((singFun1 @Lambda_0123456789876543210Sym0) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (applySing + ((applySing + ((applySing ((singFun3 @Either_Sym0) sEither_)) + ((singFun1 @PredSym0) sPred))) + ((singFun1 @SuccSym0) SSucc))) + sX })))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @RightSym0) SRight)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc84.template b/tests/compile-and-dump/Singletons/LetStatements.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/LetStatements.ghc84.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, - _) = 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.ghc86.template b/tests/compile-and-dump/Singletons/LetStatements.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LetStatements.ghc86.template @@ -0,0 +1,1002 @@ +Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = (\ x -> x) + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + in (Succ Zero) + x + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + z :: Nat + z = x + in (Succ Zero) + z + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + x) + in x + (Succ (Succ Zero)) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) |] + ======> + foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = \ x -> x + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + in (Succ Zero + x) + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + z :: Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + z = x + in (Succ Zero + z) + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + x) + in (x + Succ (Succ Zero)) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x '(y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x '(_, + y_0123456789876543210) = y_0123456789876543210 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210YSym0KindInference) ()) + data Let0123456789876543210YSym0 x0123456789876543210 + where + Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0 x0123456789876543210 + type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 + type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210X_0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) Let0123456789876543210X_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 + where + Let0123456789876543210X_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => + Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 + type family Let0123456789876543210Y x where + Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) + type family Let0123456789876543210Z x where + Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) + type family Let0123456789876543210X_0123456789876543210 x where + Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x + type Let0123456789876543210BarSym1 x0123456789876543210 = + Let0123456789876543210Bar x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210BarSym0KindInference) ()) + data Let0123456789876543210BarSym0 x0123456789876543210 + where + Let0123456789876543210BarSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => + Let0123456789876543210BarSym0 x0123456789876543210 + type instance Apply Let0123456789876543210BarSym0 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210 + type family Let0123456789876543210Bar x :: a where + Let0123456789876543210Bar x = x + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x) + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = x + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) + type family Lambda_0123456789876543210 x a_0123456789876543210 t where + Lambda_0123456789876543210 x a_0123456789876543210 x = x + type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210Z x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym1KindInference) ()) + data Let0123456789876543210ZSym1 x0123456789876543210 :: (~>) Nat Nat + where + Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => + Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type family Let0123456789876543210Z x (a :: Nat) :: Nat where + Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x x = x + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 + type Let0123456789876543210XSym1 x0123456789876543210 = + Let0123456789876543210X x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210XSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210XSym0KindInference) ()) + data Let0123456789876543210XSym0 x0123456789876543210 + where + Let0123456789876543210XSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => + Let0123456789876543210XSym0 x0123456789876543210 + type instance Apply Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210X x0123456789876543210 + type family Let0123456789876543210X x :: Nat where + Let0123456789876543210X x = ZeroSym0 + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym1KindInference) ()) + data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat + where + Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => + Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym0KindInference) ()) + data Let0123456789876543210FSym0 x0123456789876543210 + where + Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0 x0123456789876543210 + type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 y + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x + type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym1KindInference) ()) + data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + where + Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => + Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type family Let0123456789876543210Z x y :: Nat where + Let0123456789876543210Z x y = Apply SuccSym0 y + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym1KindInference) ()) + data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat + where + Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => + Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym0KindInference) ()) + data Let0123456789876543210FSym0 x0123456789876543210 + where + Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0 x0123456789876543210 + type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y) + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym1KindInference) ()) + data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat + where + Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => + Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym0KindInference) ()) + data Let0123456789876543210FSym0 x0123456789876543210 + where + Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0 x0123456789876543210 + type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 y + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210YSym0KindInference) ()) + data Let0123456789876543210YSym0 x0123456789876543210 + where + Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0 x0123456789876543210 + type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 + type family Let0123456789876543210Y x :: Nat where + Let0123456789876543210Y x = Apply SuccSym0 x + type Let0123456789876543210YSym0 = Let0123456789876543210Y + type Let0123456789876543210ZSym0 = Let0123456789876543210Z + type family Let0123456789876543210Y where + Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 + type family Let0123456789876543210Z where + Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210YSym0KindInference) ()) + data Let0123456789876543210YSym0 x0123456789876543210 + where + Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0 x0123456789876543210 + type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 + type family Let0123456789876543210Y x :: Nat where + Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 + type Foo14Sym1 (a0123456789876543210 :: Nat) = + Foo14 a0123456789876543210 + instance SuppressUnusedWarnings Foo14Sym0 where + suppressUnusedWarnings = snd (((,) Foo14Sym0KindInference) ()) + data Foo14Sym0 :: (~>) Nat (Nat, Nat) + where + Foo14Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => + Foo14Sym0 a0123456789876543210 + type instance Apply Foo14Sym0 a0123456789876543210 = Foo14 a0123456789876543210 + type Foo13_Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo13_ a0123456789876543210 + instance SuppressUnusedWarnings Foo13_Sym0 where + suppressUnusedWarnings = snd (((,) Foo13_Sym0KindInference) ()) + data Foo13_Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo13_Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => + Foo13_Sym0 a0123456789876543210 + type instance Apply Foo13_Sym0 a0123456789876543210 = Foo13_ a0123456789876543210 + type Foo13Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo13 a0123456789876543210 + instance SuppressUnusedWarnings Foo13Sym0 where + suppressUnusedWarnings = snd (((,) Foo13Sym0KindInference) ()) + data Foo13Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo13Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => + Foo13Sym0 a0123456789876543210 + type instance Apply Foo13Sym0 a0123456789876543210 = Foo13 a0123456789876543210 + type Foo12Sym1 (a0123456789876543210 :: Nat) = + Foo12 a0123456789876543210 + instance SuppressUnusedWarnings Foo12Sym0 where + suppressUnusedWarnings = snd (((,) Foo12Sym0KindInference) ()) + data Foo12Sym0 :: (~>) Nat Nat + where + Foo12Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => + Foo12Sym0 a0123456789876543210 + type instance Apply Foo12Sym0 a0123456789876543210 = Foo12 a0123456789876543210 + type Foo11Sym1 (a0123456789876543210 :: Nat) = + Foo11 a0123456789876543210 + instance SuppressUnusedWarnings Foo11Sym0 where + suppressUnusedWarnings = snd (((,) Foo11Sym0KindInference) ()) + data Foo11Sym0 :: (~>) Nat Nat + where + Foo11Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => + Foo11Sym0 a0123456789876543210 + type instance Apply Foo11Sym0 a0123456789876543210 = Foo11 a0123456789876543210 + type Foo10Sym1 (a0123456789876543210 :: Nat) = + Foo10 a0123456789876543210 + instance SuppressUnusedWarnings Foo10Sym0 where + suppressUnusedWarnings = snd (((,) Foo10Sym0KindInference) ()) + data Foo10Sym0 :: (~>) Nat Nat + where + Foo10Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => + Foo10Sym0 a0123456789876543210 + type instance Apply Foo10Sym0 a0123456789876543210 = Foo10 a0123456789876543210 + type Foo9Sym1 (a0123456789876543210 :: Nat) = + Foo9 a0123456789876543210 + instance SuppressUnusedWarnings Foo9Sym0 where + suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) + data Foo9Sym0 :: (~>) Nat Nat + where + Foo9Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => + Foo9Sym0 a0123456789876543210 + type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Nat) = + Foo8 a0123456789876543210 + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) + data Foo8Sym0 :: (~>) Nat Nat + where + Foo8Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => + Foo8Sym0 a0123456789876543210 + type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 + type Foo7Sym1 (a0123456789876543210 :: Nat) = + Foo7 a0123456789876543210 + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) + data Foo7Sym0 :: (~>) Nat Nat + where + Foo7Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0 a0123456789876543210 + type instance Apply Foo7Sym0 a0123456789876543210 = Foo7 a0123456789876543210 + type Foo6Sym1 (a0123456789876543210 :: Nat) = + Foo6 a0123456789876543210 + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) + data Foo6Sym0 :: (~>) Nat Nat + where + Foo6Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => + Foo6Sym0 a0123456789876543210 + type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 + type Foo5Sym1 (a0123456789876543210 :: Nat) = + Foo5 a0123456789876543210 + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) + data Foo5Sym0 :: (~>) Nat Nat + where + Foo5Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0 a0123456789876543210 + type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: Nat) = + Foo4 a0123456789876543210 + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) + data Foo4Sym0 :: (~>) Nat Nat + where + Foo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0 a0123456789876543210 + type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: Nat) = + Foo3 a0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: (~>) Nat Nat + where + Foo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 a0123456789876543210 + type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 + type Foo2Sym0 = Foo2 + type Foo1Sym1 (a0123456789876543210 :: Nat) = + Foo1 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: (~>) Nat Nat + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 + type family Foo14 (a :: Nat) :: (Nat, Nat) where + Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) + type family Foo13_ (a :: a) :: a where + Foo13_ y = y + type family Foo13 (a :: a) :: a where + Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x) + type family Foo12 (a :: Nat) :: Nat where + Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) + type family Foo11 (a :: Nat) :: Nat where + Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x) + type family Foo10 (a :: Nat) :: Nat where + Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) x + type family Foo9 (a :: Nat) :: Nat where + Foo9 x = Apply (Let0123456789876543210ZSym1 x) x + type family Foo8 (a :: Nat) :: Nat where + Foo8 x = Let0123456789876543210ZSym1 x + type family Foo7 (a :: Nat) :: Nat where + Foo7 x = Let0123456789876543210XSym1 x + type family Foo6 (a :: Nat) :: Nat where + Foo6 x = Let0123456789876543210ZSym1 x + type family Foo5 (a :: Nat) :: Nat where + Foo5 x = Apply (Let0123456789876543210FSym1 x) x + type family Foo4 (a :: Nat) :: Nat where + Foo4 x = Apply (Let0123456789876543210FSym1 x) x + type family Foo3 (a :: Nat) :: Nat where + Foo3 x = Let0123456789876543210YSym1 x + type family Foo2 :: Nat where + Foo2 = Let0123456789876543210ZSym0 + type family Foo1 (a :: Nat) :: Nat where + Foo1 x = Let0123456789876543210YSym1 x + sFoo14 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) + sFoo13_ :: + forall a (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) + sFoo13 :: + forall a (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) + sFoo12 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat) + sFoo11 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat) + sFoo10 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat) + sFoo9 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat) + sFoo8 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat) + sFoo7 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat) + sFoo6 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat) + sFoo5 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat) + sFoo4 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat) + sFoo3 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat) + sFoo2 :: Sing (Foo2Sym0 :: Nat) + sFoo1 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) + sFoo14 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x) + sZ :: Sing (Let0123456789876543210ZSym1 x) + sX_0123456789876543210 :: + Sing (Let0123456789876543210X_0123456789876543210Sym1 x) + sY + = (case sX_0123456789876543210 of { + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) + sZ + = (case sX_0123456789876543210 of { + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + ((applySing ((singFun1 @SuccSym0) SSucc)) sX))) + sX + in (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sZ)) sY + sFoo13_ (sY :: Sing y) = sY + sFoo13 (sX :: Sing x) + = let + sBar :: Sing (Let0123456789876543210BarSym1 x :: a) + sBar = sX + in (applySing ((singFun1 @Foo13_Sym0) sFoo13_)) sBar + sFoo12 (sX :: Sing x) + = let + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sX) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sX)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)) + sFoo11 (sX :: Sing x) + = let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + sZ = sX + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sM) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sZ + sFoo10 (sX :: Sing x) + = let + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + sN)) + sM) + in + (applySing + ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + sX + sFoo9 (sX :: Sing x) + = let + sZ :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210ZSym1 x) t :: Nat) + sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((singFun1 + @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) + (\ sX -> case sX of { (_ :: Sing x) -> sX }))) + sA_0123456789876543210 + in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX + sFoo8 (sX :: Sing x) + = let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + sZ + = (applySing + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sX -> case sX of { (_ :: Sing x) -> sX }))) + SZero + in sZ + sFoo7 (sX :: Sing x) + = let + sX :: Sing (Let0123456789876543210XSym1 x :: Nat) + sX = SZero + in sX + sFoo6 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in + let + sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) + sZ + = (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + in sZ + sFoo5 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) + = let + sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat) + sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in (applySing ((singFun1 @SuccSym0) SSucc)) sZ + in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + sFoo4 (sX :: Sing x) + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) + sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX + sFoo3 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x :: Nat) + sY = (applySing ((singFun1 @SuccSym0) SSucc)) sX + in sY + sFoo2 + = let + sY :: Sing Let0123456789876543210YSym0 + sZ :: Sing Let0123456789876543210ZSym0 + sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero + sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY + in sZ + sFoo1 (sX :: Sing x) + = let + sY :: Sing (Let0123456789876543210YSym1 x :: Nat) + sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero + in sY + instance SingI (Foo14Sym0 :: (~>) Nat (Nat, Nat)) where + sing = (singFun1 @Foo14Sym0) sFoo14 + instance SingI (Foo13_Sym0 :: (~>) a a) where + sing = (singFun1 @Foo13_Sym0) sFoo13_ + instance SingI (Foo13Sym0 :: (~>) a a) where + sing = (singFun1 @Foo13Sym0) sFoo13 + instance SingI (Foo12Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo12Sym0) sFoo12 + instance SingI (Foo11Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo11Sym0) sFoo11 + instance SingI (Foo10Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo10Sym0) sFoo10 + instance SingI (Foo9Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo9Sym0) sFoo9 + instance SingI (Foo8Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo8Sym0) sFoo8 + instance SingI (Foo7Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo7Sym0) sFoo7 + instance SingI (Foo6Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo6Sym0) sFoo6 + instance SingI (Foo5Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo5Sym0) sFoo5 + instance SingI (Foo4Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo4Sym0) sFoo4 + instance SingI (Foo3Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo3Sym0) sFoo3 + instance SingI (Foo1Sym0 :: (~>) Nat Nat) where + sing = (singFun1 @Foo1Sym0) sFoo1 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 -Wno-unused-binds -Wno-unused-matches - -Wno-name-shadowing -Wno-unused-imports #-} + -Wno-name-shadowing #-} module Singletons.LetStatements where diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc84.template b/tests/compile-and-dump/Singletons/Maybe.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Maybe.ghc84.template +++ /dev/null @@ -1,145 +0,0 @@ -Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Maybe a - = Nothing | Just a - deriving (Eq, Show) |] - ======> - data Maybe a - = Nothing | Just a - deriving (Eq, Show) - type NothingSym0 = Nothing - type JustSym1 (t :: a0123456789876543210) = Just t - instance SuppressUnusedWarnings JustSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) JustSym0KindInference) GHC.Tuple.()) - data JustSym0 (l :: TyFun a0123456789876543210 (Maybe a0123456789876543210)) - = forall arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => - JustSym0KindInference - type instance Apply JustSym0 l = Just l - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Maybe a0123456789876543210) (t :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Maybe a0123456789876543210) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow (Maybe a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where - Equals_0123456789876543210 Nothing Nothing = TrueSym0 - Equals_0123456789876543210 (Just a) (Just b) = (==) a b - Equals_0123456789876543210 (_ :: Maybe a) (_ :: Maybe a) = FalseSym0 - instance PEq (Maybe a) where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: Maybe a) - where - SNothing :: Sing Nothing - SJust :: forall (n :: a). (Sing (n :: a)) -> Sing (Just n) - type SMaybe = (Sing :: Maybe a -> GHC.Types.Type) - instance SingKind a => SingKind (Maybe a) where - type Demote (Maybe a) = Maybe (Demote a) - fromSing SNothing = Nothing - fromSing (SJust b) = Just (fromSing b) - toSing Nothing = SomeSing SNothing - toSing (Just (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SJust c) } - instance SShow a => SShow (Maybe a) where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) - (t2 :: Maybe a) - (t3 :: GHC.Types.Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Maybe a) (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - SNothing - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Nothing"))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SJust (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Just ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))) - sA_0123456789876543210 - instance SEq a => SEq (Maybe a) where - (%==) SNothing SNothing = STrue - (%==) SNothing (SJust _) = SFalse - (%==) (SJust _) SNothing = SFalse - (%==) (SJust a) (SJust b) = ((%==) a) b - instance SDecide a => SDecide (Maybe a) where - (%~) SNothing SNothing = Proved Refl - (%~) SNothing (SJust _) = Disproved (\ x -> case x of) - (%~) (SJust _) SNothing = Disproved (\ x -> case x of) - (%~) (SJust a) (SJust b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance Data.Singletons.ShowSing.ShowSing a => - Data.Singletons.ShowSing.ShowSing (Maybe a) where - Data.Singletons.ShowSing.showsSingPrec _ SNothing - = showString "SNothing" - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SJust arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SJust ")) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - instance Data.Singletons.ShowSing.ShowSing a => - Show (Sing (z :: Maybe a)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI Nothing where - sing = SNothing - instance SingI n => SingI (Just (n :: a)) where - sing = SJust sing diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc86.template b/tests/compile-and-dump/Singletons/Maybe.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Maybe.ghc86.template @@ -0,0 +1,140 @@ +Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Maybe a + = Nothing | Just a + deriving (Eq, Show) |] + ======> + data Maybe a + = Nothing | Just a + deriving (Eq, Show) + type NothingSym0 = Nothing + type JustSym1 (t0123456789876543210 :: a0123456789876543210) = + Just t0123456789876543210 + instance SuppressUnusedWarnings JustSym0 where + suppressUnusedWarnings = snd (((,) JustSym0KindInference) ()) + data JustSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 (Maybe a0123456789876543210) + where + JustSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => + JustSym0 t0123456789876543210 + type instance Apply JustSym0 t0123456789876543210 = Just t0123456789876543210 + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow (Maybe a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where + Equals_0123456789876543210 Nothing Nothing = TrueSym0 + Equals_0123456789876543210 (Just a) (Just b) = (==) a b + Equals_0123456789876543210 (_ :: Maybe a) (_ :: Maybe a) = FalseSym0 + instance PEq (Maybe a) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: Maybe a -> GHC.Types.Type + where + SNothing :: Sing Nothing + SJust :: forall a (n :: a). (Sing (n :: a)) -> Sing (Just n) + type SMaybe = (Sing :: Maybe a -> GHC.Types.Type) + instance SingKind a => SingKind (Maybe a) where + type Demote (Maybe a) = Maybe (Demote a) + fromSing SNothing = Nothing + fromSing (SJust b) = Just (fromSing b) + toSing Nothing = SomeSing SNothing + toSing (Just (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SJust c) } + instance SShow a => SShow (Maybe a) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) + (t2 :: Maybe a) + (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SNothing + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Nothing"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SJust (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Just ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + instance SEq a => SEq (Maybe a) where + (%==) SNothing SNothing = STrue + (%==) SNothing (SJust _) = SFalse + (%==) (SJust _) SNothing = SFalse + (%==) (SJust a) (SJust b) = ((%==) a) b + instance SDecide a => SDecide (Maybe a) where + (%~) SNothing SNothing = Proved Refl + (%~) SNothing (SJust _) = Disproved (\ x -> case x of) + (%~) (SJust _) SNothing = Disproved (\ x -> case x of) + (%~) (SJust a) (SJust b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + deriving instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: Maybe a)) + instance SingI Nothing where + sing = SNothing + instance SingI n => SingI (Just (n :: a)) where + sing = SJust sing + instance SingI (JustSym0 :: (~>) a (Maybe a)) where + sing = (singFun1 @JustSym0) SJust + instance SingI (TyCon1 Just :: (~>) a (Maybe a)) where + sing = (singFun1 @(TyCon1 Just)) SJust diff --git a/tests/compile-and-dump/Singletons/Nat.ghc84.template b/tests/compile-and-dump/Singletons/Nat.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Nat.ghc84.template +++ /dev/null @@ -1,260 +0,0 @@ -Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| plus :: Nat -> Nat -> Nat - plus Zero m = m - plus (Succ n) m = Succ (plus n m) - pred :: Nat -> Nat - pred Zero = Zero - pred (Succ n) = n - - data Nat - where - Zero :: Nat - Succ :: Nat -> Nat - deriving (Eq, Show, Read, Ord) |] - ======> - data Nat - where - Zero :: Nat - Succ :: Nat -> Nat - deriving (Eq, Show, Read, Ord) - plus :: Nat -> Nat -> Nat - plus Zero m = m - plus (Succ n) m = Succ ((plus n) m) - pred :: Nat -> Nat - pred Zero = Zero - pred (Succ n) = n - type ZeroSym0 = Zero - type SuccSym1 (t :: Nat) = Succ t - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) - data SuccSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type PredSym1 (t :: Nat) = Pred t - instance SuppressUnusedWarnings PredSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PredSym0KindInference) GHC.Tuple.()) - data PredSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => - PredSym0KindInference - type instance Apply PredSym0 l = Pred l - type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t - instance SuppressUnusedWarnings PlusSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PlusSym1KindInference) GHC.Tuple.()) - data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (PlusSym1 l) arg) (PlusSym2 l arg) => - PlusSym1KindInference - type instance Apply (PlusSym1 l) l = Plus l l - instance SuppressUnusedWarnings PlusSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PlusSym0KindInference) GHC.Tuple.()) - data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => - PlusSym0KindInference - type instance Apply PlusSym0 l = PlusSym1 l - type family Pred (a :: Nat) :: Nat where - Pred Zero = ZeroSym0 - Pred (Succ n) = n - type family Plus (a :: Nat) (a :: Nat) :: Nat where - Plus Zero m = m - Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Nat) (t :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Nat) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Nat where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b - Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 - instance PEq Nat where - type (==) a b = Equals_0123456789876543210 a b - sPred :: - forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) - sPlus :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) - sPred SZero = SZero - sPred (SSucc (sN :: Sing n)) = sN - sPlus SZero (sM :: Sing m) = sM - sPlus (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM) - data instance Sing (z :: Nat) - where - SZero :: Sing Zero - SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) - type SNat = (Sing :: Nat -> GHC.Types.Type) - instance SingKind Nat where - type Demote Nat = Nat - fromSing SZero = Zero - fromSing (SSucc b) = Succ (fromSing b) - toSing Zero = SomeSing SZero - toSing (Succ (b :: Demote Nat)) - = case toSing b :: SomeSing Nat of { - SomeSing c -> SomeSing (SSucc c) } - instance SShow Nat => SShow Nat where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Nat) (t3 :: GHC.Types.Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - SZero - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Zero"))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SSucc (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Succ ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))) - sA_0123456789876543210 - instance SOrd Nat => SOrd Nat where - sCompare :: - forall (t1 :: Nat) (t2 :: Nat). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare SZero SZero - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - Data.Singletons.Prelude.Instances.SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing - ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - Data.Singletons.Prelude.Instances.SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - instance SEq Nat => SEq Nat where - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) (SSucc a) (SSucc b) = ((%==) a) b - instance SDecide Nat => SDecide Nat where - (%~) SZero SZero = Proved Refl - (%~) SZero (SSucc _) = Disproved (\ x -> case x of) - (%~) (SSucc _) SZero = Disproved (\ x -> case x of) - (%~) (SSucc a) (SSucc b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance Data.Singletons.ShowSing.ShowSing Nat => - Data.Singletons.ShowSing.ShowSing Nat where - Data.Singletons.ShowSing.showsSingPrec _ SZero = showString "SZero" - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SSucc arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SSucc ")) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - instance Data.Singletons.ShowSing.ShowSing Nat => - Show (Sing (z :: Nat)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing diff --git a/tests/compile-and-dump/Singletons/Nat.ghc86.template b/tests/compile-and-dump/Singletons/Nat.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Nat.ghc86.template @@ -0,0 +1,266 @@ +Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ (plus n m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read, Ord) |] + ======> + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read, Ord) + plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ ((plus n) m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + type ZeroSym0 = Zero + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) + data SuccSym0 :: (~>) Nat Nat + where + SuccSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0 t0123456789876543210 + type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 + type PredSym1 (a0123456789876543210 :: Nat) = + Pred a0123456789876543210 + instance SuppressUnusedWarnings PredSym0 where + suppressUnusedWarnings = snd (((,) PredSym0KindInference) ()) + data PredSym0 :: (~>) Nat Nat + where + PredSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => + PredSym0 a0123456789876543210 + type instance Apply PredSym0 a0123456789876543210 = Pred a0123456789876543210 + type PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Plus a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) PlusSym1KindInference) ()) + data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + PlusSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) => + PlusSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (PlusSym1 a0123456789876543210) a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings PlusSym0 where + suppressUnusedWarnings = snd (((,) PlusSym0KindInference) ()) + data PlusSym0 :: (~>) Nat ((~>) Nat Nat) + where + PlusSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => + PlusSym0 a0123456789876543210 + type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210 + type family Pred (a :: Nat) :: Nat where + Pred Zero = ZeroSym0 + Pred (Succ n) = n + type family Plus (a :: Nat) (a :: Nat) :: Nat where + Plus Zero m = m + Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Nat where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + sPred :: + forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) + sPlus :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) + sPred SZero = SZero + sPred (SSucc (sN :: Sing n)) = sN + sPlus SZero (sM :: Sing m) = sM + sPlus (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM) + instance SingI (PredSym0 :: (~>) Nat Nat) where + sing = (singFun1 @PredSym0) sPred + instance SingI (PlusSym0 :: (~>) Nat ((~>) Nat Nat)) where + sing = (singFun2 @PlusSym0) sPlus + instance SingI d => + SingI (PlusSym1 (d :: Nat) :: (~>) Nat Nat) where + sing = (singFun1 @(PlusSym1 (d :: Nat))) (sPlus (sing @d)) + data instance Sing :: Nat -> GHC.Types.Type + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + instance SShow Nat => SShow Nat where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Nat) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SZero + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Zero"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SSucc (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Succ ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) + -> GHC.Types.Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) + Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + deriving instance Data.Singletons.ShowSing.ShowSing Nat => + Show (Sing (z :: Nat)) + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance SingI (SuccSym0 :: (~>) Nat Nat) where + sing = (singFun1 @SuccSym0) SSucc + instance SingI (TyCon1 Succ :: (~>) Nat Nat) where + sing = (singFun1 @(TyCon1 Succ)) SSucc diff --git a/tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template b/tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template diff --git a/tests/compile-and-dump/Singletons/NatSymbolReflexive.hs b/tests/compile-and-dump/Singletons/NatSymbolReflexive.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/NatSymbolReflexive.hs @@ -0,0 +1,11 @@ +module NatSymbolReflexive where + +import Data.Singletons.Prelude +import Data.Type.Equality ((:~:)(..)) +import GHC.TypeLits + +test1 :: forall (a :: Nat). Sing a -> (a == a) :~: True +test1 _ = Refl + +test2 :: forall (a :: Symbol). Sing a -> (a == a) :~: True +test2 _ = Refl diff --git a/tests/compile-and-dump/Singletons/Operators.ghc84.template b/tests/compile-and-dump/Singletons/Operators.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Operators.ghc84.template +++ /dev/null @@ -1,103 +0,0 @@ -Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| child :: Foo -> Foo - child FLeaf = FLeaf - child (a :+: _) = a - (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - - data Foo - where - FLeaf :: Foo - (:+:) :: Foo -> Foo -> Foo |] - ======> - data Foo - where - FLeaf :: Foo - (:+:) :: Foo -> Foo -> Foo - child :: Foo -> Foo - child FLeaf = FLeaf - child (a :+: _) = a - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - type FLeafSym0 = FLeaf - type (:+:@#@$$$) (t :: Foo) (t :: Foo) = (:+:) t t - instance SuppressUnusedWarnings (:+:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::+:@#@$$###)) GHC.Tuple.()) - data (:+:@#@$$) (l :: Foo) (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ((:+:@#@$$) l) arg) ((:+:@#@$$$) l arg) => - (::+:@#@$$###) - type instance Apply ((:+:@#@$$) l) l = (:+:) l l - instance SuppressUnusedWarnings (:+:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::+:@#@$###)) GHC.Tuple.()) - data (:+:@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => - (::+:@#@$###) - type instance Apply (:+:@#@$) l = (:+:@#@$$) l - type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t - instance SuppressUnusedWarnings (+@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.()) - data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) => - (:+@#@$$###) - type instance Apply ((+@#@$$) l) l = (+) l l - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.()) - data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (:+@#@$###) - type instance Apply (+@#@$) l = (+@#@$$) l - type ChildSym1 (t :: Foo) = Child t - instance SuppressUnusedWarnings ChildSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ChildSym0KindInference) GHC.Tuple.()) - data ChildSym0 (l :: TyFun Foo Foo) - = forall arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => - ChildSym0KindInference - type instance Apply ChildSym0 l = Child l - type family (+) (a :: Nat) (a :: Nat) :: Nat where - (+) Zero m = m - (+) (Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) - type family Child (a :: Foo) :: Foo where - Child FLeaf = FLeafSym0 - Child ((:+:) a _) = a - (%+) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) - sChild :: - forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) - (%+) SZero (sM :: Sing m) = sM - (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) - sChild SFLeaf = SFLeaf - sChild ((:%+:) (sA :: Sing a) _) = sA - data instance Sing (z :: Foo) - where - SFLeaf :: Sing FLeaf - (:%+:) :: forall (n :: Foo) (n :: Foo). - (Sing (n :: Foo)) -> (Sing (n :: Foo)) -> Sing ((:+:) n n) - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing SFLeaf = FLeaf - fromSing ((:%+:) b b) = ((:+:) (fromSing b)) (fromSing b) - toSing FLeaf = SomeSing SFLeaf - toSing ((:+:) (b :: Demote Foo) (b :: Demote Foo)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing Foo)) - (toSing b :: SomeSing Foo) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%+:) c) c) } - instance SingI FLeaf where - sing = SFLeaf - instance (SingI n, SingI n) => - SingI ((:+:) (n :: Foo) (n :: Foo)) where - sing = ((:%+:) sing) sing diff --git a/tests/compile-and-dump/Singletons/Operators.ghc86.template b/tests/compile-and-dump/Singletons/Operators.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Operators.ghc86.template @@ -0,0 +1,128 @@ +Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo |] + ======> + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo + child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + type FLeafSym0 = FLeaf + type (:+:@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = + (:+:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:+:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::+:@#@$$###)) ()) + data (:+:@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo + where + (::+:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:+:@#@$$) t0123456789876543210) arg) ((:+:@#@$$$) t0123456789876543210 arg) => + (:+:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:+:@#@$$) t0123456789876543210) t0123456789876543210 = (:+:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:+:@#@$) where + suppressUnusedWarnings = snd (((,) (::+:@#@$###)) ()) + data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) + where + (::+:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => + (:+:@#@$) t0123456789876543210 + type instance Apply (:+:@#@$) t0123456789876543210 = (:+:@#@$$) t0123456789876543210 + type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (+) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) + data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:+@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => + (+@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) + data (+@#@$) :: (~>) Nat ((~>) Nat Nat) + where + (:+@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (+@#@$) a0123456789876543210 + type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 + type ChildSym1 (a0123456789876543210 :: Foo) = + Child a0123456789876543210 + instance SuppressUnusedWarnings ChildSym0 where + suppressUnusedWarnings = snd (((,) ChildSym0KindInference) ()) + data ChildSym0 :: (~>) Foo Foo + where + ChildSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => + ChildSym0 a0123456789876543210 + type instance Apply ChildSym0 a0123456789876543210 = Child a0123456789876543210 + type family (+) (a :: Nat) (a :: Nat) :: Nat where + (+) 'Zero m = m + (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) + type family Child (a :: Foo) :: Foo where + Child FLeaf = FLeafSym0 + Child ((:+:) a _) = a + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) + sChild :: + forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) + sChild SFLeaf = SFLeaf + sChild ((:%+:) (sA :: Sing a) _) = sA + instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where + sing = (singFun2 @(+@#@$)) (%+) + instance SingI d => + SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where + sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d)) + instance SingI (ChildSym0 :: (~>) Foo Foo) where + sing = (singFun1 @ChildSym0) sChild + data instance Sing :: Foo -> GHC.Types.Type + where + SFLeaf :: Sing FLeaf + (:%+:) :: forall (n :: Foo) (n :: Foo). + (Sing (n :: Foo)) -> (Sing (n :: Foo)) -> Sing ((:+:) n n) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing SFLeaf = FLeaf + fromSing ((:%+:) b b) = ((:+:) (fromSing b)) (fromSing b) + toSing FLeaf = SomeSing SFLeaf + toSing ((:+:) (b :: Demote Foo) (b :: Demote Foo)) + = case + ((,) (toSing b :: SomeSing Foo)) (toSing b :: SomeSing Foo) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%+:) c) c) } + instance SingI FLeaf where + sing = SFLeaf + instance (SingI n, SingI n) => + SingI ((:+:) (n :: Foo) (n :: Foo)) where + sing = ((:%+:) sing) sing + instance SingI ((:+:@#@$) :: (~>) Foo ((~>) Foo Foo)) where + sing = (singFun2 @(:+:@#@$)) (:%+:) + instance SingI (TyCon2 (:+:) :: (~>) Foo ((~>) Foo Foo)) where + sing = (singFun2 @(TyCon2 (:+:))) (:%+:) + instance SingI d => + SingI ((:+:@#@$$) (d :: Foo) :: (~>) Foo Foo) where + sing = (singFun1 @((:+:@#@$$) (d :: Foo))) ((:%+:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:+:) (d :: Foo)) :: (~>) Foo Foo) where + sing = (singFun1 @(TyCon1 ((:+:) (d :: Foo)))) ((:%+:) (sing @d)) 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,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Singletons.Operators where import Data.Singletons diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/OrdDeriving.ghc84.template +++ /dev/null @@ -1,999 +0,0 @@ -Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Nat - = Zero | Succ Nat - deriving (Eq, Ord) - data Foo a b c d - = A a b c d | - B a b c d | - C a b c d | - D a b c d | - E a b c d | - F a b c d - deriving (Eq, Ord) |] - ======> - data Nat - = Zero | Succ Nat - deriving (Eq, Ord) - data Foo a b c d - = A a b c d | - B a b c d | - C a b c d | - D a b c d | - E a b c d | - F a b c d - deriving (Eq, Ord) - type ZeroSym0 = Zero - type SuccSym1 (t :: Nat) = Succ t - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.()) - data SuccSym0 (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0KindInference - type instance Apply SuccSym0 l = Succ l - type ASym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - A t t t t - instance SuppressUnusedWarnings ASym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ASym3KindInference) GHC.Tuple.()) - data ASym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (ASym3 l l l) arg) (ASym4 l l l arg) => - ASym3KindInference - type instance Apply (ASym3 l l l) l = A l l l l - instance SuppressUnusedWarnings ASym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ASym2KindInference) GHC.Tuple.()) - data ASym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ASym2 l l) arg) (ASym3 l l arg) => - ASym2KindInference - type instance Apply (ASym2 l l) l = ASym3 l l l - instance SuppressUnusedWarnings ASym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ASym1KindInference) GHC.Tuple.()) - data ASym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ASym1 l) arg) (ASym2 l arg) => - ASym1KindInference - type instance Apply (ASym1 l) l = ASym2 l l - instance SuppressUnusedWarnings ASym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ASym0KindInference) GHC.Tuple.()) - data ASym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ASym0 arg) (ASym1 arg) => - ASym0KindInference - type instance Apply ASym0 l = ASym1 l - type BSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - B t t t t - instance SuppressUnusedWarnings BSym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BSym3KindInference) GHC.Tuple.()) - data BSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (BSym3 l l l) arg) (BSym4 l l l arg) => - BSym3KindInference - type instance Apply (BSym3 l l l) l = B l l l l - instance SuppressUnusedWarnings BSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BSym2KindInference) GHC.Tuple.()) - data BSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BSym2 l l) arg) (BSym3 l l arg) => - BSym2KindInference - type instance Apply (BSym2 l l) l = BSym3 l l l - instance SuppressUnusedWarnings BSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BSym1KindInference) GHC.Tuple.()) - data BSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (BSym1 l) arg) (BSym2 l arg) => - BSym1KindInference - type instance Apply (BSym1 l) l = BSym2 l l - instance SuppressUnusedWarnings BSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BSym0KindInference) GHC.Tuple.()) - data BSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply BSym0 arg) (BSym1 arg) => - BSym0KindInference - type instance Apply BSym0 l = BSym1 l - type CSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - C t t t t - instance SuppressUnusedWarnings CSym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) CSym3KindInference) GHC.Tuple.()) - data CSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (CSym3 l l l) arg) (CSym4 l l l arg) => - CSym3KindInference - type instance Apply (CSym3 l l l) l = C l l l l - instance SuppressUnusedWarnings CSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) CSym2KindInference) GHC.Tuple.()) - data CSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (CSym2 l l) arg) (CSym3 l l arg) => - CSym2KindInference - type instance Apply (CSym2 l l) l = CSym3 l l l - instance SuppressUnusedWarnings CSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) CSym1KindInference) GHC.Tuple.()) - data CSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (CSym1 l) arg) (CSym2 l arg) => - CSym1KindInference - type instance Apply (CSym1 l) l = CSym2 l l - instance SuppressUnusedWarnings CSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) CSym0KindInference) GHC.Tuple.()) - data CSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply CSym0 arg) (CSym1 arg) => - CSym0KindInference - type instance Apply CSym0 l = CSym1 l - type DSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - D t t t t - instance SuppressUnusedWarnings DSym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DSym3KindInference) GHC.Tuple.()) - data DSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (DSym3 l l l) arg) (DSym4 l l l arg) => - DSym3KindInference - type instance Apply (DSym3 l l l) l = D l l l l - instance SuppressUnusedWarnings DSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DSym2KindInference) GHC.Tuple.()) - data DSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (DSym2 l l) arg) (DSym3 l l arg) => - DSym2KindInference - type instance Apply (DSym2 l l) l = DSym3 l l l - instance SuppressUnusedWarnings DSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DSym1KindInference) GHC.Tuple.()) - data DSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (DSym1 l) arg) (DSym2 l arg) => - DSym1KindInference - type instance Apply (DSym1 l) l = DSym2 l l - instance SuppressUnusedWarnings DSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) DSym0KindInference) GHC.Tuple.()) - data DSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply DSym0 arg) (DSym1 arg) => - DSym0KindInference - type instance Apply DSym0 l = DSym1 l - type ESym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - E t t t t - instance SuppressUnusedWarnings ESym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ESym3KindInference) GHC.Tuple.()) - data ESym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (ESym3 l l l) arg) (ESym4 l l l arg) => - ESym3KindInference - type instance Apply (ESym3 l l l) l = E l l l l - instance SuppressUnusedWarnings ESym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ESym2KindInference) GHC.Tuple.()) - data ESym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ESym2 l l) arg) (ESym3 l l arg) => - ESym2KindInference - type instance Apply (ESym2 l l) l = ESym3 l l l - instance SuppressUnusedWarnings ESym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ESym1KindInference) GHC.Tuple.()) - data ESym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ESym1 l) arg) (ESym2 l arg) => - ESym1KindInference - type instance Apply (ESym1 l) l = ESym2 l l - instance SuppressUnusedWarnings ESym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ESym0KindInference) GHC.Tuple.()) - data ESym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ESym0 arg) (ESym1 arg) => - ESym0KindInference - type instance Apply ESym0 l = ESym1 l - type FSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) = - F t t t t - instance SuppressUnusedWarnings FSym3 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FSym3KindInference) GHC.Tuple.()) - data FSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) - = forall arg. SameKind (Apply (FSym3 l l l) arg) (FSym4 l l l arg) => - FSym3KindInference - type instance Apply (FSym3 l l l) l = F l l l l - instance SuppressUnusedWarnings FSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FSym2KindInference) GHC.Tuple.()) - data FSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FSym2 l l) arg) (FSym3 l l arg) => - FSym2KindInference - type instance Apply (FSym2 l l) l = FSym3 l l l - instance SuppressUnusedWarnings FSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FSym1KindInference) GHC.Tuple.()) - data FSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (FSym1 l) arg) (FSym2 l arg) => - FSym1KindInference - type instance Apply (FSym1 l) l = FSym2 l l - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) - data FSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0KindInference - type instance Apply FSym0 l = FSym1 l - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Nat) (t :: Nat) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where - Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) - Compare_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = LTSym0 - Compare_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = LTSym0 - Compare_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = LTSym0 - Compare_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = LTSym0 - Compare_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = LTSym0 - Compare_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = GTSym0 - Compare_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = LTSym0 - Compare_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = LTSym0 - Compare_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = LTSym0 - Compare_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = LTSym0 - Compare_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = GTSym0 - Compare_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = GTSym0 - Compare_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = LTSym0 - Compare_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = LTSym0 - Compare_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = LTSym0 - Compare_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = GTSym0 - Compare_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = GTSym0 - Compare_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = GTSym0 - Compare_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = LTSym0 - Compare_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = LTSym0 - Compare_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = GTSym0 - Compare_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = GTSym0 - Compare_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = GTSym0 - Compare_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = GTSym0 - Compare_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = LTSym0 - Compare_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = GTSym0 - Compare_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = GTSym0 - Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0 - Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0 - Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd (Foo a b c d) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where - Equals_0123456789876543210 Zero Zero = TrueSym0 - Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b - Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 - instance PEq Nat where - type (==) a b = Equals_0123456789876543210 a b - type family Equals_0123456789876543210 (a :: Foo a b c d) (b :: Foo a b c d) :: Bool where - Equals_0123456789876543210 (A a a a a) (A b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (B a a a a) (B b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (C a a a a) (C b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (D a a a a) (D b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (E a a a a) (E b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (F a a a a) (F b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) - Equals_0123456789876543210 (_ :: Foo a b c d) (_ :: Foo a b c d) = FalseSym0 - instance PEq (Foo a b c d) where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: Nat) - where - SZero :: Sing Zero - SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) - type SNat = (Sing :: Nat -> GHC.Types.Type) - instance SingKind Nat where - type Demote Nat = Nat - fromSing SZero = Zero - fromSing (SSucc b) = Succ (fromSing b) - toSing Zero = SomeSing SZero - toSing (Succ (b :: Demote Nat)) - = case toSing b :: SomeSing Nat of { - SomeSing c -> SomeSing (SSucc c) } - data instance Sing (z :: Foo a b c d) - where - SA :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (A n n n n) - SB :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (B n n n n) - SC :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (C n n n n) - SD :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (D n n n n) - SE :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (E n n n n) - SF :: forall (n :: a) (n :: b) (n :: c) (n :: d). - (Sing (n :: a)) - -> (Sing (n :: b)) - -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (F n n n n) - type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type) - instance (SingKind a, SingKind b, SingKind c, SingKind d) => - SingKind (Foo a b c d) where - type Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d) - fromSing (SA b b b b) - = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SB b b b b) - = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SC b b b b) - = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SD b b b b) - = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SE b b b b) - = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - fromSing (SF b b b b) - = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) - toSing - (A (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SA c) c) c) c) } - toSing - (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SB c) c) c) c) } - toSing - (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SC c) c) c) c) } - toSing - (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SD c) c) c) c) } - toSing - (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SE c) c) c) c) } - toSing - (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) - = case - (((GHC.Tuple.(,,,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing b)) - (toSing b :: SomeSing c)) - (toSing b :: SomeSing d) - of { - GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) - -> SomeSing ((((SF c) c) c) c) } - instance SOrd Nat => SOrd Nat where - sCompare :: - forall (t1 :: Nat) (t2 :: Nat). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare SZero SZero - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - instance (SOrd a, SOrd b, SOrd c, SOrd d) => - SOrd (Foo a b c d) where - sCompare :: - forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare - (SA (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SA (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SB (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SB (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SC (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SC (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SD (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SD (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SE (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SE (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare - (SF (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SF (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)))) - sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT - sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT - sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT - sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT - sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT - instance SEq Nat => SEq Nat where - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) (SSucc a) (SSucc b) = ((%==) a) b - instance SDecide Nat => SDecide Nat where - (%~) SZero SZero = Proved Refl - (%~) SZero (SSucc _) = Disproved (\ x -> case x of) - (%~) (SSucc _) SZero = Disproved (\ x -> case x of) - (%~) (SSucc a) (SSucc b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance (SEq a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where - (%==) (SA a a a a) (SA b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SB a a a a) (SB b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SC a a a a) (SC b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SD a a a a) (SD b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SE a a a a) (SE b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SF a a a a) (SF b b b b) - = ((%&&) (((%==) a) b)) - (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) - instance (SDecide a, SDecide b, SDecide c, SDecide d) => - SDecide (Foo a b c d) where - (%~) (SA a a a a) (SA b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SB a a a a) (SB b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SC a a a a) (SC b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SD a a a a) (SD b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SE a a a a) (SE b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) - (%~) (SF a a a a) (SF b b b b) - = case - (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) - (((%~) a) b) - of - GHC.Tuple.(,,,) (Proved Refl) - (Proved Refl) - (Proved Refl) - (Proved Refl) - -> Proved Refl - GHC.Tuple.(,,,) (Disproved contra) _ _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ (Disproved contra) _ _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,,,) _ _ _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SA sing) sing) sing) sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SB sing) sing) sing) sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SC sing) sing) sing) sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SD sing) sing) sing) sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SE sing) sing) sing) sing - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = (((SF sing) sing) sing) sing diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template @@ -0,0 +1,1235 @@ +Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) + type ZeroSym0 = Zero + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) + data SuccSym0 :: (~>) Nat Nat + where + SuccSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => + SuccSym0 t0123456789876543210 + type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 + type ASym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ASym3KindInference) ()) + data ASym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + ASym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ASym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ASym2KindInference) ()) + data ASym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + ASym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ASym2 t0123456789876543210 t0123456789876543210) arg) (ASym3 t0123456789876543210 t0123456789876543210 arg) => + ASym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ASym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ASym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ASym1KindInference) ()) + data ASym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + ASym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ASym1 t0123456789876543210) arg) (ASym2 t0123456789876543210 arg) => + ASym1 t0123456789876543210 t0123456789876543210 + type instance Apply (ASym1 t0123456789876543210) t0123456789876543210 = ASym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ASym0 where + suppressUnusedWarnings = snd (((,) ASym0KindInference) ()) + data ASym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + ASym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply ASym0 arg) (ASym1 arg) => + ASym0 t0123456789876543210 + type instance Apply ASym0 t0123456789876543210 = ASym1 t0123456789876543210 + type BSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BSym3KindInference) ()) + data BSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + BSym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BSym2KindInference) ()) + data BSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + BSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BSym2 t0123456789876543210 t0123456789876543210) arg) (BSym3 t0123456789876543210 t0123456789876543210 arg) => + BSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BSym1KindInference) ()) + data BSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + BSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BSym1 t0123456789876543210) arg) (BSym2 t0123456789876543210 arg) => + BSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BSym1 t0123456789876543210) t0123456789876543210 = BSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BSym0 where + suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) + data BSym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + BSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BSym0 arg) (BSym1 arg) => + BSym0 t0123456789876543210 + type instance Apply BSym0 t0123456789876543210 = BSym1 t0123456789876543210 + type CSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) CSym3KindInference) ()) + data CSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + CSym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (CSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) CSym2KindInference) ()) + data CSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + CSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (CSym2 t0123456789876543210 t0123456789876543210) arg) (CSym3 t0123456789876543210 t0123456789876543210 arg) => + CSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (CSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (CSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) CSym1KindInference) ()) + data CSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + CSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (CSym1 t0123456789876543210) arg) (CSym2 t0123456789876543210 arg) => + CSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (CSym1 t0123456789876543210) t0123456789876543210 = CSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings CSym0 where + suppressUnusedWarnings = snd (((,) CSym0KindInference) ()) + data CSym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + CSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply CSym0 arg) (CSym1 arg) => + CSym0 t0123456789876543210 + type instance Apply CSym0 t0123456789876543210 = CSym1 t0123456789876543210 + type DSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) DSym3KindInference) ()) + data DSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + DSym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (DSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) DSym2KindInference) ()) + data DSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + DSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (DSym2 t0123456789876543210 t0123456789876543210) arg) (DSym3 t0123456789876543210 t0123456789876543210 arg) => + DSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (DSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (DSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) DSym1KindInference) ()) + data DSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + DSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (DSym1 t0123456789876543210) arg) (DSym2 t0123456789876543210 arg) => + DSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (DSym1 t0123456789876543210) t0123456789876543210 = DSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings DSym0 where + suppressUnusedWarnings = snd (((,) DSym0KindInference) ()) + data DSym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + DSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply DSym0 arg) (DSym1 arg) => + DSym0 t0123456789876543210 + type instance Apply DSym0 t0123456789876543210 = DSym1 t0123456789876543210 + type ESym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ESym3KindInference) ()) + data ESym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + ESym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ESym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ESym2KindInference) ()) + data ESym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + ESym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ESym2 t0123456789876543210 t0123456789876543210) arg) (ESym3 t0123456789876543210 t0123456789876543210 arg) => + ESym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ESym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (ESym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ESym1KindInference) ()) + data ESym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + ESym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ESym1 t0123456789876543210) arg) (ESym2 t0123456789876543210 arg) => + ESym1 t0123456789876543210 t0123456789876543210 + type instance Apply (ESym1 t0123456789876543210) t0123456789876543210 = ESym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ESym0 where + suppressUnusedWarnings = snd (((,) ESym0KindInference) ()) + data ESym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + ESym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply ESym0 arg) (ESym1 arg) => + ESym0 t0123456789876543210 + type instance Apply ESym0 t0123456789876543210 = ESym1 t0123456789876543210 + type FSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FSym3KindInference) ()) + data FSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + where + FSym3KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (FSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FSym2KindInference) ()) + data FSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 + d0123456789876543210. + (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) + where + FSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (FSym2 t0123456789876543210 t0123456789876543210) arg) (FSym3 t0123456789876543210 t0123456789876543210 arg) => + FSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (FSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (FSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FSym1KindInference) ()) + data FSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + FSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (FSym1 t0123456789876543210) arg) (FSym2 t0123456789876543210 arg) => + FSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (FSym1 t0123456789876543210) t0123456789876543210 = FSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) + where + FSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 t0123456789876543210 + type instance Apply FSym0 t0123456789876543210 = FSym1 t0123456789876543210 + type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where + Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 Zero (Succ _) = LTSym0 + Compare_0123456789876543210 (Succ _) Zero = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Nat where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where + Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) + Compare_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = LTSym0 + Compare_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = GTSym0 + Compare_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = LTSym0 + Compare_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0 + Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) :: (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) ((~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd (Foo a b c d) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789876543210 Zero Zero = TrueSym0 + Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b + Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 + instance PEq Nat where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: Foo a b c d) (b :: Foo a b c d) :: Bool where + Equals_0123456789876543210 (A a a a a) (A b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (B a a a a) (B b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (C a a a a) (C b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (D a a a a) (D b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (E a a a a) (E b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (F a a a a) (F b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) + Equals_0123456789876543210 (_ :: Foo a b c d) (_ :: Foo a b c d) = FalseSym0 + instance PEq (Foo a b c d) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: Nat -> GHC.Types.Type + where + SZero :: Sing Zero + SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind Nat where + type Demote Nat = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ (b :: Demote Nat)) + = case toSing b :: SomeSing Nat of { + SomeSing c -> SomeSing (SSucc c) } + data instance Sing :: Foo a b c d -> GHC.Types.Type + where + SA :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (A n n n n) + SB :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (B n n n n) + SC :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (C n n n n) + SD :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (D n n n n) + SE :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (E n n n n) + SF :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). + (Sing (n :: a)) + -> (Sing (n :: b)) + -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (F n n n n) + type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type) + instance (SingKind a, SingKind b, SingKind c, SingKind d) => + SingKind (Foo a b c d) where + type Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d) + fromSing (SA b b b b) + = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SB b b b b) + = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SC b b b b) + = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SD b b b b) + = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SE b b b b) + = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + fromSing (SF b b b b) + = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) + toSing + (A (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SA c) c) c) c) } + toSing + (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SB c) c) c) c) } + toSing + (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SC c) c) c) c) } + toSing + (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SD c) c) c) c) } + toSing + (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SE c) c) c) c) } + toSing + (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) + = case + ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) + (toSing b :: SomeSing c)) + (toSing b :: SomeSing d) + of { + (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing ((((SF c) c) c) c) } + instance SOrd Nat => SOrd Nat where + sCompare :: + forall (t1 :: Nat) (t2 :: Nat). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) + -> GHC.Types.Type) t1) t2) + sCompare SZero SZero + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare SZero (SSucc _) = SLT + sCompare (SSucc _) SZero = SGT + instance (SOrd a, SOrd b, SOrd c, SOrd d) => + SOrd (Foo a b c d) where + sCompare :: + forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) ((~>) (Foo a b c d) Ordering) + -> GHC.Types.Type) t1) t2) + sCompare + (SA (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SA (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SB (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SB (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SC (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SC (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SD (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SD (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SE (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SE (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare + (SF (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SF (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)))) + sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT + sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT + sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT + sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT + sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT + instance SEq Nat => SEq Nat where + (%==) SZero SZero = STrue + (%==) SZero (SSucc _) = SFalse + (%==) (SSucc _) SZero = SFalse + (%==) (SSucc a) (SSucc b) = ((%==) a) b + instance SDecide Nat => SDecide Nat where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) = Disproved (\ x -> case x of) + (%~) (SSucc _) SZero = Disproved (\ x -> case x of) + (%~) (SSucc a) (SSucc b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance (SEq a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where + (%==) (SA a a a a) (SA b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SB a a a a) (SB b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SC a a a a) (SC b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SD a a a a) (SD b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SE a a a a) (SE b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse + (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse + (%==) (SF a a a a) (SF b b b b) + = ((%&&) (((%==) a) b)) + (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) + instance (SDecide a, SDecide b, SDecide c, SDecide d) => + SDecide (Foo a b c d) where + (%~) (SA a a a a) (SA b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB a a a a) (SB b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC a a a a) (SC b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD a a a a) (SD b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SE a a a a) (SE b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) + (%~) (SF a a a a) (SF b b b b) + = case + ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) + of + (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) + -> Proved Refl + (,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance SingI (SuccSym0 :: (~>) Nat Nat) where + sing = (singFun1 @SuccSym0) SSucc + instance SingI (TyCon1 Succ :: (~>) Nat Nat) where + sing = (singFun1 @(TyCon1 Succ)) SSucc + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SA sing) sing) sing) sing + instance SingI (ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @ASym0) SA + instance SingI (TyCon4 A :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 A)) SA + instance SingI d => + SingI (ASym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(ASym1 (d :: a))) (SA (sing @d)) + instance SingI d => + SingI (TyCon3 (A (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (A (d :: a)))) (SA (sing @d)) + instance (SingI d, SingI d) => + SingI (ASym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(ASym2 (d :: a) (d :: b))) ((SA (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (A (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (A (d :: a) (d :: b)))) + ((SA (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (ASym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(ASym3 (d :: a) (d :: b) (d :: c))) + (((SA (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (A (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (A (d :: a) (d :: b) (d :: c)))) + (((SA (sing @d)) (sing @d)) (sing @d)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SB sing) sing) sing) sing + instance SingI (BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @BSym0) SB + instance SingI (TyCon4 B :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 B)) SB + instance SingI d => + SingI (BSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(BSym1 (d :: a))) (SB (sing @d)) + instance SingI d => + SingI (TyCon3 (B (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (B (d :: a)))) (SB (sing @d)) + instance (SingI d, SingI d) => + SingI (BSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(BSym2 (d :: a) (d :: b))) ((SB (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (B (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (B (d :: a) (d :: b)))) + ((SB (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (BSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(BSym3 (d :: a) (d :: b) (d :: c))) + (((SB (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (B (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (B (d :: a) (d :: b) (d :: c)))) + (((SB (sing @d)) (sing @d)) (sing @d)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SC sing) sing) sing) sing + instance SingI (CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @CSym0) SC + instance SingI (TyCon4 C :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 C)) SC + instance SingI d => + SingI (CSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(CSym1 (d :: a))) (SC (sing @d)) + instance SingI d => + SingI (TyCon3 (C (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (C (d :: a)))) (SC (sing @d)) + instance (SingI d, SingI d) => + SingI (CSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(CSym2 (d :: a) (d :: b))) ((SC (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (C (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (C (d :: a) (d :: b)))) + ((SC (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (CSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(CSym3 (d :: a) (d :: b) (d :: c))) + (((SC (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (C (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (C (d :: a) (d :: b) (d :: c)))) + (((SC (sing @d)) (sing @d)) (sing @d)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SD sing) sing) sing) sing + instance SingI (DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @DSym0) SD + instance SingI (TyCon4 D :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 D)) SD + instance SingI d => + SingI (DSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(DSym1 (d :: a))) (SD (sing @d)) + instance SingI d => + SingI (TyCon3 (D (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (D (d :: a)))) (SD (sing @d)) + instance (SingI d, SingI d) => + SingI (DSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(DSym2 (d :: a) (d :: b))) ((SD (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (D (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (D (d :: a) (d :: b)))) + ((SD (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (DSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(DSym3 (d :: a) (d :: b) (d :: c))) + (((SD (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (D (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (D (d :: a) (d :: b) (d :: c)))) + (((SD (sing @d)) (sing @d)) (sing @d)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SE sing) sing) sing) sing + instance SingI (ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @ESym0) SE + instance SingI (TyCon4 E :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 E)) SE + instance SingI d => + SingI (ESym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(ESym1 (d :: a))) (SE (sing @d)) + instance SingI d => + SingI (TyCon3 (E (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (E (d :: a)))) (SE (sing @d)) + instance (SingI d, SingI d) => + SingI (ESym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(ESym2 (d :: a) (d :: b))) ((SE (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (E (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (E (d :: a) (d :: b)))) + ((SE (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (ESym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(ESym3 (d :: a) (d :: b) (d :: c))) + (((SE (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (E (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (E (d :: a) (d :: b) (d :: c)))) + (((SE (sing @d)) (sing @d)) (sing @d)) + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = (((SF sing) sing) sing) sing + instance SingI (FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @FSym0) SF + instance SingI (TyCon4 F :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where + sing = (singFun4 @(TyCon4 F)) SF + instance SingI d => + SingI (FSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(FSym1 (d :: a))) (SF (sing @d)) + instance SingI d => + SingI (TyCon3 (F (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where + sing = (singFun3 @(TyCon3 (F (d :: a)))) (SF (sing @d)) + instance (SingI d, SingI d) => + SingI (FSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(FSym2 (d :: a) (d :: b))) ((SF (sing @d)) (sing @d)) + instance (SingI d, SingI d) => + SingI (TyCon2 (F (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where + sing + = (singFun2 @(TyCon2 (F (d :: a) (d :: b)))) + ((SF (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (FSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(FSym3 (d :: a) (d :: b) (d :: c))) + (((SF (sing @d)) (sing @d)) (sing @d)) + instance (SingI d, SingI d, SingI d) => + SingI (TyCon1 (F (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where + sing + = (singFun1 @(TyCon1 (F (d :: a) (d :: b) (d :: c)))) + (((SF (sing @d)) (sing @d)) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc84.template +++ /dev/null @@ -1,31 +0,0 @@ -Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| symId :: Symbol -> Symbol - symId x = x - foo :: Symbol - foo = symId "foo" |] - ======> - symId :: Symbol -> Symbol - symId x = x - foo :: Symbol - foo = symId "foo" - type SymIdSym1 (t :: Symbol) = SymId t - instance SuppressUnusedWarnings SymIdSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SymIdSym0KindInference) GHC.Tuple.()) - data SymIdSym0 (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => - SymIdSym0KindInference - type instance Apply SymIdSym0 l = SymId l - type FooSym0 = Foo - type family SymId (a :: Symbol) :: Symbol where - SymId x = x - type family Foo :: Symbol where - Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") - sSymId :: - forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol) - sFoo :: Sing (FooSym0 :: Symbol) - sSymId (sX :: Sing x) = sX - sFoo - = (applySing ((singFun1 @SymIdSym0) sSymId)) - (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo")) diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template @@ -0,0 +1,35 @@ +Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| symId :: Symbol -> Symbol + symId x = x + foo :: Symbol + foo = symId "foo" |] + ======> + symId :: Symbol -> Symbol + symId x = x + foo :: Symbol + foo = symId "foo" + type SymIdSym1 (a0123456789876543210 :: Symbol) = + SymId a0123456789876543210 + instance SuppressUnusedWarnings SymIdSym0 where + suppressUnusedWarnings = snd (((,) SymIdSym0KindInference) ()) + data SymIdSym0 :: (~>) Symbol Symbol + where + SymIdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => + SymIdSym0 a0123456789876543210 + type instance Apply SymIdSym0 a0123456789876543210 = SymId a0123456789876543210 + type FooSym0 = Foo + type family SymId (a :: Symbol) :: Symbol where + SymId x = x + type family Foo :: Symbol where + Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") + sSymId :: + forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol) + sFoo :: Sing (FooSym0 :: Symbol) + sSymId (sX :: Sing x) = sX + sFoo + = (applySing ((singFun1 @SymIdSym0) sSymId)) + (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo")) + instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where + sing = (singFun1 @SymIdSym0) sSymId diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PatternMatching.ghc84.template +++ /dev/null @@ -1,544 +0,0 @@ -Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| pr = Pair (Succ Zero) ([Zero]) - complex = Pair (Pair (Just Zero) Zero) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - - data Pair a b - = Pair a b - deriving Show |] - ======> - data Pair a b - = Pair a b - deriving Show - pr = (Pair (Succ Zero)) [Zero] - complex = (Pair ((Pair (Just Zero)) Zero)) False - tuple = (False, Just Zero, True) - aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - Pair t t - instance SuppressUnusedWarnings PairSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.()) - data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) => - PairSym1KindInference - type instance Apply (PairSym1 l) l = Pair l l - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.()) - data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0KindInference - type instance Apply PairSym0 l = PairSym1 l - type AListSym0 = AList - type TupleSym0 = Tuple - type ComplexSym0 = Complex - type PrSym0 = Pr - type family AList where - AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) - type family Tuple where - Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 - type family Complex where - Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 - type family Pr where - Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow (Pair a b) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - sAList :: Sing AListSym0 - sTuple :: Sing TupleSym0 - sComplex :: Sing ComplexSym0 - sPr :: Sing PrSym0 - sAList - = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - SNil)) - sTuple - = (applySing - ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - STrue - sComplex - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @JustSym0) SJust)) SZero))) - SZero))) - SFalse - sPr - = (applySing - ((applySing ((singFun2 @PairSym0) SPair)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) - data instance Sing (z :: Pair a b) - where - SPair :: forall (n :: a) (n :: b). - (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) - type SPair = (Sing :: Pair a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind (Pair a b) where - type Demote (Pair a b) = Pair (Demote a) (Demote b) - fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) - toSing (Pair (b :: Demote a) (b :: Demote b)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } - instance (SShow a, SShow b) => SShow (Pair a b) where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Pair a b) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Pair ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - instance (Data.Singletons.ShowSing.ShowSing a, - Data.Singletons.ShowSing.ShowSing b) => - Data.Singletons.ShowSing.ShowSing (Pair a b) where - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SPair arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SPair ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - (((.) GHC.Show.showSpace) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)))) - instance (Data.Singletons.ShowSing.ShowSing a, - Data.Singletons.ShowSing.ShowSing b) => - Show (Sing (z :: Pair a b)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where - sing = (SPair sing) sing -Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| Pair sz lz = pr - Pair (Pair jz zz) fls = complex - (tf, tjz, tt) = tuple - [_, lsz, (Succ blimy)] = aList - lsz :: Nat - fls :: Bool - foo1 :: (a, b) -> a - foo1 (x, y) = (\ _ -> x) y - foo2 :: (# a, b #) -> a - foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } - silly :: a -> () - silly x = case x of { _ -> () } |] - ======> - Pair sz lz = pr - Pair (Pair jz zz) fls = complex - (tf, tjz, tt) = tuple - [_, lsz, Succ blimy] = aList - lsz :: Nat - fls :: Bool - foo1 :: (a, b) -> a - foo1 (x, y) = (\ _ -> x) y - foo2 :: (# a, b #) -> a - foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } - silly :: a -> () - silly x = case x of { _ -> GHC.Tuple.() } - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x _ = Tuple0Sym0 - type Let0123456789876543210TSym2 t t = Let0123456789876543210T t t - instance SuppressUnusedWarnings Let0123456789876543210TSym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210TSym1KindInference) - GHC.Tuple.()) - data Let0123456789876543210TSym1 l l - = forall arg. SameKind (Apply (Let0123456789876543210TSym1 l) arg) (Let0123456789876543210TSym2 l arg) => - Let0123456789876543210TSym1KindInference - type instance Apply (Let0123456789876543210TSym1 l) l = Let0123456789876543210T l l - instance SuppressUnusedWarnings Let0123456789876543210TSym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Let0123456789876543210TSym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210TSym0 l - = forall arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => - Let0123456789876543210TSym0KindInference - type instance Apply Let0123456789876543210TSym0 l = Let0123456789876543210TSym1 l - type family Let0123456789876543210T x y where - Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y - type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where - Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a - type family Lambda_0123456789876543210 x y a b t where - Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym5 t t t t t = - Lambda_0123456789876543210 t t t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym4 l l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) => - Lambda_0123456789876543210Sym4KindInference - type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym3 l l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) => - Lambda_0123456789876543210Sym3KindInference - type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 x y t where - Case_0123456789876543210 x y '(a, - b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _ = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 t t t = - Lambda_0123456789876543210 t t t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym2 l l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) => - Lambda_0123456789876543210Sym2KindInference - type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym1 l l - = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) => - Lambda_0123456789876543210Sym1KindInference - type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - y_0123456789876543210, - Succ _] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - _, - Succ y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(y_0123456789876543210, - _, - _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(_, - y_0123456789876543210, - _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '(_, - _, - y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair y_0123456789876543210 _) _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair _ y_0123456789876543210) _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair (Pair _ _) y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair y_0123456789876543210 _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Pair _ y_0123456789876543210) = y_0123456789876543210 - type SillySym1 (t :: a0123456789876543210) = Silly t - instance SuppressUnusedWarnings SillySym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) SillySym0KindInference) GHC.Tuple.()) - data SillySym0 (l :: TyFun a0123456789876543210 ()) - = forall arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => - SillySym0KindInference - type instance Apply SillySym0 l = Silly l - type Foo2Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = - Foo2 t - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun (a0123456789876543210, - b0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0KindInference - type instance Apply Foo2Sym0 l = Foo2 l - type Foo1Sym1 (t :: (a0123456789876543210, b0123456789876543210)) = - Foo1 t - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun (a0123456789876543210, - b0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0KindInference - type instance Apply Foo1Sym0 l = Foo1 l - type LszSym0 = Lsz - type BlimySym0 = Blimy - type TfSym0 = Tf - type TjzSym0 = Tjz - type TtSym0 = Tt - type JzSym0 = Jz - type ZzSym0 = Zz - type FlsSym0 = Fls - type SzSym0 = Sz - type LzSym0 = Lz - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type family Silly (a :: a) :: () where - Silly x = Case_0123456789876543210 x x - type family Foo2 (a :: (a, b)) :: a where - Foo2 '(x, - y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) - type family Foo1 (a :: (a, b)) :: a where - Foo1 '(x, - y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Lsz :: Nat where - Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Blimy where - Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tf where - Tf = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tjz where - Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tt where - Tt = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Jz where - Jz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Zz where - Zz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Fls :: Bool where - Fls = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Sz where - Sz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Lz where - Lz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = PrSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = ComplexSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = TupleSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = AListSym0 - sSilly :: forall (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) - sFoo2 :: - forall (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) - sFoo1 :: - forall (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) - sLsz :: Sing (LszSym0 :: Nat) - sBlimy :: Sing BlimySym0 - sTf :: Sing TfSym0 - sTjz :: Sing TjzSym0 - sTt :: Sing TtSym0 - sJz :: Sing JzSym0 - sZz :: Sing ZzSym0 - sFls :: Sing (FlsSym0 :: Bool) - sSz :: Sing SzSym0 - sLz :: Sing LzSym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sSilly (sX :: Sing x) - = case sX of { _ -> STuple0 } :: - Sing (Case_0123456789876543210 x x :: ()) - sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) - = let - sT :: Sing (Let0123456789876543210TSym2 x y) - sT - = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY - in case sT of { - STuple2 (sA :: Sing a) (sB :: Sing b) - -> (applySing - ((singFun1 - @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sA } :: - Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) }))) - sB } :: - Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a) - sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) - = (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of { - _ :: Sing arg_0123456789876543210 - -> case sArg_0123456789876543210 of { _ -> sX } :: - Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) - sY - sLsz - = case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons (SSucc _) SNil)) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat) - sBlimy - = case sX_0123456789876543210 of { - SCons _ - (SCons _ - (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) - SNil)) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTf - = case sX_0123456789876543210 of { - STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTjz - = case sX_0123456789876543210 of { - STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sTt - = case sX_0123456789876543210 of { - STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sJz - = case sX_0123456789876543210 of { - SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) - _) - _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sZz - = case sX_0123456789876543210 of { - SPair (SPair _ - (sY_0123456789876543210 :: Sing y_0123456789876543210)) - _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sFls - = case sX_0123456789876543210 of { - SPair (SPair _ _) - (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sSz - = case sX_0123456789876543210 of { - SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sLz - = case sX_0123456789876543210 of { - SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0) - sX_0123456789876543210 = sPr - sX_0123456789876543210 = sComplex - sX_0123456789876543210 = sTuple - sX_0123456789876543210 = sAList diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template @@ -0,0 +1,574 @@ +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving Show |] + ======> + data Pair a b + = Pair a b + deriving Show + pr = (Pair (Succ Zero)) [Zero] + complex = (Pair ((Pair (Just Zero)) Zero)) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) + data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + where + PairSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => + PairSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210 + b0123456789876543210. + (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow (Pair a b) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + SNil)) + sTuple + = (applySing + ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + STrue + sComplex + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @JustSym0) SJust)) SZero))) + SZero))) + SFalse + sPr + = (applySing + ((applySing ((singFun2 @PairSym0) SPair)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) + data instance Sing :: Pair a b -> GHC.Types.Type + where + SPair :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) + toSing (Pair (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } + instance (SShow a, SShow b) => SShow (Pair a b) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Pair ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + deriving instance (Data.Singletons.ShowSing.ShowSing a, + Data.Singletons.ShowSing.ShowSing b) => + Show (Sing (z :: Pair a b)) + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = (SPair sing) sing + instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @PairSym0) SPair + instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @(TyCon2 Pair)) SPair + instance SingI d => + SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where + sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d)) + instance SingI d => + SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where + sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d)) +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, (Succ blimy)] = aList + lsz :: Nat + fls :: Bool + foo1 :: (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: a -> () + silly x = case x of { _ -> () } |] + ======> + Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, Succ blimy] = aList + lsz :: Nat + fls :: Bool + foo1 :: (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: a -> () + silly x = case x of { _ -> () } + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x _ = Tuple0Sym0 + type Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 = + Let0123456789876543210T x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210TSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210TSym1KindInference) ()) + data Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 + where + Let0123456789876543210TSym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210TSym1 x0123456789876543210) arg) (Let0123456789876543210TSym2 x0123456789876543210 arg) => + Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Let0123456789876543210TSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210TSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210TSym0KindInference) ()) + data Let0123456789876543210TSym0 x0123456789876543210 + where + Let0123456789876543210TSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => + Let0123456789876543210TSym0 x0123456789876543210 + type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 + type family Let0123456789876543210T x y where + Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y + type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where + Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a + type family Lambda_0123456789876543210 x y a b t where + Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 + y0123456789876543210 + a0123456789876543210 + b0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + y0123456789876543210 + a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 y0123456789876543210 x0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 x y t where + Case_0123456789876543210 x y '(a, + b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b + type family Case_0123456789876543210 x y arg_0123456789876543210 t where + Case_0123456789876543210 x y arg_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + y_0123456789876543210, + 'Succ _] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + _, + 'Succ y_0123456789876543210] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(y_0123456789876543210, + _, + _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(_, + y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(_, + _, + y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Pair ( 'Pair y_0123456789876543210 _) _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Pair ( 'Pair _ y_0123456789876543210) _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Pair ( 'Pair _ _) y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Pair y_0123456789876543210 _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Pair _ y_0123456789876543210) = y_0123456789876543210 + type SillySym1 (a0123456789876543210 :: a0123456789876543210) = + Silly a0123456789876543210 + instance SuppressUnusedWarnings SillySym0 where + suppressUnusedWarnings = snd (((,) SillySym0KindInference) ()) + data SillySym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 () + where + SillySym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => + SillySym0 a0123456789876543210 + type instance Apply SillySym0 a0123456789876543210 = Silly a0123456789876543210 + type Foo2Sym1 (a0123456789876543210 :: (a0123456789876543210, + b0123456789876543210)) = + Foo2 a0123456789876543210 + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) + data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) (a0123456789876543210, + b0123456789876543210) a0123456789876543210 + where + Foo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0 a0123456789876543210 + type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 + type Foo1Sym1 (a0123456789876543210 :: (a0123456789876543210, + b0123456789876543210)) = + Foo1 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) (a0123456789876543210, + b0123456789876543210) a0123456789876543210 + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 + type LszSym0 = Lsz + type BlimySym0 = Blimy + type TfSym0 = Tf + type TjzSym0 = Tjz + type TtSym0 = Tt + type JzSym0 = Jz + type ZzSym0 = Zz + type FlsSym0 = Fls + type SzSym0 = Sz + type LzSym0 = Lz + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type family Silly (a :: a) :: () where + Silly x = Case_0123456789876543210 x x + type family Foo2 (a :: (a, b)) :: a where + Foo2 '(x, + y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) + type family Foo1 (a :: (a, b)) :: a where + Foo1 '(x, + y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y + type family Lsz :: Nat where + Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Blimy where + Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tf where + Tf = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tjz where + Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tt where + Tt = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Jz where + Jz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Zz where + Zz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Fls :: Bool where + Fls = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Sz where + Sz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Lz where + Lz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = PrSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = ComplexSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = TupleSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = AListSym0 + sSilly :: + forall a (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) + sFoo2 :: + forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) + sFoo1 :: + forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) + sLsz :: Sing (LszSym0 :: Nat) + sBlimy :: Sing BlimySym0 + sTf :: Sing TfSym0 + sTjz :: Sing TjzSym0 + sTt :: Sing TtSym0 + sJz :: Sing JzSym0 + sZz :: Sing ZzSym0 + sFls :: Sing (FlsSym0 :: Bool) + sSz :: Sing SzSym0 + sLz :: Sing LzSym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sSilly (sX :: Sing x) + = (case sX of { _ -> STuple0 }) :: + Sing (Case_0123456789876543210 x x :: ()) + sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) + = let + sT :: Sing (Let0123456789876543210TSym2 x y) + sT + = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY + in (case sT of { + STuple2 (sA :: Sing a) (sB :: Sing b) + -> (applySing + ((singFun1 + @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sA }) :: + Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) }))) + sB }) :: + Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a) + sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) + = (applySing + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sX }) :: + Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) + sY + sLsz + = (case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons (SSucc _) SNil)) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat) + sBlimy + = (case sX_0123456789876543210 of { + SCons _ + (SCons _ + (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) + SNil)) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTf + = (case sX_0123456789876543210 of { + STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTjz + = (case sX_0123456789876543210 of { + STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sTt + = (case sX_0123456789876543210 of { + STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sJz + = (case sX_0123456789876543210 of { + SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) + _) + _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sZz + = (case sX_0123456789876543210 of { + SPair (SPair _ + (sY_0123456789876543210 :: Sing y_0123456789876543210)) + _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sFls + = (case sX_0123456789876543210 of { + SPair (SPair _ _) + (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sSz + = (case sX_0123456789876543210 of { + SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sLz + = (case sX_0123456789876543210 of { + SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0) + sX_0123456789876543210 = sPr + sX_0123456789876543210 = sComplex + sX_0123456789876543210 = sTuple + sX_0123456789876543210 = sAList + instance SingI (SillySym0 :: (~>) a ()) where + sing = (singFun1 @SillySym0) sSilly + instance SingI (Foo2Sym0 :: (~>) (a, b) a) where + sing = (singFun1 @Foo2Sym0) sFoo2 + instance SingI (Foo1Sym0 :: (~>) (a, b) a) where + sing = (singFun1 @Foo1Sym0) sFoo1 diff --git a/tests/compile-and-dump/Singletons/PolyKinds.ghc84.template b/tests/compile-and-dump/Singletons/PolyKinds.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PolyKinds.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/PolyKinds.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PolyKinds.ghc86.template @@ -0,0 +1,28 @@ +Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Cls (a :: k) where + fff :: Proxy (a :: k) -> () |] + ======> + class Cls (a :: k) where + fff :: Proxy (a :: k) -> () + type FffSym1 (arg0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) = + Fff arg0123456789876543210 + instance SuppressUnusedWarnings FffSym0 where + suppressUnusedWarnings = snd (((,) FffSym0KindInference) ()) + data FffSym0 :: forall k0123456789876543210 + (a0123456789876543210 :: k0123456789876543210). + (~>) (Proxy (a0123456789876543210 :: k0123456789876543210)) () + where + FffSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) => + FffSym0 arg0123456789876543210 + type instance Apply FffSym0 arg0123456789876543210 = Fff arg0123456789876543210 + class PCls (a :: k) where + type Fff (arg :: Proxy (a :: k)) :: () + class SCls (a :: k) where + sFff :: + forall (t :: Proxy (a :: k)). + Sing t -> Sing (Apply FffSym0 t :: ()) + instance SCls a => + SingI (FffSym0 :: (~>) (Proxy (a :: k)) ()) where + sing = (singFun1 @FffSym0) sFff diff --git a/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.template b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/PolyKindsApp.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.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 :: forall b. Sing (FffSym0 :: (a :: k -> Type) (b :: k)) diff --git a/tests/compile-and-dump/Singletons/PolyKindsApp.hs b/tests/compile-and-dump/Singletons/PolyKindsApp.hs --- a/tests/compile-and-dump/Singletons/PolyKindsApp.hs +++ b/tests/compile-and-dump/Singletons/PolyKindsApp.hs @@ -1,6 +1,6 @@ module Singletons.PolyKindsApp where -import Data.Kind +import Data.Kind (Type) import Data.Singletons.TH $(singletons [d| diff --git a/tests/compile-and-dump/Singletons/Records.ghc84.template b/tests/compile-and-dump/Singletons/Records.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Records.ghc84.template +++ /dev/null @@ -1,61 +0,0 @@ -Singletons/Records.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] - ======> - data Record a = MkRecord {field1 :: a, field2 :: Bool} - type Field1Sym1 (t :: Record a0123456789876543210) = Field1 t - instance SuppressUnusedWarnings Field1Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Field1Sym0KindInference) GHC.Tuple.()) - data Field1Sym0 (l :: TyFun (Record a0123456789876543210) a0123456789876543210) - = forall arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => - Field1Sym0KindInference - type instance Apply Field1Sym0 l = Field1 l - type Field2Sym1 (t :: Record a0123456789876543210) = Field2 t - instance SuppressUnusedWarnings Field2Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) Field2Sym0KindInference) GHC.Tuple.()) - data Field2Sym0 (l :: TyFun (Record a0123456789876543210) Bool) - = forall arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => - Field2Sym0KindInference - type instance Apply Field2Sym0 l = Field2 l - type family Field1 (a :: Record a) :: a where - Field1 (MkRecord field _) = field - type family Field2 (a :: Record a) :: Bool where - Field2 (MkRecord _ field) = field - type MkRecordSym2 (t :: a0123456789876543210) (t :: Bool) = - MkRecord t t - instance SuppressUnusedWarnings MkRecordSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkRecordSym1KindInference) GHC.Tuple.()) - data MkRecordSym1 (l :: a0123456789876543210) (l :: TyFun Bool (Record a0123456789876543210)) - = forall arg. SameKind (Apply (MkRecordSym1 l) arg) (MkRecordSym2 l arg) => - MkRecordSym1KindInference - type instance Apply (MkRecordSym1 l) l = MkRecord l l - instance SuppressUnusedWarnings MkRecordSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkRecordSym0KindInference) GHC.Tuple.()) - data MkRecordSym0 (l :: TyFun a0123456789876543210 (TyFun Bool (Record a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => - MkRecordSym0KindInference - type instance Apply MkRecordSym0 l = MkRecordSym1 l - data instance Sing (z :: Record a) - where - SMkRecord :: forall (n :: a) (n :: Bool). - {sField1 :: (Sing (n :: a)), sField2 :: (Sing (n :: Bool))} - -> Sing (MkRecord n n) - type SRecord = (Sing :: Record a -> GHC.Types.Type) - instance SingKind a => SingKind (Record a) where - type Demote (Record a) = Record (Demote a) - fromSing (SMkRecord b b) = (MkRecord (fromSing b)) (fromSing b) - toSing (MkRecord (b :: Demote a) (b :: Demote Bool)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) - (toSing b :: SomeSing Bool) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing ((SMkRecord c) c) } - instance (SingI n, SingI n) => - SingI (MkRecord (n :: a) (n :: Bool)) where - sing = (SMkRecord sing) sing diff --git a/tests/compile-and-dump/Singletons/Records.ghc86.template b/tests/compile-and-dump/Singletons/Records.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Records.ghc86.template @@ -0,0 +1,79 @@ +Singletons/Records.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] + ======> + data Record a = MkRecord {field1 :: a, field2 :: Bool} + type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = + Field1 a0123456789876543210 + instance SuppressUnusedWarnings Field1Sym0 where + suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ()) + data Field1Sym0 :: forall a0123456789876543210. + (~>) (Record a0123456789876543210) a0123456789876543210 + where + Field1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => + Field1Sym0 a0123456789876543210 + type instance Apply Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210 + type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) = + Field2 a0123456789876543210 + instance SuppressUnusedWarnings Field2Sym0 where + suppressUnusedWarnings = snd (((,) Field2Sym0KindInference) ()) + data Field2Sym0 :: forall a0123456789876543210. + (~>) (Record a0123456789876543210) Bool + where + Field2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => + Field2Sym0 a0123456789876543210 + type instance Apply Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210 + type family Field1 (a :: Record a) :: a where + Field1 (MkRecord field _) = field + type family Field2 (a :: Record a) :: Bool where + Field2 (MkRecord _ field) = field + type MkRecordSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Bool) = + MkRecord t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkRecordSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkRecordSym1KindInference) ()) + data MkRecordSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) Bool (Record a0123456789876543210) + where + MkRecordSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkRecordSym1 t0123456789876543210) arg) (MkRecordSym2 t0123456789876543210 arg) => + MkRecordSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkRecordSym1 t0123456789876543210) t0123456789876543210 = MkRecord t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkRecordSym0 where + suppressUnusedWarnings = snd (((,) MkRecordSym0KindInference) ()) + data MkRecordSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) Bool (Record a0123456789876543210)) + where + MkRecordSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => + MkRecordSym0 t0123456789876543210 + type instance Apply MkRecordSym0 t0123456789876543210 = MkRecordSym1 t0123456789876543210 + data instance Sing :: Record a -> GHC.Types.Type + where + SMkRecord :: forall a (n :: a) (n :: Bool). + {sField1 :: (Sing (n :: a)), sField2 :: (Sing (n :: Bool))} + -> Sing (MkRecord n n) + type SRecord = (Sing :: Record a -> GHC.Types.Type) + instance SingKind a => SingKind (Record a) where + type Demote (Record a) = Record (Demote a) + fromSing (SMkRecord b b) = (MkRecord (fromSing b)) (fromSing b) + toSing (MkRecord (b :: Demote a) (b :: Demote Bool)) + = case + ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing Bool) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkRecord c) c) } + instance (SingI n, SingI n) => + SingI (MkRecord (n :: a) (n :: Bool)) where + sing = (SMkRecord sing) sing + instance SingI (MkRecordSym0 :: (~>) a ((~>) Bool (Record a))) where + sing = (singFun2 @MkRecordSym0) SMkRecord + instance SingI (TyCon2 MkRecord :: (~>) a ((~>) Bool (Record a))) where + sing = (singFun2 @(TyCon2 MkRecord)) SMkRecord + instance SingI d => + SingI (MkRecordSym1 (d :: a) :: (~>) Bool (Record a)) where + sing = (singFun1 @(MkRecordSym1 (d :: a))) (SMkRecord (sing @d)) + instance SingI d => + SingI (TyCon1 (MkRecord (d :: a)) :: (~>) Bool (Record a)) where + sing + = (singFun1 @(TyCon1 (MkRecord (d :: a)))) (SMkRecord (sing @d)) 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,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} module Singletons.Records where import Data.Singletons.SuppressUnusedWarnings diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/ReturnFunc.ghc84.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 _ 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.ghc86.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template @@ -0,0 +1,98 @@ +Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: a -> a + id x = x + idFoo :: c -> a -> a + idFoo _ = id |] + ======> + returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: a -> a + id x = x + idFoo :: c -> a -> a + idFoo _ = id + type IdSym1 (a0123456789876543210 :: a0123456789876543210) = + Id a0123456789876543210 + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings = snd (((,) IdSym0KindInference) ()) + data IdSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + IdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => + IdSym0 a0123456789876543210 + type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 + type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + IdFoo a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) IdFooSym1KindInference) ()) + data IdFooSym1 (a0123456789876543210 :: c0123456789876543210) :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + IdFooSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) => + IdFooSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings IdFooSym0 where + suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ()) + data IdFooSym0 :: forall a0123456789876543210 c0123456789876543210. + (~>) c0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) + where + IdFooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => + IdFooSym0 a0123456789876543210 + type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210 + type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + ReturnFunc a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ReturnFuncSym1KindInference) ()) + data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + ReturnFuncSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) => + ReturnFuncSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ReturnFuncSym0 where + suppressUnusedWarnings = snd (((,) ReturnFuncSym0KindInference) ()) + data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) + where + ReturnFuncSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => + ReturnFuncSym0 a0123456789876543210 + type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 + type family Id (a :: a) :: a where + Id x = x + type family IdFoo (a :: c) (a :: a) :: a where + IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 + type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where + ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 + sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sIdFoo :: + forall c a (t :: c) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) + sReturnFunc :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) + sId (sX :: Sing x) = sX + sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210 + sReturnFunc + _ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210 + instance SingI (IdSym0 :: (~>) a a) where + sing = (singFun1 @IdSym0) sId + instance SingI (IdFooSym0 :: (~>) c ((~>) a a)) where + sing = (singFun2 @IdFooSym0) sIdFoo + instance SingI d => SingI (IdFooSym1 (d :: c) :: (~>) a a) where + sing = (singFun1 @(IdFooSym1 (d :: c))) (sIdFoo (sing @d)) + instance SingI (ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)) where + sing = (singFun2 @ReturnFuncSym0) sReturnFunc + instance SingI d => + SingI (ReturnFuncSym1 (d :: Nat) :: (~>) Nat Nat) where + sing + = (singFun1 @(ReturnFuncSym1 (d :: Nat))) (sReturnFunc (sing @d)) 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,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Singletons.ReturnFunc where import Data.Singletons diff --git a/tests/compile-and-dump/Singletons/Sections.ghc84.template b/tests/compile-and-dump/Singletons/Sections.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Sections.ghc84.template +++ /dev/null @@ -1,113 +0,0 @@ -Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| (+) :: Nat -> Nat -> Nat - Zero + m = m - (Succ n) + m = Succ (n + m) - foo1 :: [Nat] - foo1 = map ((Succ Zero) +) [Zero, Succ Zero] - foo2 :: [Nat] - foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] - foo3 :: [Nat] - foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] - ======> - (+) :: Nat -> Nat -> Nat - (+) Zero m = m - (+) (Succ n) m = Succ (n + m) - foo1 :: [Nat] - foo1 = (map (Succ Zero +)) [Zero, Succ Zero] - foo2 :: [Nat] - foo2 = (map (+ Succ Zero)) [Zero, Succ Zero] - foo3 :: [Nat] - foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] - type family Lambda_0123456789876543210 t where - Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) - type Lambda_0123456789876543210Sym1 t = - Lambda_0123456789876543210 t - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Lambda_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0KindInference - type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l - type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t - instance SuppressUnusedWarnings (+@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.()) - data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) => - (:+@#@$$###) - type instance Apply ((+@#@$$) l) l = (+) l l - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.()) - data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (:+@#@$###) - type instance Apply (+@#@$) l = (+@#@$$) l - type Foo1Sym0 = Foo1 - type Foo2Sym0 = Foo2 - type Foo3Sym0 = Foo3 - type family (+) (a :: Nat) (a :: Nat) :: Nat where - (+) Zero m = m - (+) (Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) - type family Foo1 :: [Nat] where - Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) - type family Foo2 :: [Nat] where - Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) - type family Foo3 :: [Nat] where - Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) - (%+) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) - sFoo1 :: Sing (Foo1Sym0 :: [Nat]) - sFoo2 :: Sing (Foo2Sym0 :: [Nat]) - sFoo3 :: Sing (Foo3Sym0 :: [Nat]) - (%+) SZero (sM :: Sing m) = sM - (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) - sFoo1 - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((applySing ((singFun2 @(+@#@$)) (%+))) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) - ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) - sFoo2 - = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((singFun1 @Lambda_0123456789876543210Sym0) - (\ sLhs_0123456789876543210 - -> case sLhs_0123456789876543210 of { - _ :: Sing lhs_0123456789876543210 - -> (applySing - ((applySing ((singFun2 @(+@#@$)) (%+))) sLhs_0123456789876543210)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) })))) - ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) - sFoo3 - = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(+@#@$)) (%+)))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)))) - ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)) diff --git a/tests/compile-and-dump/Singletons/Sections.ghc86.template b/tests/compile-and-dump/Singletons/Sections.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Sections.ghc86.template @@ -0,0 +1,122 @@ +Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + foo1 :: [Nat] + foo1 = map ((Succ Zero) +) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] + ======> + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + foo1 :: [Nat] + foo1 = (map (Succ Zero +)) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = (map (+ Succ Zero)) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] + type family Lambda_0123456789876543210 t where + Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) + type Lambda_0123456789876543210Sym1 t0123456789876543210 = + Lambda_0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 t0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 t0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 + type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (+) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) + data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:+@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => + (+@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) + data (+@#@$) :: (~>) Nat ((~>) Nat Nat) + where + (:+@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (+@#@$) a0123456789876543210 + type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 + type Foo1Sym0 = Foo1 + type Foo2Sym0 = Foo2 + type Foo3Sym0 = Foo3 + type family (+) (a :: Nat) (a :: Nat) :: Nat where + (+) 'Zero m = m + (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) + type family Foo1 :: [Nat] where + Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + type family Foo2 :: [Nat] where + Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + type family Foo3 :: [Nat] where + Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + (%+) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) + sFoo1 :: Sing (Foo1Sym0 :: [Nat]) + sFoo2 :: Sing (Foo2Sym0 :: [Nat]) + sFoo3 :: Sing (Foo3Sym0 :: [Nat]) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) + sFoo1 + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((applySing ((singFun2 @(+@#@$)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) + sFoo2 + = (applySing + ((applySing ((singFun2 @MapSym0) sMap)) + ((singFun1 @Lambda_0123456789876543210Sym0) + (\ sLhs_0123456789876543210 + -> case sLhs_0123456789876543210 of { + (_ :: Sing lhs_0123456789876543210) + -> (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) sLhs_0123456789876543210)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) })))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) + sFoo3 + = (applySing + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 @(+@#@$)) (%+)))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)))) + ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)) + instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where + sing = (singFun2 @(+@#@$)) (%+) + instance SingI d => + SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where + sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template b/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/ShowDeriving.ghc84.template +++ /dev/null @@ -1,591 +0,0 @@ -Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixl 5 `MkFoo2b`, :*:, :&: - - data Foo1 - = MkFoo1 - deriving Show - data Foo2 a - = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a - deriving Show - data Foo3 - = MkFoo3 {getFoo3a :: Bool, *** :: Bool} - deriving Show |] - ======> - data Foo1 - = MkFoo1 - deriving Show - infixl 5 `MkFoo2b` - infixl 5 :*: - infixl 5 :&: - data Foo2 a - = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a - deriving Show - data Foo3 - = MkFoo3 {getFoo3a :: Bool, *** :: Bool} - deriving Show - type GetFoo3aSym1 (t :: Foo3) = GetFoo3a t - instance SuppressUnusedWarnings GetFoo3aSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) GetFoo3aSym0KindInference) GHC.Tuple.()) - data GetFoo3aSym0 (l :: TyFun Foo3 Bool) - = forall arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => - GetFoo3aSym0KindInference - type instance Apply GetFoo3aSym0 l = GetFoo3a l - type (***@#@$$) (t :: Foo3) = (***) t - instance SuppressUnusedWarnings (***@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:***@#@$###)) GHC.Tuple.()) - data (***@#@$) (l :: TyFun Foo3 Bool) - = forall arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => - (:***@#@$###) - type instance Apply (***@#@$) l = (***) l - type family GetFoo3a (a :: Foo3) :: Bool where - GetFoo3a (MkFoo3 field _) = field - type family (***) (a :: Foo3) :: Bool where - (***) (MkFoo3 _ field) = field - type MkFoo1Sym0 = MkFoo1 - type MkFoo2aSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - MkFoo2a t t - instance SuppressUnusedWarnings MkFoo2aSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo2aSym1KindInference) GHC.Tuple.()) - data MkFoo2aSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) - = forall arg. SameKind (Apply (MkFoo2aSym1 l) arg) (MkFoo2aSym2 l arg) => - MkFoo2aSym1KindInference - type instance Apply (MkFoo2aSym1 l) l = MkFoo2a l l - instance SuppressUnusedWarnings MkFoo2aSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo2aSym0KindInference) GHC.Tuple.()) - data MkFoo2aSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => - MkFoo2aSym0KindInference - type instance Apply MkFoo2aSym0 l = MkFoo2aSym1 l - type MkFoo2bSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) = - MkFoo2b t t - instance SuppressUnusedWarnings MkFoo2bSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo2bSym1KindInference) GHC.Tuple.()) - data MkFoo2bSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) - = forall arg. SameKind (Apply (MkFoo2bSym1 l) arg) (MkFoo2bSym2 l arg) => - MkFoo2bSym1KindInference - type instance Apply (MkFoo2bSym1 l) l = MkFoo2b l l - instance SuppressUnusedWarnings MkFoo2bSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo2bSym0KindInference) GHC.Tuple.()) - data MkFoo2bSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => - MkFoo2bSym0KindInference - type instance Apply MkFoo2bSym0 l = MkFoo2bSym1 l - type (:*:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (:*:) t t - instance SuppressUnusedWarnings (:*:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) - data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) - = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => - (::*:@#@$$###) - type instance Apply ((:*:@#@$$) l) l = (:*:) l l - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) - data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (::*:@#@$###) - type instance Apply (:*:@#@$) l = (:*:@#@$$) l - type (:&:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) = - (:&:) t t - instance SuppressUnusedWarnings (:&:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::&:@#@$$###)) GHC.Tuple.()) - data (:&:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210)) - = forall arg. SameKind (Apply ((:&:@#@$$) l) arg) ((:&:@#@$$$) l arg) => - (::&:@#@$$###) - type instance Apply ((:&:@#@$$) l) l = (:&:) l l - instance SuppressUnusedWarnings (:&:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::&:@#@$###)) GHC.Tuple.()) - data (:&:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => - (::&:@#@$###) - type instance Apply (:&:@#@$) l = (:&:@#@$$) l - type MkFoo3Sym2 (t :: Bool) (t :: Bool) = MkFoo3 t t - instance SuppressUnusedWarnings MkFoo3Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo3Sym1KindInference) GHC.Tuple.()) - data MkFoo3Sym1 (l :: Bool) (l :: TyFun Bool Foo3) - = forall arg. SameKind (Apply (MkFoo3Sym1 l) arg) (MkFoo3Sym2 l arg) => - MkFoo3Sym1KindInference - type instance Apply (MkFoo3Sym1 l) l = MkFoo3 l l - instance SuppressUnusedWarnings MkFoo3Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.()) - data MkFoo3Sym0 (l :: TyFun Bool (TyFun Bool Foo3 - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => - MkFoo3Sym0KindInference - type instance Apply MkFoo3Sym0 l = MkFoo3Sym1 l - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo1) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo1) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo1 (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo1 (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Foo1 where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2a arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo2a ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo2 a0123456789876543210) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo2 a0123456789876543210) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow (Foo2 a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Foo3) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo3) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo3 (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo3 (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Foo3 where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - infixl 5 :%&: - infixl 5 :%*: - infixl 5 `SMkFoo2b` - data instance Sing (z :: Foo1) where SMkFoo1 :: Sing MkFoo1 - type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type) - instance SingKind Foo1 where - type Demote Foo1 = Foo1 - fromSing SMkFoo1 = MkFoo1 - toSing MkFoo1 = SomeSing SMkFoo1 - data instance Sing (z :: Foo2 a) - where - SMkFoo2a :: forall (n :: a) (n :: a). - (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n) - SMkFoo2b :: forall (n :: a) (n :: a). - (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n) - (:%*:) :: forall (n :: a) (n :: a). - (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n) - (:%&:) :: forall (n :: a) (n :: a). - (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:&:) n n) - type SFoo2 = (Sing :: Foo2 a -> GHC.Types.Type) - instance SingKind a => SingKind (Foo2 a) where - type Demote (Foo2 a) = Foo2 (Demote a) - fromSing (SMkFoo2a b b) = (MkFoo2a (fromSing b)) (fromSing b) - fromSing (SMkFoo2b b b) = (MkFoo2b (fromSing b)) (fromSing b) - fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) - fromSing ((:%&:) b b) = ((:&:) (fromSing b)) (fromSing b) - toSing (MkFoo2a (b :: Demote a) (b :: Demote a)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing ((SMkFoo2a c) c) } - toSing (MkFoo2b (b :: Demote a) (b :: Demote a)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing ((SMkFoo2b c) c) } - toSing ((:*:) (b :: Demote a) (b :: Demote a)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%*:) c) c) } - toSing ((:&:) (b :: Demote a) (b :: Demote a)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%&:) c) c) } - data instance Sing (z :: Foo3) - where - SMkFoo3 :: forall (n :: Bool) (n :: Bool). - {sGetFoo3a :: (Sing (n :: Bool)), %*** :: (Sing (n :: Bool))} - -> Sing (MkFoo3 n n) - type SFoo3 = (Sing :: Foo3 -> GHC.Types.Type) - instance SingKind Foo3 where - type Demote Foo3 = Foo3 - fromSing (SMkFoo3 b b) = (MkFoo3 (fromSing b)) (fromSing b) - toSing (MkFoo3 (b :: Demote Bool) (b :: Demote Bool)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) - (toSing b :: SomeSing Bool) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing ((SMkFoo3 c) c) } - instance SShow Foo1 where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Foo1) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo1 (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - SMkFoo1 - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "MkFoo1"))) - sA_0123456789876543210 - instance SShow a => SShow (Foo2 a) where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Foo2 a) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (Foo2 a) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SMkFoo2a (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "MkFoo2a ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SMkFoo2b (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) - (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 5))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 6)))) - sArgL_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing " `MkFoo2b` ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 6)))) - sArgR_0123456789876543210))))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - ((:%*:) (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "(:*:) ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - ((:%&:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) - (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 5))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 6)))) - sArgL_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing " :&: ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 6)))) - sArgR_0123456789876543210))))) - sA_0123456789876543210 - instance SShow Bool => SShow Foo3 where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Foo3) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Foo3 (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SMkFoo3 (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "MkFoo3 ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowCharSym0) sShowChar)) - (sing :: Sing "{")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "getFoo3a = ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 0)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowCommaSpaceSym0) sShowCommaSpace))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "(***) = ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 0)))) - sArg_0123456789876543210))) - ((applySing ((singFun2 @ShowCharSym0) sShowChar)) - (sing :: Sing "}"))))))))))) - sA_0123456789876543210 - instance Data.Singletons.ShowSing.ShowSing Foo1 where - Data.Singletons.ShowSing.showsSingPrec _ SMkFoo1 - = showString "SMkFoo1" - instance Show (Sing (z :: Foo1)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance Data.Singletons.ShowSing.ShowSing a => - Data.Singletons.ShowSing.ShowSing (Foo2 a) where - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SMkFoo2a arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SMkFoo2a ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - (((.) GHC.Show.showSpace) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)))) - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SMkFoo2b argL_0123456789876543210 argR_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 9)) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argL_0123456789876543210)) - (((.) (showString " `SMkFoo2b` ")) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argR_0123456789876543210))) - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - ((:%*:) arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "(:%*:) ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)) - (((.) GHC.Show.showSpace) - ((Data.Singletons.ShowSing.showsSingPrec 11) - arg_0123456789876543210)))) - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - ((:%&:) argL_0123456789876543210 argR_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 9)) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argL_0123456789876543210)) - (((.) (showString " :%&: ")) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argR_0123456789876543210))) - instance Data.Singletons.ShowSing.ShowSing a => - Show (Sing (z :: Foo2 a)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance Data.Singletons.ShowSing.ShowSing Bool => - Data.Singletons.ShowSing.ShowSing Foo3 where - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - (SMkFoo3 arg_0123456789876543210 arg_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 10)) - (((.) (showString "SMkFoo3 ")) - (((.) (showChar '{')) - (((.) (showString "sGetFoo3a = ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 0) - arg_0123456789876543210)) - (((.) GHC.Show.showCommaSpace) - (((.) (showString "(%***) = ")) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 0) - arg_0123456789876543210)) - (showChar '}')))))))) - instance Data.Singletons.ShowSing.ShowSing Bool => - Show (Sing (z :: Foo3)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI MkFoo1 where - sing = SMkFoo1 - instance (SingI n, SingI n) => - SingI (MkFoo2a (n :: a) (n :: a)) where - sing = (SMkFoo2a sing) sing - instance (SingI n, SingI n) => - SingI (MkFoo2b (n :: a) (n :: a)) where - sing = (SMkFoo2b sing) sing - instance (SingI n, SingI n) => - SingI ((:*:) (n :: a) (n :: a)) where - sing = ((:%*:) sing) sing - instance (SingI n, SingI n) => - SingI ((:&:) (n :: a) (n :: a)) where - sing = ((:%&:) sing) sing - instance (SingI n, SingI n) => - SingI (MkFoo3 (n :: Bool) (n :: Bool)) where - sing = (SMkFoo3 sing) sing diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template b/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template @@ -0,0 +1,582 @@ +Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 5 `MkFoo2b`, :*:, :&: + + data Foo1 + = MkFoo1 + deriving Show + data Foo2 a + = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a + deriving Show + data Foo3 + = MkFoo3 {getFoo3a :: Bool, *** :: Bool} + deriving Show |] + ======> + data Foo1 + = MkFoo1 + deriving Show + infixl 5 `MkFoo2b` + infixl 5 :*: + infixl 5 :&: + data Foo2 a + = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a + deriving Show + data Foo3 + = MkFoo3 {getFoo3a :: Bool, *** :: Bool} + deriving Show + type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = + GetFoo3a a0123456789876543210 + instance SuppressUnusedWarnings GetFoo3aSym0 where + suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ()) + data GetFoo3aSym0 :: (~>) Foo3 Bool + where + GetFoo3aSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => + GetFoo3aSym0 a0123456789876543210 + type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210 + type (***@#@$$) (a0123456789876543210 :: Foo3) = + (***) a0123456789876543210 + instance SuppressUnusedWarnings (***@#@$) where + suppressUnusedWarnings = snd (((,) (:***@#@$###)) ()) + data (***@#@$) :: (~>) Foo3 Bool + where + (:***@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => + (***@#@$) a0123456789876543210 + type instance Apply (***@#@$) a0123456789876543210 = (***) a0123456789876543210 + type family GetFoo3a (a :: Foo3) :: Bool where + GetFoo3a (MkFoo3 field _) = field + type family (***) (a :: Foo3) :: Bool where + (***) (MkFoo3 _ field) = field + type MkFoo1Sym0 = MkFoo1 + type MkFoo2aSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + MkFoo2a t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkFoo2aSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkFoo2aSym1KindInference) ()) + data MkFoo2aSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) + where + MkFoo2aSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkFoo2aSym1 t0123456789876543210) arg) (MkFoo2aSym2 t0123456789876543210 arg) => + MkFoo2aSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkFoo2aSym1 t0123456789876543210) t0123456789876543210 = MkFoo2a t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo2aSym0 where + suppressUnusedWarnings = snd (((,) MkFoo2aSym0KindInference) ()) + data MkFoo2aSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + where + MkFoo2aSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => + MkFoo2aSym0 t0123456789876543210 + type instance Apply MkFoo2aSym0 t0123456789876543210 = MkFoo2aSym1 t0123456789876543210 + type MkFoo2bSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + MkFoo2b t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkFoo2bSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkFoo2bSym1KindInference) ()) + data MkFoo2bSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) + where + MkFoo2bSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkFoo2bSym1 t0123456789876543210) arg) (MkFoo2bSym2 t0123456789876543210 arg) => + MkFoo2bSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkFoo2bSym1 t0123456789876543210) t0123456789876543210 = MkFoo2b t0123456789876543210 t0123456789876543210 + infixl 5 `MkFoo2bSym1` + instance SuppressUnusedWarnings MkFoo2bSym0 where + suppressUnusedWarnings = snd (((,) MkFoo2bSym0KindInference) ()) + data MkFoo2bSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + where + MkFoo2bSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => + MkFoo2bSym0 t0123456789876543210 + type instance Apply MkFoo2bSym0 t0123456789876543210 = MkFoo2bSym1 t0123456789876543210 + infixl 5 `MkFoo2bSym0` + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) + data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) + where + (::*:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => + (:*:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 + infixl 5 :*:@#@$$ + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + where + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 + infixl 5 :*:@#@$ + type (:&:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + (:&:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:&:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::&:@#@$$###)) ()) + data (:&:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) + where + (::&:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:&:@#@$$) t0123456789876543210) arg) ((:&:@#@$$$) t0123456789876543210 arg) => + (:&:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:&:@#@$$) t0123456789876543210) t0123456789876543210 = (:&:) t0123456789876543210 t0123456789876543210 + infixl 5 :&:@#@$$ + instance SuppressUnusedWarnings (:&:@#@$) where + suppressUnusedWarnings = snd (((,) (::&:@#@$###)) ()) + data (:&:@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + where + (::&:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => + (:&:@#@$) t0123456789876543210 + type instance Apply (:&:@#@$) t0123456789876543210 = (:&:@#@$$) t0123456789876543210 + infixl 5 :&:@#@$ + type MkFoo3Sym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + MkFoo3 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkFoo3Sym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkFoo3Sym1KindInference) ()) + data MkFoo3Sym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo3 + where + MkFoo3Sym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkFoo3Sym1 t0123456789876543210) arg) (MkFoo3Sym2 t0123456789876543210 arg) => + MkFoo3Sym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkFoo3Sym1 t0123456789876543210) t0123456789876543210 = MkFoo3 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo3Sym0 where + suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) + data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) + where + MkFoo3Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => + MkFoo3Sym0 t0123456789876543210 + type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210 + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo1 ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Foo1 where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2a arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo2a ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. + (~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow (Foo2 a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo3 ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Foo3 where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + infixl 5 `SMkFoo2b` + infixl 5 :%*: + infixl 5 :%&: + data instance Sing :: Foo1 -> GHC.Types.Type + where SMkFoo1 :: Sing MkFoo1 + type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type) + instance SingKind Foo1 where + type Demote Foo1 = Foo1 + fromSing SMkFoo1 = MkFoo1 + toSing MkFoo1 = SomeSing SMkFoo1 + data instance Sing :: Foo2 a -> GHC.Types.Type + where + SMkFoo2a :: forall a (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n) + SMkFoo2b :: forall a (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n) + (:%*:) :: forall a (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n) + (:%&:) :: forall a (n :: a) (n :: a). + (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:&:) n n) + type SFoo2 = (Sing :: Foo2 a -> GHC.Types.Type) + instance SingKind a => SingKind (Foo2 a) where + type Demote (Foo2 a) = Foo2 (Demote a) + fromSing (SMkFoo2a b b) = (MkFoo2a (fromSing b)) (fromSing b) + fromSing (SMkFoo2b b b) = (MkFoo2b (fromSing b)) (fromSing b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + fromSing ((:%&:) b b) = ((:&:) (fromSing b)) (fromSing b) + toSing (MkFoo2a (b :: Demote a) (b :: Demote a)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2a c) c) } + toSing (MkFoo2b (b :: Demote a) (b :: Demote a)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2b c) c) } + toSing ((:*:) (b :: Demote a) (b :: Demote a)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } + toSing ((:&:) (b :: Demote a) (b :: Demote a)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&:) c) c) } + data instance Sing :: Foo3 -> GHC.Types.Type + where + SMkFoo3 :: forall (n :: Bool) (n :: Bool). + {sGetFoo3a :: (Sing (n :: Bool)), %*** :: (Sing (n :: Bool))} + -> Sing (MkFoo3 n n) + type SFoo3 = (Sing :: Foo3 -> GHC.Types.Type) + instance SingKind Foo3 where + type Demote Foo3 = Foo3 + fromSing (SMkFoo3 b b) = (MkFoo3 (fromSing b)) (fromSing b) + toSing (MkFoo3 (b :: Demote Bool) (b :: Demote Bool)) + = case + ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo3 c) c) } + instance SShow Foo1 where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo1) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SMkFoo1 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo1"))) + sA_0123456789876543210 + instance SShow a => SShow (Foo2 a) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo2 a) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Foo2 a) ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo2a (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo2a ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo2b (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 5))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " `MkFoo2b` ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%*:) (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "(:*:) ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%&:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 5))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " :&: ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 6)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + instance SShow Bool => SShow Foo3 where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Foo3) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMkFoo3 (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "MkFoo3 ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowCharSym0) sShowChar)) + (sing :: Sing "{")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "getFoo3a = ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 0)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowCommaSpaceSym0) sShowCommaSpace))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "(***) = ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 0)))) + sArg_0123456789876543210))) + ((applySing ((singFun2 @ShowCharSym0) sShowChar)) + (sing :: Sing "}"))))))))))) + sA_0123456789876543210 + deriving instance Show (Sing (z :: Foo1)) + deriving instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: Foo2 a)) + deriving instance Data.Singletons.ShowSing.ShowSing Bool => + Show (Sing (z :: Foo3)) + instance SingI MkFoo1 where + sing = SMkFoo1 + instance (SingI n, SingI n) => + SingI (MkFoo2a (n :: a) (n :: a)) where + sing = (SMkFoo2a sing) sing + instance SingI (MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @MkFoo2aSym0) SMkFoo2a + instance SingI (TyCon2 MkFoo2a :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(TyCon2 MkFoo2a)) SMkFoo2a + instance SingI d => + SingI (MkFoo2aSym1 (d :: a) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(MkFoo2aSym1 (d :: a))) (SMkFoo2a (sing @d)) + instance SingI d => + SingI (TyCon1 (MkFoo2a (d :: a)) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(TyCon1 (MkFoo2a (d :: a)))) (SMkFoo2a (sing @d)) + instance (SingI n, SingI n) => + SingI (MkFoo2b (n :: a) (n :: a)) where + sing = (SMkFoo2b sing) sing + instance SingI (MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @MkFoo2bSym0) SMkFoo2b + instance SingI (TyCon2 MkFoo2b :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(TyCon2 MkFoo2b)) SMkFoo2b + instance SingI d => + SingI (MkFoo2bSym1 (d :: a) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(MkFoo2bSym1 (d :: a))) (SMkFoo2b (sing @d)) + instance SingI d => + SingI (TyCon1 (MkFoo2b (d :: a)) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(TyCon1 (MkFoo2b (d :: a)))) (SMkFoo2b (sing @d)) + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: a)) where + sing = ((:%*:) sing) sing + instance SingI ((:*:@#@$) :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(:*:@#@$)) (:%*:) + instance SingI (TyCon2 (:*:) :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(TyCon2 (:*:))) (:%*:) + instance SingI d => + SingI ((:*:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where + sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:*:) (d :: a)) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) + instance (SingI n, SingI n) => + SingI ((:&:) (n :: a) (n :: a)) where + sing = ((:%&:) sing) sing + instance SingI ((:&:@#@$) :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(:&:@#@$)) (:%&:) + instance SingI (TyCon2 (:&:) :: (~>) a ((~>) a (Foo2 a))) where + sing = (singFun2 @(TyCon2 (:&:))) (:%&:) + instance SingI d => + SingI ((:&:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where + sing = (singFun1 @((:&:@#@$$) (d :: a))) ((:%&:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:&:) (d :: a)) :: (~>) a (Foo2 a)) where + sing = (singFun1 @(TyCon1 ((:&:) (d :: a)))) ((:%&:) (sing @d)) + instance (SingI n, SingI n) => + SingI (MkFoo3 (n :: Bool) (n :: Bool)) where + sing = (SMkFoo3 sing) sing + instance SingI (MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)) where + sing = (singFun2 @MkFoo3Sym0) SMkFoo3 + instance SingI (TyCon2 MkFoo3 :: (~>) Bool ((~>) Bool Foo3)) where + sing = (singFun2 @(TyCon2 MkFoo3)) SMkFoo3 + instance SingI d => + SingI (MkFoo3Sym1 (d :: Bool) :: (~>) Bool Foo3) where + sing = (singFun1 @(MkFoo3Sym1 (d :: Bool))) (SMkFoo3 (sing @d)) + instance SingI d => + SingI (TyCon1 (MkFoo3 (d :: Bool)) :: (~>) Bool Foo3) where + sing + = (singFun1 @(TyCon1 (MkFoo3 (d :: Bool)))) (SMkFoo3 (sing @d)) diff --git a/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template b/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc84.template +++ /dev/null @@ -1,454 +0,0 @@ -Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixl 6 :*: - - data T a b = a :*: b - data S = S1 | S2 - - deriving instance Enum S - deriving instance Bounded S - deriving instance Show S - deriving instance Ord S - deriving instance Eq S - deriving instance Show a => Show (T a ()) - deriving instance Ord a => Ord (T a ()) - deriving instance Eq a => Eq (T a ()) |] - ======> - infixl 6 :*: - data T a b = a :*: b - data S = S1 | S2 - deriving instance Eq a => Eq (T a ()) - deriving instance Ord a => Ord (T a ()) - deriving instance Show a => Show (T a ()) - deriving instance Eq S - deriving instance Ord S - deriving instance Show S - deriving instance Bounded S - deriving instance Enum S - type (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) = - (:*:) t t - instance SuppressUnusedWarnings (:*:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) - data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => - (::*:@#@$$###) - type instance Apply ((:*:@#@$$) l) l = (:*:) l l - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) - data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (::*:@#@$###) - type instance Apply (:*:@#@$) l = (:*:@#@$$) l - type S1Sym0 = S1 - type S2Sym0 = S2 - type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where - Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) - type Compare_0123456789876543210Sym2 (t :: T a0123456789876543210 ()) (t :: T a0123456789876543210 ()) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: T a0123456789876543210 ()) (l :: TyFun (T a0123456789876543210 ()) Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun (T a0123456789876543210 ()) (TyFun (T a0123456789876543210 ()) Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd (T a ()) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: T a0123456789876543210 ()) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T a0123456789876543210 ()) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow (T a ()) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where - Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 S1 S2 = LTSym0 - Compare_0123456789876543210 S2 S1 = GTSym0 - type Compare_0123456789876543210Sym2 (t :: S) (t :: S) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: S) (l :: TyFun S Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun S (TyFun S Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd S where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: S) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: S) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun S (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun S (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow S where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family MinBound_0123456789876543210 :: S where - MinBound_0123456789876543210 = S1Sym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: S where - MaxBound_0123456789876543210 = S2Sym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded S where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = S2Sym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = S1Sym0 - Case_0123456789876543210 n False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat S) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where - FromEnum_0123456789876543210 S1 = FromInteger 0 - FromEnum_0123456789876543210 S2 = FromInteger 1 - type FromEnum_0123456789876543210Sym1 (t :: S) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun S GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum S where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - type family Equals_0123456789876543210 (a :: T a ()) (b :: T a ()) :: Bool where - Equals_0123456789876543210 ((:*:) a a) ((:*:) b b) = (&&) ((==) a b) ((==) a b) - Equals_0123456789876543210 (_ :: T a ()) (_ :: T a ()) = FalseSym0 - instance PEq (T a ()) where - type (==) a b = Equals_0123456789876543210 a b - type family Equals_0123456789876543210 (a :: S) (b :: S) :: Bool where - Equals_0123456789876543210 S1 S1 = TrueSym0 - Equals_0123456789876543210 S2 S2 = TrueSym0 - Equals_0123456789876543210 (_ :: S) (_ :: S) = FalseSym0 - instance PEq S where - type (==) a b = Equals_0123456789876543210 a b - infixl 6 :%*: - data instance Sing (z :: T a b) - where - (:%*:) :: forall (n :: a) (n :: b). - (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) - type ST = (Sing :: T a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind (T a b) where - type Demote (T a b) = T (Demote a) (Demote b) - fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) - toSing ((:*:) (b :: Demote a) (b :: Demote b)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%*:) c) c) } - data instance Sing (z :: S) - where - SS1 :: Sing S1 - SS2 :: Sing S2 - type SS = (Sing :: S -> GHC.Types.Type) - instance SingKind S where - type Demote S = S - fromSing SS1 = S1 - fromSing SS2 = S2 - toSing S1 = SomeSing SS1 - toSing S2 = SomeSing SS2 - instance SOrd a => SOrd (T a ()) where - sCompare :: - forall (t1 :: T a ()) (t2 :: T a ()). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun (T a ()) (TyFun (T a ()) Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare - ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)) - instance SShow a => SShow (T a ()) where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: T a ()) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun (T a ()) (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - ((:%*:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) - (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 6))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 7)))) - sArgL_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing " :*: ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 7)))) - sArgR_0123456789876543210))))) - sA_0123456789876543210 - instance SOrd S where - sCompare :: - forall (t1 :: S) (t2 :: S). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun S (TyFun S Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare SS1 SS1 - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SS2 SS2 - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SS1 SS2 = SLT - sCompare SS2 SS1 = SGT - instance SShow S where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: S) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun S (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - SS1 - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "S1"))) - sA_0123456789876543210 - sShowsPrec - _ - SS2 - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "S2"))) - sA_0123456789876543210 - instance SBounded S where - sMinBound :: Sing (MinBoundSym0 :: S) - sMaxBound :: Sing (MaxBoundSym0 :: S) - sMinBound = SS1 - sMaxBound = SS2 - instance SEnum S where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat S - -> GHC.Types.Type) t) - sFromEnum :: - forall (t :: S). - Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Types.Nat - -> GHC.Types.Type) t) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SS1 - SFalse - -> case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SS2 - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1))) :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0))) - sFromEnum SS1 = sFromInteger (sing :: Sing 0) - sFromEnum SS2 = sFromInteger (sing :: Sing 1) - instance SEq a => SEq (T a ()) where - (%==) ((:%*:) a a) ((:%*:) b b) - = ((%&&) (((%==) a) b)) (((%==) a) b) - instance SDecide a => SDecide (T a ()) where - (%~) ((:%*:) a a) ((:%*:) b b) - = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of - GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl - GHC.Tuple.(,) (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,) _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SEq S where - (%==) SS1 SS1 = STrue - (%==) SS1 SS2 = SFalse - (%==) SS2 SS1 = SFalse - (%==) SS2 SS2 = STrue - instance SDecide S where - (%~) SS1 SS1 = Proved Refl - (%~) SS1 SS2 = Disproved (\ x -> case x of) - (%~) SS2 SS1 = Disproved (\ x -> case x of) - (%~) SS2 SS2 = Proved Refl - instance Data.Singletons.ShowSing.ShowSing a => - Data.Singletons.ShowSing.ShowSing (T a ()) where - Data.Singletons.ShowSing.showsSingPrec - p_0123456789876543210 - ((:%*:) argL_0123456789876543210 argR_0123456789876543210) - = (showParen (((>) p_0123456789876543210) 9)) - (((.) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argL_0123456789876543210)) - (((.) (showString " :%*: ")) - ((Data.Singletons.ShowSing.showsSingPrec 10) - argR_0123456789876543210))) - instance Data.Singletons.ShowSing.ShowSing a => - Show (Sing (z :: T a ())) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance Data.Singletons.ShowSing.ShowSing S where - Data.Singletons.ShowSing.showsSingPrec _ SS1 = showString "SS1" - Data.Singletons.ShowSing.showsSingPrec _ SS2 = showString "SS2" - instance Show (Sing (z :: S)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance (SingI n, SingI n) => - SingI ((:*:) (n :: a) (n :: b)) where - sing = ((:%*:) sing) sing - instance SingI S1 where - sing = SS1 - instance SingI S2 where - sing = SS2 diff --git a/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template b/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template @@ -0,0 +1,447 @@ +Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 6 :*: + + data T a b = a :*: b + data S = S1 | S2 + + deriving instance Enum S + deriving instance Bounded S + deriving instance Show S + deriving instance Ord S + deriving instance Eq S + deriving instance Show a => Show (T a ()) + deriving instance Ord a => Ord (T a ()) + deriving instance Eq a => Eq (T a ()) |] + ======> + infixl 6 :*: + data T a b = a :*: b + data S = S1 | S2 + deriving instance Eq a => Eq (T a ()) + deriving instance Ord a => Ord (T a ()) + deriving instance Show a => Show (T a ()) + deriving instance Eq S + deriving instance Ord S + deriving instance Show S + deriving instance Bounded S + deriving instance Enum S + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) + data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210) + where + (::*:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => + (:*:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 + infixl 6 :*:@#@$$ + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) + where + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 + infixl 6 :*:@#@$ + type S1Sym0 = S1 + type S2Sym0 = S2 + type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where + Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: T a0123456789876543210 ()) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) (T a0123456789876543210 ()) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) (T a0123456789876543210 ()) ((~>) (T a0123456789876543210 ()) Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd (T a ()) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. + (~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow (T a ()) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where + Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 S1 S2 = LTSym0 + Compare_0123456789876543210 S2 S1 = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: S) :: (~>) S Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd S where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) S ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow S where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family MinBound_0123456789876543210 :: S where + MinBound_0123456789876543210 = S1Sym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: S where + MaxBound_0123456789876543210 = S2Sym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded S where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n 'True = S2Sym0 + Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n 'True = S1Sym0 + Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) + data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat S + where + ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 + type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where + FromEnum_0123456789876543210 S1 = FromInteger 0 + FromEnum_0123456789876543210 S2 = FromInteger 1 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) = + FromEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) + data FromEnum_0123456789876543210Sym0 :: (~>) S GHC.Types.Nat + where + FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 + instance PEnum S where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + type family Equals_0123456789876543210 (a :: T a ()) (b :: T a ()) :: Bool where + Equals_0123456789876543210 ((:*:) a a) ((:*:) b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: T a ()) (_ :: T a ()) = FalseSym0 + instance PEq (T a ()) where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: S) (b :: S) :: Bool where + Equals_0123456789876543210 S1 S1 = TrueSym0 + Equals_0123456789876543210 S2 S2 = TrueSym0 + Equals_0123456789876543210 (_ :: S) (_ :: S) = FalseSym0 + instance PEq S where + type (==) a b = Equals_0123456789876543210 a b + infixl 6 :%*: + data instance Sing :: T a b -> GHC.Types.Type + where + (:%*:) :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) + type ST = (Sing :: T a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (T a b) where + type Demote (T a b) = T (Demote a) (Demote b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + toSing ((:*:) (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } + data instance Sing :: S -> GHC.Types.Type + where + SS1 :: Sing S1 + SS2 :: Sing S2 + type SS = (Sing :: S -> GHC.Types.Type) + instance SingKind S where + type Demote S = S + fromSing SS1 = S1 + fromSing SS2 = S2 + toSing S1 = SomeSing SS1 + toSing S2 = SomeSing SS2 + instance SOrd a => SOrd (T a ()) where + sCompare :: + forall (t1 :: T a ()) (t2 :: T a ()). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (T a ()) ((~>) (T a ()) Ordering) + -> GHC.Types.Type) t1) t2) + sCompare + ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)) + instance SShow a => SShow (T a ()) where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: T a ()) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (T a ()) ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + ((:%*:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) + (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 6))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 7)))) + sArgL_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing " :*: ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 7)))) + sArgR_0123456789876543210))))) + sA_0123456789876543210 + instance SOrd S where + sCompare :: + forall (t1 :: S) (t2 :: S). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun S ((~>) S Ordering) + -> GHC.Types.Type) t1) t2) + sCompare SS1 SS1 + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SS2 SS2 + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SS1 SS2 = SLT + sCompare SS2 SS1 = SGT + instance SShow S where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: S) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SS1 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "S1"))) + sA_0123456789876543210 + sShowsPrec + _ + SS2 + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "S2"))) + sA_0123456789876543210 + instance SBounded S where + sMinBound :: Sing (MinBoundSym0 :: S) + sMaxBound :: Sing (MaxBoundSym0 :: S) + sMinBound = SS1 + sMaxBound = SS2 + instance SEnum S where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat S + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: S). + Sing t + -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> SS1 + SFalse + -> (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (sFromInteger (sing :: Sing 1)) + of + STrue -> SS2 + SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0))) + sFromEnum SS1 = sFromInteger (sing :: Sing 0) + sFromEnum SS2 = sFromInteger (sing :: Sing 1) + instance SEq a => SEq (T a ()) where + (%==) ((:%*:) a a) ((:%*:) b b) + = ((%&&) (((%==) a) b)) (((%==) a) b) + instance SDecide a => SDecide (T a ()) where + (%~) ((:%*:) a a) ((:%*:) b b) + = case ((,) (((%~) a) b)) (((%~) a) b) of + (,) (Proved Refl) (Proved Refl) -> Proved Refl + (,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq S where + (%==) SS1 SS1 = STrue + (%==) SS1 SS2 = SFalse + (%==) SS2 SS1 = SFalse + (%==) SS2 SS2 = STrue + instance SDecide S where + (%~) SS1 SS1 = Proved Refl + (%~) SS1 SS2 = Disproved (\ x -> case x of) + (%~) SS2 SS1 = Disproved (\ x -> case x of) + (%~) SS2 SS2 = Proved Refl + deriving instance Data.Singletons.ShowSing.ShowSing a => + Show (Sing (z :: T a ())) + deriving instance Show (Sing (z :: S)) + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: b)) where + sing = ((:%*:) sing) sing + instance SingI ((:*:@#@$) :: (~>) a ((~>) b (T a b))) where + sing = (singFun2 @(:*:@#@$)) (:%*:) + instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b (T a b))) where + sing = (singFun2 @(TyCon2 (:*:))) (:%*:) + instance SingI d => + SingI ((:*:@#@$$) (d :: a) :: (~>) b (T a b)) where + sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b (T a b)) where + sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) + instance SingI S1 where + sing = SS1 + instance SingI S2 where + sing = SS2 diff --git a/tests/compile-and-dump/Singletons/Star.ghc84.template b/tests/compile-and-dump/Singletons/Star.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Star.ghc84.template +++ /dev/null @@ -1,405 +0,0 @@ -Singletons/Star.hs:0:0:: Splicing declarations - singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec] - ======> - data Rep - = Singletons.Star.Nat | - Singletons.Star.Int | - Singletons.Star.String | - Singletons.Star.Maybe Rep | - Singletons.Star.Vec Rep Nat - deriving (Eq, Ord, Read, Show) - type NatSym0 = Nat - type IntSym0 = Int - type StringSym0 = String - type MaybeSym1 (t :: Type) = Maybe t - instance SuppressUnusedWarnings MaybeSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MaybeSym0KindInference) GHC.Tuple.()) - data MaybeSym0 (l :: TyFun Type Type) - = forall arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => - MaybeSym0KindInference - type instance Apply MaybeSym0 l = Maybe l - type VecSym2 (t :: Type) (t :: Nat) = Vec t t - instance SuppressUnusedWarnings VecSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) VecSym1KindInference) GHC.Tuple.()) - data VecSym1 (l :: Type) (l :: TyFun Nat Type) - = forall arg. SameKind (Apply (VecSym1 l) arg) (VecSym2 l arg) => - VecSym1KindInference - type instance Apply (VecSym1 l) l = Vec l l - instance SuppressUnusedWarnings VecSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) VecSym0KindInference) GHC.Tuple.()) - data VecSym0 (l :: TyFun Type (TyFun Nat Type -> Type)) - = forall arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => - VecSym0KindInference - type instance Apply VecSym0 l = VecSym1 l - type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where - Equals_0123456789876543210 Nat Nat = TrueSym0 - Equals_0123456789876543210 Int Int = TrueSym0 - Equals_0123456789876543210 String String = TrueSym0 - Equals_0123456789876543210 (Maybe a) (Maybe b) = (==) a b - Equals_0123456789876543210 (Vec a a) (Vec b b) = (&&) ((==) a b) ((==) a b) - Equals_0123456789876543210 (_ :: Type) (_ :: Type) = FalseSym0 - instance PEq Type where - type (==) a b = Equals_0123456789876543210 a b - type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where - Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) - Compare_0123456789876543210 Nat Int = LTSym0 - Compare_0123456789876543210 Nat String = LTSym0 - Compare_0123456789876543210 Nat (Maybe _) = LTSym0 - Compare_0123456789876543210 Nat (Vec _ _) = LTSym0 - Compare_0123456789876543210 Int Nat = GTSym0 - Compare_0123456789876543210 Int String = LTSym0 - Compare_0123456789876543210 Int (Maybe _) = LTSym0 - Compare_0123456789876543210 Int (Vec _ _) = LTSym0 - Compare_0123456789876543210 String Nat = GTSym0 - Compare_0123456789876543210 String Int = GTSym0 - Compare_0123456789876543210 String (Maybe _) = LTSym0 - Compare_0123456789876543210 String (Vec _ _) = LTSym0 - Compare_0123456789876543210 (Maybe _) Nat = GTSym0 - Compare_0123456789876543210 (Maybe _) Int = GTSym0 - Compare_0123456789876543210 (Maybe _) String = GTSym0 - Compare_0123456789876543210 (Maybe _) (Vec _ _) = LTSym0 - Compare_0123456789876543210 (Vec _ _) Nat = GTSym0 - Compare_0123456789876543210 (Vec _ _) Int = GTSym0 - Compare_0123456789876543210 (Vec _ _) String = GTSym0 - Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Type) (t :: Type) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Type) (l :: TyFun Type Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Type (TyFun Type Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Type where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ Nat a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nat") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ Int a_0123456789876543210 = Apply (Apply ShowStringSym0 "Int") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: Type) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Type) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Type (TyFun Symbol Symbol - -> Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Type (TyFun Symbol Symbol - -> Type) - -> Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Type where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data instance Sing (z :: Type) - where - SNat :: Sing Nat - SInt :: Sing Int - SString :: Sing String - SMaybe :: forall (n :: Type). (Sing (n :: Type)) -> Sing (Maybe n) - SVec :: forall (n :: Type) (n :: Nat). - (Sing (n :: Type)) -> (Sing (n :: Nat)) -> Sing (Vec n n) - type SRep = (Sing :: Type -> Type) - instance SingKind Type where - type Demote Type = Rep - fromSing SNat = Singletons.Star.Nat - fromSing SInt = Singletons.Star.Int - fromSing SString = Singletons.Star.String - fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) - fromSing (SVec b b) - = (Singletons.Star.Vec (fromSing b)) (fromSing b) - toSing Singletons.Star.Nat = SomeSing SNat - toSing Singletons.Star.Int = SomeSing SInt - toSing Singletons.Star.String = SomeSing SString - toSing (Singletons.Star.Maybe (b :: Demote Type)) - = case toSing b :: SomeSing Type of { - SomeSing c -> SomeSing (SMaybe c) } - toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing Type)) - (toSing b :: SomeSing Nat) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SVec c) c) } - instance (SEq Type, SEq Nat) => SEq Type where - (%==) SNat SNat = STrue - (%==) SNat SInt = SFalse - (%==) SNat SString = SFalse - (%==) SNat (SMaybe _) = SFalse - (%==) SNat (SVec _ _) = SFalse - (%==) SInt SNat = SFalse - (%==) SInt SInt = STrue - (%==) SInt SString = SFalse - (%==) SInt (SMaybe _) = SFalse - (%==) SInt (SVec _ _) = SFalse - (%==) SString SNat = SFalse - (%==) SString SInt = SFalse - (%==) SString SString = STrue - (%==) SString (SMaybe _) = SFalse - (%==) SString (SVec _ _) = SFalse - (%==) (SMaybe _) SNat = SFalse - (%==) (SMaybe _) SInt = SFalse - (%==) (SMaybe _) SString = SFalse - (%==) (SMaybe a) (SMaybe b) = ((%==) a) b - (%==) (SMaybe _) (SVec _ _) = SFalse - (%==) (SVec _ _) SNat = SFalse - (%==) (SVec _ _) SInt = SFalse - (%==) (SVec _ _) SString = SFalse - (%==) (SVec _ _) (SMaybe _) = SFalse - (%==) (SVec a a) (SVec b b) = ((%&&) (((%==) a) b)) (((%==) a) b) - instance (SDecide Type, SDecide Nat) => SDecide Type where - (%~) SNat SNat = Proved Refl - (%~) SNat SInt = Disproved (\ x -> case x of) - (%~) SNat SString = Disproved (\ x -> case x of) - (%~) SNat (SMaybe _) = Disproved (\ x -> case x of) - (%~) SNat (SVec _ _) = Disproved (\ x -> case x of) - (%~) SInt SNat = Disproved (\ x -> case x of) - (%~) SInt SInt = Proved Refl - (%~) SInt SString = Disproved (\ x -> case x of) - (%~) SInt (SMaybe _) = Disproved (\ x -> case x of) - (%~) SInt (SVec _ _) = Disproved (\ x -> case x of) - (%~) SString SNat = Disproved (\ x -> case x of) - (%~) SString SInt = Disproved (\ x -> case x of) - (%~) SString SString = Proved Refl - (%~) SString (SMaybe _) = Disproved (\ x -> case x of) - (%~) SString (SVec _ _) = Disproved (\ x -> case x of) - (%~) (SMaybe _) SNat = Disproved (\ x -> case x of) - (%~) (SMaybe _) SInt = Disproved (\ x -> case x of) - (%~) (SMaybe _) SString = Disproved (\ x -> case x of) - (%~) (SMaybe a) (SMaybe b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - (%~) (SMaybe _) (SVec _ _) = Disproved (\ x -> case x of) - (%~) (SVec _ _) SNat = Disproved (\ x -> case x of) - (%~) (SVec _ _) SInt = Disproved (\ x -> case x of) - (%~) (SVec _ _) SString = Disproved (\ x -> case x of) - (%~) (SVec _ _) (SMaybe _) = Disproved (\ x -> case x of) - (%~) (SVec a a) (SVec b b) - = case (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of - GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl - GHC.Tuple.(,) (Disproved contra) _ - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - GHC.Tuple.(,) _ (Disproved contra) - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance (SOrd Type, SOrd Nat) => SOrd Type where - sCompare :: - forall (t1 :: Type) (t2 :: Type). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Type (TyFun Type Ordering - -> Type) - -> Type) t1) t2) - sCompare SNat SNat - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SInt SInt - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare SString SString - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - SNil - sCompare - (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil) - sCompare - (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - SNil)) - sCompare SNat SInt = SLT - sCompare SNat SString = SLT - sCompare SNat (SMaybe _) = SLT - sCompare SNat (SVec _ _) = SLT - sCompare SInt SNat = SGT - sCompare SInt SString = SLT - sCompare SInt (SMaybe _) = SLT - sCompare SInt (SVec _ _) = SLT - sCompare SString SNat = SGT - sCompare SString SInt = SGT - sCompare SString (SMaybe _) = SLT - sCompare SString (SVec _ _) = SLT - sCompare (SMaybe _) SNat = SGT - sCompare (SMaybe _) SInt = SGT - sCompare (SMaybe _) SString = SGT - sCompare (SMaybe _) (SVec _ _) = SLT - sCompare (SVec _ _) SNat = SGT - sCompare (SVec _ _) SInt = SGT - sCompare (SVec _ _) SString = SGT - sCompare (SVec _ _) (SMaybe _) = SGT - instance (SShow Type, SShow Nat) => SShow Type where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: Type) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun Type (TyFun Symbol Symbol - -> Type) - -> Type) - -> Type) t1) t2) t3) - sShowsPrec - _ - SNat - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Nat"))) - sA_0123456789876543210 - sShowsPrec - _ - SInt - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Int"))) - sA_0123456789876543210 - sShowsPrec - _ - SString - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "String"))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SMaybe (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Maybe ")))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))) - sA_0123456789876543210 - sShowsPrec - (sP_0123456789876543210 :: Sing p_0123456789876543210) - (SVec (sArg_0123456789876543210 :: Sing arg_0123456789876543210) - (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing - ((applySing ((singFun3 @ShowParenSym0) sShowParen)) - ((applySing - ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) - (sFromInteger (sing :: Sing 10))))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Vec ")))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @ShowSpaceSym0) sShowSpace))) - ((applySing - ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) - (sFromInteger (sing :: Sing 11)))) - sArg_0123456789876543210)))))) - sA_0123456789876543210 - instance SingI Nat where - sing = SNat - instance SingI Int where - sing = SInt - instance SingI String where - sing = SString - instance SingI n => SingI (Maybe (n :: Type)) where - sing = SMaybe sing - instance (SingI n, SingI n) => - SingI (Vec (n :: Type) (n :: Nat)) where - sing = (SVec sing) sing diff --git a/tests/compile-and-dump/Singletons/Star.ghc86.template b/tests/compile-and-dump/Singletons/Star.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Star.ghc86.template @@ -0,0 +1,422 @@ +Singletons/Star.hs:0:0:: Splicing declarations + singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec] + ======> + data Rep :: Type + where + Singletons.Star.Nat :: Rep + Singletons.Star.Int :: Rep + Singletons.Star.String :: Rep + Singletons.Star.Maybe :: Rep -> Rep + Singletons.Star.Vec :: Rep -> Nat -> Rep + deriving (Eq, Ord, Read, Show) + type NatSym0 = Nat + type IntSym0 = Int + type StringSym0 = String + type MaybeSym1 (t0123456789876543210 :: Type) = + Maybe t0123456789876543210 + instance SuppressUnusedWarnings MaybeSym0 where + suppressUnusedWarnings = snd (((,) MaybeSym0KindInference) ()) + data MaybeSym0 :: (~>) Type Type + where + MaybeSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => + MaybeSym0 t0123456789876543210 + type instance Apply MaybeSym0 t0123456789876543210 = Maybe t0123456789876543210 + type VecSym2 (t0123456789876543210 :: Type) (t0123456789876543210 :: Nat) = + Vec t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (VecSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) VecSym1KindInference) ()) + data VecSym1 (t0123456789876543210 :: Type) :: (~>) Nat Type + where + VecSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (VecSym1 t0123456789876543210) arg) (VecSym2 t0123456789876543210 arg) => + VecSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (VecSym1 t0123456789876543210) t0123456789876543210 = Vec t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings VecSym0 where + suppressUnusedWarnings = snd (((,) VecSym0KindInference) ()) + data VecSym0 :: (~>) Type ((~>) Nat Type) + where + VecSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => + VecSym0 t0123456789876543210 + type instance Apply VecSym0 t0123456789876543210 = VecSym1 t0123456789876543210 + type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where + Equals_0123456789876543210 Nat Nat = TrueSym0 + Equals_0123456789876543210 Int Int = TrueSym0 + Equals_0123456789876543210 String String = TrueSym0 + Equals_0123456789876543210 (Maybe a) (Maybe b) = (==) a b + Equals_0123456789876543210 (Vec a a) (Vec b b) = (&&) ((==) a b) ((==) a b) + Equals_0123456789876543210 (_ :: Type) (_ :: Type) = FalseSym0 + instance PEq Type where + type (==) a b = Equals_0123456789876543210 a b + type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where + Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) + Compare_0123456789876543210 Nat Int = LTSym0 + Compare_0123456789876543210 Nat String = LTSym0 + Compare_0123456789876543210 Nat (Maybe _) = LTSym0 + Compare_0123456789876543210 Nat (Vec _ _) = LTSym0 + Compare_0123456789876543210 Int Nat = GTSym0 + Compare_0123456789876543210 Int String = LTSym0 + Compare_0123456789876543210 Int (Maybe _) = LTSym0 + Compare_0123456789876543210 Int (Vec _ _) = LTSym0 + Compare_0123456789876543210 String Nat = GTSym0 + Compare_0123456789876543210 String Int = GTSym0 + Compare_0123456789876543210 String (Maybe _) = LTSym0 + Compare_0123456789876543210 String (Vec _ _) = LTSym0 + Compare_0123456789876543210 (Maybe _) Nat = GTSym0 + Compare_0123456789876543210 (Maybe _) Int = GTSym0 + Compare_0123456789876543210 (Maybe _) String = GTSym0 + Compare_0123456789876543210 (Maybe _) (Vec _ _) = LTSym0 + Compare_0123456789876543210 (Vec _ _) Nat = GTSym0 + Compare_0123456789876543210 (Vec _ _) Int = GTSym0 + Compare_0123456789876543210 (Vec _ _) String = GTSym0 + Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Type) :: (~>) Type Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Type where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ Nat a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nat") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Int a_0123456789876543210 = Apply (Apply ShowStringSym0 "Int") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Type ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Type where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + data instance Sing :: Type -> Type + where + SNat :: Sing Nat + SInt :: Sing Int + SString :: Sing String + SMaybe :: forall (n :: Type). (Sing (n :: Type)) -> Sing (Maybe n) + SVec :: forall (n :: Type) (n :: Nat). + (Sing (n :: Type)) -> (Sing (n :: Nat)) -> Sing (Vec n n) + type SRep = (Sing :: Type -> Type) + instance SingKind Type where + type Demote Type = Rep + fromSing SNat = Singletons.Star.Nat + fromSing SInt = Singletons.Star.Int + fromSing SString = Singletons.Star.String + fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) + fromSing (SVec b b) + = (Singletons.Star.Vec (fromSing b)) (fromSing b) + toSing Singletons.Star.Nat = SomeSing SNat + toSing Singletons.Star.Int = SomeSing SInt + toSing Singletons.Star.String = SomeSing SString + toSing (Singletons.Star.Maybe (b :: Demote Type)) + = case toSing b :: SomeSing Type of { + SomeSing c -> SomeSing (SMaybe c) } + toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat)) + = case + ((,) (toSing b :: SomeSing Type)) (toSing b :: SomeSing Nat) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVec c) c) } + instance (SEq Type, SEq Nat) => SEq Type where + (%==) SNat SNat = STrue + (%==) SNat SInt = SFalse + (%==) SNat SString = SFalse + (%==) SNat (SMaybe _) = SFalse + (%==) SNat (SVec _ _) = SFalse + (%==) SInt SNat = SFalse + (%==) SInt SInt = STrue + (%==) SInt SString = SFalse + (%==) SInt (SMaybe _) = SFalse + (%==) SInt (SVec _ _) = SFalse + (%==) SString SNat = SFalse + (%==) SString SInt = SFalse + (%==) SString SString = STrue + (%==) SString (SMaybe _) = SFalse + (%==) SString (SVec _ _) = SFalse + (%==) (SMaybe _) SNat = SFalse + (%==) (SMaybe _) SInt = SFalse + (%==) (SMaybe _) SString = SFalse + (%==) (SMaybe a) (SMaybe b) = ((%==) a) b + (%==) (SMaybe _) (SVec _ _) = SFalse + (%==) (SVec _ _) SNat = SFalse + (%==) (SVec _ _) SInt = SFalse + (%==) (SVec _ _) SString = SFalse + (%==) (SVec _ _) (SMaybe _) = SFalse + (%==) (SVec a a) (SVec b b) = ((%&&) (((%==) a) b)) (((%==) a) b) + instance (SDecide Type, SDecide Nat) => SDecide Type where + (%~) SNat SNat = Proved Refl + (%~) SNat SInt = Disproved (\ x -> case x of) + (%~) SNat SString = Disproved (\ x -> case x of) + (%~) SNat (SMaybe _) = Disproved (\ x -> case x of) + (%~) SNat (SVec _ _) = Disproved (\ x -> case x of) + (%~) SInt SNat = Disproved (\ x -> case x of) + (%~) SInt SInt = Proved Refl + (%~) SInt SString = Disproved (\ x -> case x of) + (%~) SInt (SMaybe _) = Disproved (\ x -> case x of) + (%~) SInt (SVec _ _) = Disproved (\ x -> case x of) + (%~) SString SNat = Disproved (\ x -> case x of) + (%~) SString SInt = Disproved (\ x -> case x of) + (%~) SString SString = Proved Refl + (%~) SString (SMaybe _) = Disproved (\ x -> case x of) + (%~) SString (SVec _ _) = Disproved (\ x -> case x of) + (%~) (SMaybe _) SNat = Disproved (\ x -> case x of) + (%~) (SMaybe _) SInt = Disproved (\ x -> case x of) + (%~) (SMaybe _) SString = Disproved (\ x -> case x of) + (%~) (SMaybe a) (SMaybe b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (%~) (SMaybe _) (SVec _ _) = Disproved (\ x -> case x of) + (%~) (SVec _ _) SNat = Disproved (\ x -> case x of) + (%~) (SVec _ _) SInt = Disproved (\ x -> case x of) + (%~) (SVec _ _) SString = Disproved (\ x -> case x of) + (%~) (SVec _ _) (SMaybe _) = Disproved (\ x -> case x of) + (%~) (SVec a a) (SVec b b) + = case ((,) (((%~) a) b)) (((%~) a) b) of + (,) (Proved Refl) (Proved Refl) -> Proved Refl + (,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + (,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance (SOrd Type, SOrd Nat) => SOrd Type where + sCompare :: + forall (t1 :: Type) (t2 :: Type). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Type ((~>) Type Ordering) + -> Type) t1) t2) + sCompare SNat SNat + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SInt SInt + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare SString SString + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + SNil + sCompare + (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil) + sCompare + (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) + (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + SNil)) + sCompare SNat SInt = SLT + sCompare SNat SString = SLT + sCompare SNat (SMaybe _) = SLT + sCompare SNat (SVec _ _) = SLT + sCompare SInt SNat = SGT + sCompare SInt SString = SLT + sCompare SInt (SMaybe _) = SLT + sCompare SInt (SVec _ _) = SLT + sCompare SString SNat = SGT + sCompare SString SInt = SGT + sCompare SString (SMaybe _) = SLT + sCompare SString (SVec _ _) = SLT + sCompare (SMaybe _) SNat = SGT + sCompare (SMaybe _) SInt = SGT + sCompare (SMaybe _) SString = SGT + sCompare (SMaybe _) (SVec _ _) = SLT + sCompare (SVec _ _) SNat = SGT + sCompare (SVec _ _) SInt = SGT + sCompare (SVec _ _) SString = SGT + sCompare (SVec _ _) (SMaybe _) = SGT + instance (SShow Type, SShow Nat) => SShow Type where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: Type) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) + -> Type) t1) t2) t3) + sShowsPrec + _ + SNat + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Nat"))) + sA_0123456789876543210 + sShowsPrec + _ + SInt + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Int"))) + sA_0123456789876543210 + sShowsPrec + _ + SString + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "String"))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SMaybe (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Maybe ")))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))) + sA_0123456789876543210 + sShowsPrec + (sP_0123456789876543210 :: Sing p_0123456789876543210) + (SVec (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + ((applySing ((singFun3 @ShowParenSym0) sShowParen)) + ((applySing + ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) + (sFromInteger (sing :: Sing 10))))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Vec ")))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @ShowSpaceSym0) sShowSpace))) + ((applySing + ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) + (sFromInteger (sing :: Sing 11)))) + sArg_0123456789876543210)))))) + sA_0123456789876543210 + instance SingI Nat where + sing = SNat + instance SingI Int where + sing = SInt + instance SingI String where + sing = SString + instance SingI n => SingI (Maybe (n :: Type)) where + sing = SMaybe sing + instance SingI (MaybeSym0 :: (~>) Type Type) where + sing = (singFun1 @MaybeSym0) SMaybe + instance SingI (TyCon1 Maybe :: (~>) Type Type) where + sing = (singFun1 @(TyCon1 Maybe)) SMaybe + instance (SingI n, SingI n) => + SingI (Vec (n :: Type) (n :: Nat)) where + sing = (SVec sing) sing + instance SingI (VecSym0 :: (~>) Type ((~>) Nat Type)) where + sing = (singFun2 @VecSym0) SVec + instance SingI (TyCon2 Vec :: (~>) Type ((~>) Nat Type)) where + sing = (singFun2 @(TyCon2 Vec)) SVec + instance SingI d => + SingI (VecSym1 (d :: Type) :: (~>) Nat Type) where + sing = (singFun1 @(VecSym1 (d :: Type))) (SVec (sing @d)) + instance SingI d => + SingI (TyCon1 (Vec (d :: Type)) :: (~>) Nat Type) where + sing = (singFun1 @(TyCon1 (Vec (d :: Type)))) (SVec (sing @d)) 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,12 +1,10 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - module Singletons.Star where import Data.Singletons.Prelude import Data.Singletons.Decide import Data.Singletons.CustomStar import Singletons.Nat -import Data.Kind +import Data.Kind (Type) data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero diff --git a/tests/compile-and-dump/Singletons/T124.ghc84.template b/tests/compile-and-dump/Singletons/T124.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T124.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/T124.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T124.ghc86.template @@ -0,0 +1,33 @@ +Singletons/T124.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> () + foo True = () + foo False = () |] + ======> + foo :: Bool -> () + foo True = () + foo False = () + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) Bool () + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Foo (a :: Bool) :: () where + Foo 'True = Tuple0Sym0 + Foo 'False = Tuple0Sym0 + sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo STrue = STuple0 + sFoo SFalse = STuple0 + instance SingI (FooSym0 :: (~>) Bool ()) where + sing = (singFun1 @FooSym0) sFoo +Singletons/T124.hs:0:0:: Splicing expression + sCases ''Bool [| b |] [| STuple0 |] + ======> + case b of + SFalse -> STuple0 + STrue -> STuple0 diff --git a/tests/compile-and-dump/Singletons/T136.ghc84.template b/tests/compile-and-dump/Singletons/T136.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T136.ghc84.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 = 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/T136.ghc86.template b/tests/compile-and-dump/Singletons/T136.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136.ghc86.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 [] = [True] + succ (False : as) = (True : as) + succ (True : as) = (False : succ as) + pred [] = error "pred 0" + pred (False : as) = (True : pred as) + pred (True : as) = (False : as) + toEnum i + | (i < 0) = error "negative toEnum" + | (i == 0) = [] + | otherwise = succ (toEnum (pred i)) + fromEnum [] = 0 + fromEnum (False : as) = (2 * fromEnum as) + fromEnum (True : as) = (1 + (2 * fromEnum as)) + type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where + Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) '[] + Succ_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as + Succ_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as) + type Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + Succ_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Succ_0123456789876543210Sym0KindInference) ()) + data Succ_0123456789876543210Sym0 :: (~>) [Bool] [Bool] + where + Succ_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => + Succ_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Succ_0123456789876543210Sym0 a0123456789876543210 = Succ_0123456789876543210 a0123456789876543210 + type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where + Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0" + Pred_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) (Apply PredSym0 as) + Pred_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) as + type Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + Pred_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Pred_0123456789876543210Sym0KindInference) ()) + data Pred_0123456789876543210Sym0 :: (~>) [Bool] [Bool] + where + Pred_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => + Pred_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Pred_0123456789876543210Sym0 a0123456789876543210 = Pred_0123456789876543210 a0123456789876543210 + type family Case_0123456789876543210 i arg_0123456789876543210 t where + Case_0123456789876543210 i arg_0123456789876543210 'True = '[] + Case_0123456789876543210 i arg_0123456789876543210 'False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) + type family Case_0123456789876543210 i arg_0123456789876543210 t where + Case_0123456789876543210 i arg_0123456789876543210 'True = Apply ErrorSym0 "negative toEnum" + Case_0123456789876543210 i arg_0123456789876543210 'False = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)) + type family Case_0123456789876543210 arg_0123456789876543210 t where + Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0)) + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where + ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) + data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat [Bool] + where + ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 + type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where + FromEnum_0123456789876543210 '[] = FromInteger 0 + FromEnum_0123456789876543210 ( '(:) 'False as) = Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as) + FromEnum_0123456789876543210 ( '(:) 'True as) = Apply (Apply (+@#@$) (FromInteger 1)) (Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as)) + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + FromEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) + data FromEnum_0123456789876543210Sym0 :: (~>) [Bool] GHC.Types.Nat + where + FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 + instance PEnum [Bool] where + type Succ a = Apply Succ_0123456789876543210Sym0 a + type Pred a = Apply Pred_0123456789876543210Sym0 a + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + instance SEnum [Bool] where + sSucc :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t) + sPred :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t) + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool] + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: [Bool]). + Sing t + -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat + -> GHC.Types.Type) t) + sSucc SNil + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) SNil + sSucc (SCons SFalse (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) sAs + sSucc (SCons STrue (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) + ((applySing ((singFun1 @SuccSym0) sSucc)) sAs) + sPred SNil = sError (sing :: Sing "pred 0") + sPred (SCons SFalse (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) + ((applySing ((singFun1 @PredSym0) sPred)) sAs) + sPred (SCons STrue (sAs :: Sing as)) + = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) sAs + sToEnum (sArg_0123456789876543210 :: Sing arg_0123456789876543210) + = (case sArg_0123456789876543210 of { + (sI :: Sing i) + -> (case + (applySing ((applySing ((singFun2 @(<@#@$)) (%<))) sI)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> sError (sing :: Sing "negative toEnum") + SFalse + -> (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sI)) + (sFromInteger (sing :: Sing 0)) + of + STrue -> SNil + SFalse + -> (applySing ((singFun1 @SuccSym0) sSucc)) + ((applySing ((singFun1 @ToEnumSym0) sToEnum)) + ((applySing ((singFun1 @PredSym0) sPred)) sI))) :: + Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)))) :: + Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0))) }) :: + Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210) + sFromEnum SNil = sFromInteger (sing :: Sing 0) + sFromEnum (SCons SFalse (sAs :: Sing as)) + = (applySing + ((applySing ((singFun2 @(*@#@$)) (%*))) + (sFromInteger (sing :: Sing 2)))) + ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs) + sFromEnum (SCons STrue (sAs :: Sing as)) + = (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) + (sFromInteger (sing :: Sing 1)))) + ((applySing + ((applySing ((singFun2 @(*@#@$)) (%*))) + (sFromInteger (sing :: Sing 2)))) + ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs)) diff --git a/tests/compile-and-dump/Singletons/T136b.ghc84.template b/tests/compile-and-dump/Singletons/T136b.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T136b.ghc84.template +++ /dev/null @@ -1,48 +0,0 @@ -Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| class C a where - meth :: a -> a |] - ======> - class C a where - meth :: a -> a - type MethSym1 (t :: a0123456789876543210) = Meth t - instance SuppressUnusedWarnings MethSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.()) - data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => - MethSym0KindInference - type instance Apply MethSym0 l = Meth l - class PC (a :: GHC.Types.Type) where - type Meth (arg :: a) :: a - class SC a where - sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) -Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| instance C Bool where - meth = not |] - ======> - instance C Bool where - meth = not - type family Meth_0123456789876543210 (a :: Bool) :: Bool where - Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym1 (t :: Bool) = - Meth_0123456789876543210 t - instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => - Meth_0123456789876543210Sym0KindInference - type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l - instance PC Bool where - type Meth a = Apply Meth_0123456789876543210Sym0 a - instance SC Bool where - sMeth :: - forall (t :: Bool). - Sing t - -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> GHC.Types.Type) t) - sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T136b.ghc86.template b/tests/compile-and-dump/Singletons/T136b.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136b.ghc86.template @@ -0,0 +1,53 @@ +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class C a where + meth :: a -> a |] + ======> + class C a where + meth :: a -> a + type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = + Meth arg0123456789876543210 + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) + data MethSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + MethSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => + MethSym0 arg0123456789876543210 + type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210 + class PC (a :: GHC.Types.Type) where + type Meth (arg :: a) :: a + class SC a where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) + instance SC a => SingI (MethSym0 :: (~>) a a) where + sing = (singFun1 @MethSym0) sMeth +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance C Bool where + meth = not |] + ======> + instance C Bool where + meth = not + type family Meth_0123456789876543210 (a :: Bool) :: Bool where + Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 + type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + Meth_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) + data Meth_0123456789876543210Sym0 :: (~>) Bool Bool + where + Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => + Meth_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 + instance PC Bool where + type Meth a = Apply Meth_0123456789876543210Sym0 a + instance SC Bool where + sMeth :: + forall (t :: Bool). + Sing t + -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> GHC.Types.Type) t) + sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T145.ghc84.template b/tests/compile-and-dump/Singletons/T145.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T145.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/T145.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T145.ghc86.template @@ -0,0 +1,39 @@ +Singletons/T145.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Column (f :: Type -> Type) where + col :: f a -> a -> Bool |] + ======> + class Column (f :: Type -> Type) where + col :: f a -> a -> Bool + type ColSym2 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + Col arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (ColSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) ColSym1KindInference) ()) + data ColSym1 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) :: (~>) a0123456789876543210 Bool + where + ColSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (ColSym1 arg0123456789876543210) arg) (ColSym2 arg0123456789876543210 arg) => + ColSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = Col arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings ColSym0 where + suppressUnusedWarnings = snd (((,) ColSym0KindInference) ()) + data ColSym0 :: forall a0123456789876543210 f0123456789876543210. + (~>) (f0123456789876543210 a0123456789876543210) ((~>) a0123456789876543210 Bool) + where + ColSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) => + ColSym0 arg0123456789876543210 + type instance Apply ColSym0 arg0123456789876543210 = ColSym1 arg0123456789876543210 + class PColumn (f :: Type -> Type) where + type Col (arg :: f a) (arg :: a) :: Bool + class SColumn (f :: Type -> Type) where + sCol :: + forall a (t :: f a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool) + instance SColumn f => + SingI (ColSym0 :: (~>) (f a) ((~>) a Bool)) where + sing = (singFun2 @ColSym0) sCol + instance (SColumn f, SingI d) => + SingI (ColSym1 (d :: f a) :: (~>) a Bool) where + sing = (singFun1 @(ColSym1 (d :: f a))) (sCol (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T145.hs b/tests/compile-and-dump/Singletons/T145.hs --- a/tests/compile-and-dump/Singletons/T145.hs +++ b/tests/compile-and-dump/Singletons/T145.hs @@ -1,7 +1,7 @@ module Singletons.T145 where import Data.Singletons.TH -import Data.Kind +import Data.Kind (Type) $(singletons [d| class Column (f :: Type -> Type) where diff --git a/tests/compile-and-dump/Singletons/T153.ghc84.template b/tests/compile-and-dump/Singletons/T153.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T153.ghc84.template +++ /dev/null diff --git a/tests/compile-and-dump/Singletons/T153.ghc86.template b/tests/compile-and-dump/Singletons/T153.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T153.ghc86.template diff --git a/tests/compile-and-dump/Singletons/T153.hs b/tests/compile-and-dump/Singletons/T153.hs --- a/tests/compile-and-dump/Singletons/T153.hs +++ b/tests/compile-and-dump/Singletons/T153.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeInType, +{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeApplications, RankNTypes #-} module Singletons.T153 where diff --git a/tests/compile-and-dump/Singletons/T157.ghc84.template b/tests/compile-and-dump/Singletons/T157.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T157.ghc84.template +++ /dev/null diff --git a/tests/compile-and-dump/Singletons/T157.ghc86.template b/tests/compile-and-dump/Singletons/T157.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T157.ghc86.template diff --git a/tests/compile-and-dump/Singletons/T159.ghc84.template b/tests/compile-and-dump/Singletons/T159.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T159.ghc84.template +++ /dev/null @@ -1,184 +0,0 @@ -Singletons/T159.hs:0:0:: Splicing declarations - genSingletons [''T0, ''T1] - ======> - type ASym0 = A - type BSym0 = B - type CSym0 = C - type DSym0 = D - type ESym0 = E - type FSym0 = F - data instance Sing (z :: T0) - where - SA :: Sing A - SB :: Sing B - SC :: Sing C - SD :: Sing D - SE :: Sing E - SF :: Sing F - type ST0 = (Sing :: T0 -> GHC.Types.Type) - instance SingKind T0 where - type Demote T0 = T0 - fromSing SA = A - fromSing SB = B - fromSing SC = C - fromSing SD = D - fromSing SE = E - fromSing SF = F - toSing A = SomeSing SA - toSing B = SomeSing SB - toSing C = SomeSing SC - toSing D = SomeSing SD - toSing E = SomeSing SE - toSing F = SomeSing SF - instance SingI A where - sing = SA - instance SingI B where - sing = SB - instance SingI C where - sing = SC - instance SingI D where - sing = SD - instance SingI E where - sing = SE - instance SingI F where - sing = SF - type N1Sym0 = N1 - type C1Sym2 (t :: T0) (t :: T1) = C1 t t - instance SuppressUnusedWarnings C1Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) C1Sym1KindInference) GHC.Tuple.()) - data C1Sym1 (l :: T0) (l :: TyFun T1 T1) - = forall arg. SameKind (Apply (C1Sym1 l) arg) (C1Sym2 l arg) => - C1Sym1KindInference - type instance Apply (C1Sym1 l) l = C1 l l - instance SuppressUnusedWarnings C1Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) C1Sym0KindInference) GHC.Tuple.()) - data C1Sym0 (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) - = forall arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => - C1Sym0KindInference - type instance Apply C1Sym0 l = C1Sym1 l - type (:&&@#@$$$) (t :: T0) (t :: T1) = (:&&) t t - instance SuppressUnusedWarnings (:&&@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::&&@#@$$###)) GHC.Tuple.()) - data (:&&@#@$$) (l :: T0) (l :: TyFun T1 T1) - = forall arg. SameKind (Apply ((:&&@#@$$) l) arg) ((:&&@#@$$$) l arg) => - (::&&@#@$$###) - type instance Apply ((:&&@#@$$) l) l = (:&&) l l - instance SuppressUnusedWarnings (:&&@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::&&@#@$###)) GHC.Tuple.()) - data (:&&@#@$) (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => - (::&&@#@$###) - type instance Apply (:&&@#@$) l = (:&&@#@$$) l - data instance Sing (z :: T1) - where - SN1 :: Sing N1 - SC1 :: forall (n :: T0) (n :: T1). - (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing (C1 n n) - (:%&&) :: forall (n :: T0) (n :: T1). - (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ((:&&) n n) - type ST1 = (Sing :: T1 -> GHC.Types.Type) - instance SingKind T1 where - type Demote T1 = T1 - fromSing SN1 = N1 - fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b) - fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b) - toSing N1 = SomeSing SN1 - toSing (C1 (b :: Demote T0) (b :: Demote T1)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) } - toSing ((:&&) (b :: Demote T0) (b :: Demote T1)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%&&) c) c) } - infixr 5 `SC1` - infixr 5 :%&& - instance SingI N1 where - sing = SN1 - instance (SingI n, SingI n) => SingI (C1 (n :: T0) (n :: T1)) where - sing = (SC1 sing) sing - instance (SingI n, SingI n) => - SingI ((:&&) (n :: T0) (n :: T1)) where - sing = ((:%&&) sing) sing -Singletons/T159.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixr 5 :|| - infixr 5 `C2` - - data T2 = N2 | C2 T0 T2 | T0 :|| T2 |] - ======> - data T2 = N2 | C2 T0 T2 | T0 :|| T2 - infixr 5 `C2` - infixr 5 :|| - type N2Sym0 = N2 - type C2Sym2 (t :: T0) (t :: T2) = C2 t t - instance SuppressUnusedWarnings C2Sym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) C2Sym1KindInference) GHC.Tuple.()) - data C2Sym1 (l :: T0) (l :: TyFun T2 T2) - = forall arg. SameKind (Apply (C2Sym1 l) arg) (C2Sym2 l arg) => - C2Sym1KindInference - type instance Apply (C2Sym1 l) l = C2 l l - instance SuppressUnusedWarnings C2Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) C2Sym0KindInference) GHC.Tuple.()) - data C2Sym0 (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) - = forall arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => - C2Sym0KindInference - type instance Apply C2Sym0 l = C2Sym1 l - type (:||@#@$$$) (t :: T0) (t :: T2) = (:||) t t - instance SuppressUnusedWarnings (:||@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::||@#@$$###)) GHC.Tuple.()) - data (:||@#@$$) (l :: T0) (l :: TyFun T2 T2) - = forall arg. SameKind (Apply ((:||@#@$$) l) arg) ((:||@#@$$$) l arg) => - (::||@#@$$###) - type instance Apply ((:||@#@$$) l) l = (:||) l l - instance SuppressUnusedWarnings (:||@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::||@#@$###)) GHC.Tuple.()) - data (:||@#@$) (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => - (::||@#@$###) - type instance Apply (:||@#@$) l = (:||@#@$$) l - infixr 5 :%|| - infixr 5 `SC2` - data instance Sing (z :: T2) - where - SN2 :: Sing N2 - SC2 :: forall (n :: T0) (n :: T2). - (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing (C2 n n) - (:%||) :: forall (n :: T0) (n :: T2). - (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing ((:||) n n) - type ST2 = (Sing :: T2 -> GHC.Types.Type) - instance SingKind T2 where - type Demote T2 = T2 - fromSing SN2 = N2 - fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b) - fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b) - toSing N2 = SomeSing SN2 - toSing (C2 (b :: Demote T0) (b :: Demote T2)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) } - toSing ((:||) (b :: Demote T0) (b :: Demote T2)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%||) c) c) } - instance SingI N2 where - sing = SN2 - instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where - sing = (SC2 sing) sing - instance (SingI n, SingI n) => - SingI ((:||) (n :: T0) (n :: T2)) where - sing = ((:%||) sing) sing diff --git a/tests/compile-and-dump/Singletons/T159.ghc86.template b/tests/compile-and-dump/Singletons/T159.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T159.ghc86.template @@ -0,0 +1,245 @@ +Singletons/T159.hs:0:0:: Splicing declarations + genSingletons [''T0, ''T1] + ======> + type ASym0 = 'A + type BSym0 = 'B + type CSym0 = 'C + type DSym0 = 'D + type ESym0 = 'E + type FSym0 = 'F + data instance Sing :: T0 -> GHC.Types.Type + where + SA :: Sing 'A + SB :: Sing 'B + SC :: Sing 'C + SD :: Sing 'D + SE :: Sing 'E + SF :: Sing 'F + type ST0 = (Sing :: T0 -> GHC.Types.Type) + instance SingKind T0 where + type Demote T0 = T0 + fromSing SA = A + fromSing SB = B + fromSing SC = C + fromSing SD = D + fromSing SE = E + fromSing SF = F + toSing A = SomeSing SA + toSing B = SomeSing SB + toSing C = SomeSing SC + toSing D = SomeSing SD + toSing E = SomeSing SE + toSing F = SomeSing SF + instance SingI 'A where + sing = SA + instance SingI 'B where + sing = SB + instance SingI 'C where + sing = SC + instance SingI 'D where + sing = SD + instance SingI 'E where + sing = SE + instance SingI 'F where + sing = SF + type N1Sym0 = 'N1 + type C1Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = + 'C1 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (C1Sym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) C1Sym1KindInference) ()) + data C1Sym1 (t0123456789876543210 :: T0) :: (~>) T1 T1 + where + C1Sym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (C1Sym1 t0123456789876543210) arg) (C1Sym2 t0123456789876543210 arg) => + C1Sym1 t0123456789876543210 t0123456789876543210 + type instance Apply (C1Sym1 t0123456789876543210) t0123456789876543210 = 'C1 t0123456789876543210 t0123456789876543210 + infixr 5 `C1Sym1` + instance SuppressUnusedWarnings C1Sym0 where + suppressUnusedWarnings = snd (((,) C1Sym0KindInference) ()) + data C1Sym0 :: (~>) T0 ((~>) T1 T1) + where + C1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => + C1Sym0 t0123456789876543210 + type instance Apply C1Sym0 t0123456789876543210 = C1Sym1 t0123456789876543210 + infixr 5 `C1Sym0` + type (:&&@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = + '(:&&) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:&&@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::&&@#@$$###)) ()) + data (:&&@#@$$) (t0123456789876543210 :: T0) :: (~>) T1 T1 + where + (::&&@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:&&@#@$$) t0123456789876543210) arg) ((:&&@#@$$$) t0123456789876543210 arg) => + (:&&@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:&&@#@$$) t0123456789876543210) t0123456789876543210 = '(:&&) t0123456789876543210 t0123456789876543210 + infixr 5 :&&@#@$$ + instance SuppressUnusedWarnings (:&&@#@$) where + suppressUnusedWarnings = snd (((,) (::&&@#@$###)) ()) + data (:&&@#@$) :: (~>) T0 ((~>) T1 T1) + where + (::&&@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => + (:&&@#@$) t0123456789876543210 + type instance Apply (:&&@#@$) t0123456789876543210 = (:&&@#@$$) t0123456789876543210 + infixr 5 :&&@#@$ + data instance Sing :: T1 -> GHC.Types.Type + where + SN1 :: Sing 'N1 + SC1 :: forall (n :: T0) (n :: T1). + (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( 'C1 n n) + (:%&&) :: forall (n :: T0) (n :: T1). + (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( '(:&&) n n) + type ST1 = (Sing :: T1 -> GHC.Types.Type) + instance SingKind T1 where + type Demote T1 = T1 + fromSing SN1 = N1 + fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b) + fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b) + toSing N1 = SomeSing SN1 + toSing (C1 (b :: Demote T0) (b :: Demote T1)) + = case + ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) } + toSing ((:&&) (b :: Demote T0) (b :: Demote T1)) + = case + ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&&) c) c) } + infixr 5 `SC1` + infixr 5 :%&& + instance SingI 'N1 where + sing = SN1 + instance (SingI n, SingI n) => + SingI ( 'C1 (n :: T0) (n :: T1)) where + sing = (SC1 sing) sing + instance SingI (C1Sym0 :: (~>) T0 ((~>) T1 T1)) where + sing = (singFun2 @C1Sym0) SC1 + instance SingI (TyCon2 'C1 :: (~>) T0 ((~>) T1 T1)) where + sing = (singFun2 @(TyCon2 'C1)) SC1 + instance SingI d => SingI (C1Sym1 (d :: T0) :: (~>) T1 T1) where + sing = (singFun1 @(C1Sym1 (d :: T0))) (SC1 (sing @d)) + instance SingI d => + SingI (TyCon1 ( 'C1 (d :: T0)) :: (~>) T1 T1) where + sing = (singFun1 @(TyCon1 ( 'C1 (d :: T0)))) (SC1 (sing @d)) + instance (SingI n, SingI n) => + SingI ( '(:&&) (n :: T0) (n :: T1)) where + sing = ((:%&&) sing) sing + instance SingI ((:&&@#@$) :: (~>) T0 ((~>) T1 T1)) where + sing = (singFun2 @(:&&@#@$)) (:%&&) + instance SingI (TyCon2 '(:&&) :: (~>) T0 ((~>) T1 T1)) where + sing = (singFun2 @(TyCon2 '(:&&))) (:%&&) + instance SingI d => + SingI ((:&&@#@$$) (d :: T0) :: (~>) T1 T1) where + sing = (singFun1 @((:&&@#@$$) (d :: T0))) ((:%&&) (sing @d)) + instance SingI d => + SingI (TyCon1 ( '(:&&) (d :: T0)) :: (~>) T1 T1) where + sing = (singFun1 @(TyCon1 ( '(:&&) (d :: T0)))) ((:%&&) (sing @d)) +Singletons/T159.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixr 5 :|| + infixr 5 `C2` + + data T2 = N2 | C2 T0 T2 | T0 :|| T2 |] + ======> + data T2 = N2 | C2 T0 T2 | T0 :|| T2 + infixr 5 `C2` + infixr 5 :|| + type N2Sym0 = N2 + type C2Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = + C2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (C2Sym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) C2Sym1KindInference) ()) + data C2Sym1 (t0123456789876543210 :: T0) :: (~>) T2 T2 + where + C2Sym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (C2Sym1 t0123456789876543210) arg) (C2Sym2 t0123456789876543210 arg) => + C2Sym1 t0123456789876543210 t0123456789876543210 + type instance Apply (C2Sym1 t0123456789876543210) t0123456789876543210 = C2 t0123456789876543210 t0123456789876543210 + infixr 5 `C2Sym1` + instance SuppressUnusedWarnings C2Sym0 where + suppressUnusedWarnings = snd (((,) C2Sym0KindInference) ()) + data C2Sym0 :: (~>) T0 ((~>) T2 T2) + where + C2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => + C2Sym0 t0123456789876543210 + type instance Apply C2Sym0 t0123456789876543210 = C2Sym1 t0123456789876543210 + infixr 5 `C2Sym0` + type (:||@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = + (:||) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:||@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::||@#@$$###)) ()) + data (:||@#@$$) (t0123456789876543210 :: T0) :: (~>) T2 T2 + where + (::||@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:||@#@$$) t0123456789876543210) arg) ((:||@#@$$$) t0123456789876543210 arg) => + (:||@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:||@#@$$) t0123456789876543210) t0123456789876543210 = (:||) t0123456789876543210 t0123456789876543210 + infixr 5 :||@#@$$ + instance SuppressUnusedWarnings (:||@#@$) where + suppressUnusedWarnings = snd (((,) (::||@#@$###)) ()) + data (:||@#@$) :: (~>) T0 ((~>) T2 T2) + where + (::||@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => + (:||@#@$) t0123456789876543210 + type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210 + infixr 5 :||@#@$ + infixr 5 `SC2` + infixr 5 :%|| + data instance Sing :: T2 -> GHC.Types.Type + where + SN2 :: Sing N2 + SC2 :: forall (n :: T0) (n :: T2). + (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing (C2 n n) + (:%||) :: forall (n :: T0) (n :: T2). + (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing ((:||) n n) + type ST2 = (Sing :: T2 -> GHC.Types.Type) + instance SingKind T2 where + type Demote T2 = T2 + fromSing SN2 = N2 + fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b) + fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b) + toSing N2 = SomeSing SN2 + toSing (C2 (b :: Demote T0) (b :: Demote T2)) + = case + ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) } + toSing ((:||) (b :: Demote T0) (b :: Demote T2)) + = case + ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%||) c) c) } + instance SingI N2 where + sing = SN2 + instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where + sing = (SC2 sing) sing + instance SingI (C2Sym0 :: (~>) T0 ((~>) T2 T2)) where + sing = (singFun2 @C2Sym0) SC2 + instance SingI (TyCon2 C2 :: (~>) T0 ((~>) T2 T2)) where + sing = (singFun2 @(TyCon2 C2)) SC2 + instance SingI d => SingI (C2Sym1 (d :: T0) :: (~>) T2 T2) where + sing = (singFun1 @(C2Sym1 (d :: T0))) (SC2 (sing @d)) + instance SingI d => + SingI (TyCon1 (C2 (d :: T0)) :: (~>) T2 T2) where + sing = (singFun1 @(TyCon1 (C2 (d :: T0)))) (SC2 (sing @d)) + instance (SingI n, SingI n) => + SingI ((:||) (n :: T0) (n :: T2)) where + sing = ((:%||) sing) sing + instance SingI ((:||@#@$) :: (~>) T0 ((~>) T2 T2)) where + sing = (singFun2 @(:||@#@$)) (:%||) + instance SingI (TyCon2 (:||) :: (~>) T0 ((~>) T2 T2)) where + sing = (singFun2 @(TyCon2 (:||))) (:%||) + instance SingI d => + SingI ((:||@#@$$) (d :: T0) :: (~>) T2 T2) where + sing = (singFun1 @((:||@#@$$) (d :: T0))) ((:%||) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:||) (d :: T0)) :: (~>) T2 T2) where + sing = (singFun1 @(TyCon1 ((:||) (d :: T0)))) ((:%||) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T160.ghc86.template b/tests/compile-and-dump/Singletons/T160.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T160.ghc86.template @@ -0,0 +1,85 @@ +Singletons/T160.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: (Num a, Eq a) => a -> a + foo x = if x == 0 then 1 else typeError $ ShowType x |] + ======> + foo :: (Num a, Eq a) => a -> a + foo x = if (x == 0) then 1 else (typeError $ ShowType x) + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 x where + Let0123456789876543210Scrutinee_0123456789876543210 x = Apply (Apply (==@#@$) x) (FromInteger 0) + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x 'True = FromInteger 1 + Case_0123456789876543210 x 'False = Apply (Apply ($@#@$) TypeErrorSym0) (Apply ShowTypeSym0 x) + type FooSym1 (a0123456789876543210 :: a0123456789876543210) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Foo (a :: a) :: a where + Foo x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + sFoo :: + forall a (t :: a). + (SNum a, SEq a) => Sing t -> Sing (Apply FooSym0 t :: a) + sFoo (sX :: Sing x) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + sScrutinee_0123456789876543210 + = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sX)) + (sFromInteger (sing :: Sing 0)) + in (case sScrutinee_0123456789876543210 of + STrue -> sFromInteger (sing :: Sing 1) + SFalse + -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) + ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a) + instance (SNum a, SEq a) => SingI (FooSym0 :: (~>) a a) where + sing = (singFun1 @FooSym0) sFoo + +Singletons/T160.hs:0:0: error: + • t + • In the expression: + (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) + ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX) + In a case alternative: + SFalse + -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) + ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX) + In the expression: + (case sScrutinee_0123456789876543210 of + STrue -> sFromInteger (sing :: Sing 1) + SFalse + -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) + ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a) + | +7 | $(singletons + | ^^^^^^^^^^... + +Singletons/T160.hs:0:0: error: + • 1 + • In the expression: Refl + In an equation for ‘f’: f = Refl + | +13 | f = Refl + | ^^^^ diff --git a/tests/compile-and-dump/Singletons/T160.hs b/tests/compile-and-dump/Singletons/T160.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T160.hs @@ -0,0 +1,13 @@ +module T160 where + +import Data.Singletons.Prelude +import Data.Singletons.TH +import Data.Singletons.TypeError + +$(singletons + [d| foo :: (Num a, Eq a) => a -> a + foo x = if x == 0 then 1 else typeError $ ShowType x + |]) + +f :: Foo 1 :~: 42 +f = Refl diff --git a/tests/compile-and-dump/Singletons/T163.ghc84.template b/tests/compile-and-dump/Singletons/T163.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T163.ghc84.template +++ /dev/null @@ -1,37 +0,0 @@ -Singletons/T163.hs:0:0:: Splicing declarations - singletons [d| data a + b = L a | R b |] - ======> - data (+) a b = L a | R b - type LSym1 (t :: a0123456789876543210) = L t - instance SuppressUnusedWarnings LSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) LSym0KindInference) GHC.Tuple.()) - data LSym0 (l :: TyFun a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply LSym0 arg) (LSym1 arg) => - LSym0KindInference - type instance Apply LSym0 l = L l - type RSym1 (t :: b0123456789876543210) = R t - instance SuppressUnusedWarnings RSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) RSym0KindInference) GHC.Tuple.()) - data RSym0 (l :: TyFun b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply RSym0 arg) (RSym1 arg) => - RSym0KindInference - type instance Apply RSym0 l = R l - data instance Sing (z :: (+) a b) - where - SL :: forall (n :: a). (Sing (n :: a)) -> Sing (L n) - SR :: forall (n :: b). (Sing (n :: b)) -> Sing (R n) - type %+ = (Sing :: (+) a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind ((+) a b) where - type Demote ((+) a b) = (+) (Demote a) (Demote b) - fromSing (SL b) = L (fromSing b) - fromSing (SR b) = R (fromSing b) - toSing (L (b :: Demote a)) - = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SL c) } - toSing (R (b :: Demote b)) - = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SR c) } - instance SingI n => SingI (L (n :: a)) where - sing = SL sing - instance SingI n => SingI (R (n :: b)) where - sing = SR sing diff --git a/tests/compile-and-dump/Singletons/T163.ghc86.template b/tests/compile-and-dump/Singletons/T163.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T163.ghc86.template @@ -0,0 +1,51 @@ +Singletons/T163.hs:0:0:: Splicing declarations + singletons [d| data a + b = L a | R b |] + ======> + data (+) a b = L a | R b + type LSym1 (t0123456789876543210 :: a0123456789876543210) = + L t0123456789876543210 + instance SuppressUnusedWarnings LSym0 where + suppressUnusedWarnings = snd (((,) LSym0KindInference) ()) + data LSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210) + where + LSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply LSym0 arg) (LSym1 arg) => + LSym0 t0123456789876543210 + type instance Apply LSym0 t0123456789876543210 = L t0123456789876543210 + type RSym1 (t0123456789876543210 :: b0123456789876543210) = + R t0123456789876543210 + instance SuppressUnusedWarnings RSym0 where + suppressUnusedWarnings = snd (((,) RSym0KindInference) ()) + data RSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210) + where + RSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply RSym0 arg) (RSym1 arg) => + RSym0 t0123456789876543210 + type instance Apply RSym0 t0123456789876543210 = R t0123456789876543210 + data instance Sing :: (+) a b -> GHC.Types.Type + where + SL :: forall a (n :: a). (Sing (n :: a)) -> Sing (L n) + SR :: forall b (n :: b). (Sing (n :: b)) -> Sing (R n) + type (%+) = (Sing :: (+) a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind ((+) a b) where + type Demote ((+) a b) = (+) (Demote a) (Demote b) + fromSing (SL b) = L (fromSing b) + fromSing (SR b) = R (fromSing b) + toSing (L (b :: Demote a)) + = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SL c) } + toSing (R (b :: Demote b)) + = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SR c) } + instance SingI n => SingI (L (n :: a)) where + sing = SL sing + instance SingI (LSym0 :: (~>) a ((+) a b)) where + sing = (singFun1 @LSym0) SL + instance SingI (TyCon1 L :: (~>) a ((+) a b)) where + sing = (singFun1 @(TyCon1 L)) SL + instance SingI n => SingI (R (n :: b)) where + sing = SR sing + instance SingI (RSym0 :: (~>) b ((+) a b)) where + sing = (singFun1 @RSym0) SR + instance SingI (TyCon1 R :: (~>) b ((+) a b)) where + sing = (singFun1 @(TyCon1 R)) SR diff --git a/tests/compile-and-dump/Singletons/T166.ghc84.template b/tests/compile-and-dump/Singletons/T166.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T166.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/T166.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T166.ghc86.template @@ -0,0 +1,139 @@ +Singletons/T166.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [d| class Foo a where + foosPrec :: Nat -> a -> [Bool] -> [Bool] + foo :: a -> [Bool] + foo x s = foosPrec 0 x s |] + ======> + type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) + data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FoosPrecSym2KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => + FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) + data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) [Bool] [Bool]) + where + FoosPrecSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => + FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings FoosPrecSym0 where + suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) + data FoosPrecSym0 :: forall a0123456789876543210. + (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) + where + FoosPrecSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => + FoosPrecSym0 arg0123456789876543210 + type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 + type FooSym1 (arg0123456789876543210 :: a0123456789876543210) = + Foo arg0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 [Bool] + where + FooSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 arg0123456789876543210 + type instance Apply FooSym0 arg0123456789876543210 = Foo arg0123456789876543210 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x s = Apply (Apply (Apply FoosPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 0)) x) s + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type family Foo_0123456789876543210 (a :: a) :: [Bool] where + Foo_0123456789876543210 x = Apply Lambda_0123456789876543210Sym0 x + type Foo_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Foo_0123456789876543210Sym0KindInference) ()) + data Foo_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 [Bool] + where + Foo_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo_0123456789876543210Sym0 arg) (Foo_0123456789876543210Sym1 arg) => + Foo_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Foo_0123456789876543210Sym0 a0123456789876543210 = Foo_0123456789876543210 a0123456789876543210 + class PFoo (a :: GHC.Types.Type) where + type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] + type Foo (arg :: a) :: [Bool] + type Foo a = Apply Foo_0123456789876543210Sym0 a + class SFoo a where + sFoosPrec :: + forall (t :: Nat) (t :: a) (t :: [Bool]). + Sing t + -> Sing t + -> Sing t + -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) + sFoo :: forall (t :: a). Sing t -> Sing (Apply FooSym0 t :: [Bool]) + default sFoo :: + forall (t :: a). + (Apply FooSym0 t :: [Bool]) + ~ Apply Foo_0123456789876543210Sym0 t => + Sing t -> Sing (Apply FooSym0 t :: [Bool]) + sFoo (sX :: Sing x) + = (singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sS + -> case sS of { + (_ :: Sing s) + -> (applySing + ((applySing + ((applySing ((singFun3 @FoosPrecSym0) sFoosPrec)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)))) + sX)) + sS }) + instance SFoo a => + SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where + sing = (singFun3 @FoosPrecSym0) sFoosPrec + instance (SFoo a, SingI d) => + SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where + sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d)) + instance (SFoo a, SingI d, SingI d) => + SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where + sing + = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a))) + ((sFoosPrec (sing @d)) (sing @d)) + instance SFoo a => SingI (FooSym0 :: (~>) a [Bool]) where + sing = (singFun1 @FooSym0) sFoo + +Singletons/T166.hs:0:0: error: + • Expecting one more argument to ‘Apply Lambda_0123456789876543210Sym0 x’ + Expected kind ‘[Bool]’, + but ‘Apply Lambda_0123456789876543210Sym0 x’ has kind ‘TyFun + [Bool] [Bool] + -> Type’ + • In the type ‘Apply Lambda_0123456789876543210Sym0 x’ + In the type family declaration for ‘Foo_0123456789876543210’ + | +14 | $(singletonsOnly [d| + | ^^^^^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T167.ghc84.template b/tests/compile-and-dump/Singletons/T167.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T167.ghc84.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 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/T167.ghc86.template b/tests/compile-and-dump/Singletons/T167.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T167.ghc86.template @@ -0,0 +1,178 @@ +Singletons/T167.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [d| class Foo a where + foosPrec :: Nat -> a -> DiffList + fooList :: a -> DiffList + fooList = undefined + + instance Foo a => Foo [a] where + foosPrec _ = fooList |] + ======> + type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) + data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FoosPrecSym2KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => + FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) + data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) [Bool] [Bool]) + where + FoosPrecSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => + FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings FoosPrecSym0 where + suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) + data FoosPrecSym0 :: forall a0123456789876543210. + (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) + where + FoosPrecSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => + FoosPrecSym0 arg0123456789876543210 + type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 + type FooListSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FooList arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (FooListSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooListSym1KindInference) ()) + data FooListSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FooListSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FooListSym1 arg0123456789876543210) arg) (FooListSym2 arg0123456789876543210 arg) => + FooListSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FooListSym1 arg0123456789876543210) arg0123456789876543210 = FooList arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings FooListSym0 where + suppressUnusedWarnings = snd (((,) FooListSym0KindInference) ()) + data FooListSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) [Bool] [Bool]) + where + FooListSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => + FooListSym0 arg0123456789876543210 + type instance Apply FooListSym0 arg0123456789876543210 = FooListSym1 arg0123456789876543210 + type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where + FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210 + type FooList_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [Bool]) = + FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FooList_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FooList_0123456789876543210Sym1KindInference) ()) + data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FooList_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooList_0123456789876543210Sym1 a0123456789876543210) arg) (FooList_0123456789876543210Sym2 a0123456789876543210 arg) => + FooList_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FooList_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FooList_0123456789876543210Sym0KindInference) ()) + data FooList_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) [Bool] [Bool]) + where + FooList_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => + FooList_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FooList_0123456789876543210Sym0 a0123456789876543210 = FooList_0123456789876543210Sym1 a0123456789876543210 + class PFoo (a :: GHC.Types.Type) where + type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] + type FooList (arg :: a) (arg :: [Bool]) :: [Bool] + type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a + type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where + FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 + type FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [Bool]) = + FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoosPrec_0123456789876543210Sym2KindInference) ()) + data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [Bool] [Bool] + where + FoosPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoosPrec_0123456789876543210Sym1KindInference) ()) + data FoosPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: forall a0123456789876543210. + (~>) [a0123456789876543210] ((~>) [Bool] [Bool]) + where + FoosPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + FoosPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FoosPrec_0123456789876543210Sym0KindInference) ()) + data FoosPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) Nat ((~>) [a0123456789876543210] ((~>) [Bool] [Bool])) + where + FoosPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => + FoosPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210 + instance PFoo [a] where + type FoosPrec a a a = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a + class SFoo a where + sFoosPrec :: + forall (t :: Nat) (t :: a) (t :: [Bool]). + Sing t + -> Sing t + -> Sing t + -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) + sFooList :: + forall (t :: a) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) + default sFooList :: + forall (t :: a) (t :: [Bool]). + (Apply (Apply FooListSym0 t) t :: [Bool]) + ~ Apply (Apply FooList_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) + sFooList + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (sUndefined sA_0123456789876543210) sA_0123456789876543210 + instance SFoo a => SFoo [a] where + sFoosPrec :: + forall (t :: Nat) (t :: [a]) (t :: [Bool]). + Sing t + -> Sing t + -> Sing t + -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) + sFoosPrec + _ + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @FooListSym0) sFooList)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SFoo a => + SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where + sing = (singFun3 @FoosPrecSym0) sFoosPrec + instance (SFoo a, SingI d) => + SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where + sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d)) + instance (SFoo a, SingI d, SingI d) => + SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where + sing + = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a))) + ((sFoosPrec (sing @d)) (sing @d)) + instance SFoo a => + SingI (FooListSym0 :: (~>) a ((~>) [Bool] [Bool])) where + sing = (singFun2 @FooListSym0) sFooList + instance (SFoo a, SingI d) => + SingI (FooListSym1 (d :: a) :: (~>) [Bool] [Bool]) where + sing = (singFun1 @(FooListSym1 (d :: a))) (sFooList (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T167.hs b/tests/compile-and-dump/Singletons/T167.hs --- a/tests/compile-and-dump/Singletons/T167.hs +++ b/tests/compile-and-dump/Singletons/T167.hs @@ -7,7 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} module Singletons.T167 where diff --git a/tests/compile-and-dump/Singletons/T172.ghc84.template b/tests/compile-and-dump/Singletons/T172.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T172.ghc84.template +++ /dev/null @@ -1,31 +0,0 @@ -Singletons/T172.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| ($>) :: Nat -> Nat -> Nat - ($>) = (+) |] - ======> - type ($>@#@$$$) (t :: Nat) (t :: Nat) = ($>) t t - instance SuppressUnusedWarnings ($>@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$>@#@$$###)) GHC.Tuple.()) - data ($>@#@$$) (l :: Nat) (l :: TyFun Nat Nat) - = forall arg. SameKind (Apply (($>@#@$$) l) arg) (($>@#@$$$) l arg) => - (:$>@#@$$###) - type instance Apply (($>@#@$$) l) l = ($>) l l - instance SuppressUnusedWarnings ($>@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$>@#@$###)) GHC.Tuple.()) - data ($>@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) - = forall arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => - (:$>@#@$###) - type instance Apply ($>@#@$) l = ($>@#@$$) l - type family ($>) (a :: Nat) (a :: Nat) :: Nat where - ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 - (%$>) :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Nat) - (%$>) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @(+@#@$)) (%+))) sA_0123456789876543210)) - sA_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T172.ghc86.template b/tests/compile-and-dump/Singletons/T172.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T172.ghc86.template @@ -0,0 +1,40 @@ +Singletons/T172.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [d| ($>) :: Nat -> Nat -> Nat + ($>) = (+) |] + ======> + type ($>@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + ($>) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:$>@#@$$###)) ()) + data ($>@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat + where + (:$>@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) => + ($>@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ($>@#@$) where + suppressUnusedWarnings = snd (((,) (:$>@#@$###)) ()) + data ($>@#@$) :: (~>) Nat ((~>) Nat Nat) + where + (:$>@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => + ($>@#@$) a0123456789876543210 + type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210 + type family ($>) (a :: Nat) (a :: Nat) :: Nat where + ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 + (%$>) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Nat) + (%$>) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @(+@#@$)) (%+))) sA_0123456789876543210)) + sA_0123456789876543210 + instance SingI (($>@#@$) :: (~>) Nat ((~>) Nat Nat)) where + sing = (singFun2 @($>@#@$)) (%$>) + instance SingI d => + SingI (($>@#@$$) (d :: Nat) :: (~>) Nat Nat) where + sing = (singFun1 @(($>@#@$$) (d :: Nat))) ((%$>) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T175.ghc84.template b/tests/compile-and-dump/Singletons/T175.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T175.ghc84.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 - 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/T175.ghc86.template b/tests/compile-and-dump/Singletons/T175.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T175.ghc86.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 :: forall a. SBar2 a => Sing (Quux2Sym0 :: a) + sQuux2 = sBaz + class SFoo a where + sBaz :: Sing (BazSym0 :: a) + class SFoo a => SBar1 a where + sQuux1 :: Sing (Quux1Sym0 :: a) + default sQuux1 :: + (Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0 => + Sing (Quux1Sym0 :: a) + sQuux1 = sBaz + class SFoo a => SBar2 a diff --git a/tests/compile-and-dump/Singletons/T175.hs b/tests/compile-and-dump/Singletons/T175.hs --- a/tests/compile-and-dump/Singletons/T175.hs +++ b/tests/compile-and-dump/Singletons/T175.hs @@ -5,7 +5,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} diff --git a/tests/compile-and-dump/Singletons/T176.ghc84.template b/tests/compile-and-dump/Singletons/T176.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T176.ghc84.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 _ = 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.ghc86.template b/tests/compile-and-dump/Singletons/T176.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T176.ghc86.template @@ -0,0 +1,166 @@ +Singletons/T176.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| quux1 :: Foo1 a => a -> a + quux1 x = x `bar1` \ _ -> baz1 + quux2 :: Foo2 a => a -> a + quux2 x = x `bar2` baz2 + + class Foo1 a where + bar1 :: a -> (a -> b) -> b + baz1 :: a + class Foo2 a where + bar2 :: a -> b -> b + baz2 :: a |] + ======> + class Foo1 a where + bar1 :: a -> (a -> b) -> b + baz1 :: a + quux1 :: Foo1 a => a -> a + quux1 x = (x `bar1` (\ _ -> baz1)) + class Foo2 a where + bar2 :: a -> b -> b + baz2 :: a + quux2 :: Foo2 a => a -> a + quux2 x = (x `bar2` baz2) + type family Case_0123456789876543210 x arg_0123456789876543210 t where + Case_0123456789876543210 x arg_0123456789876543210 _ = Baz1Sym0 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + type Quux2Sym1 (a0123456789876543210 :: a0123456789876543210) = + Quux2 a0123456789876543210 + instance SuppressUnusedWarnings Quux2Sym0 where + suppressUnusedWarnings = snd (((,) Quux2Sym0KindInference) ()) + data Quux2Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Quux2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => + Quux2Sym0 a0123456789876543210 + type instance Apply Quux2Sym0 a0123456789876543210 = Quux2 a0123456789876543210 + type Quux1Sym1 (a0123456789876543210 :: a0123456789876543210) = + Quux1 a0123456789876543210 + instance SuppressUnusedWarnings Quux1Sym0 where + suppressUnusedWarnings = snd (((,) Quux1Sym0KindInference) ()) + data Quux1Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Quux1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => + Quux1Sym0 a0123456789876543210 + type instance Apply Quux1Sym0 a0123456789876543210 = Quux1 a0123456789876543210 + type family Quux2 (a :: a) :: a where + Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 + type family Quux1 (a :: a) :: a where + Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) + type Bar1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = + Bar1 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (Bar1Sym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) Bar1Sym1KindInference) ()) + data Bar1Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210 + where + Bar1Sym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (Bar1Sym1 arg0123456789876543210) arg) (Bar1Sym2 arg0123456789876543210 arg) => + Bar1Sym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (Bar1Sym1 arg0123456789876543210) arg0123456789876543210 = Bar1 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings Bar1Sym0 where + suppressUnusedWarnings = snd (((,) Bar1Sym0KindInference) ()) + data Bar1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210) + where + Bar1Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => + Bar1Sym0 arg0123456789876543210 + type instance Apply Bar1Sym0 arg0123456789876543210 = Bar1Sym1 arg0123456789876543210 + type Baz1Sym0 = Baz1 + class PFoo1 (a :: Type) where + type Bar1 (arg :: a) (arg :: (~>) a b) :: b + type Baz1 :: a + type Bar2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Bar2 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (Bar2Sym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) Bar2Sym1KindInference) ()) + data Bar2Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Bar2Sym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (Bar2Sym1 arg0123456789876543210) arg) (Bar2Sym2 arg0123456789876543210 arg) => + Bar2Sym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (Bar2Sym1 arg0123456789876543210) arg0123456789876543210 = Bar2 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings Bar2Sym0 where + suppressUnusedWarnings = snd (((,) Bar2Sym0KindInference) ()) + data Bar2Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Bar2Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => + Bar2Sym0 arg0123456789876543210 + type instance Apply Bar2Sym0 arg0123456789876543210 = Bar2Sym1 arg0123456789876543210 + type Baz2Sym0 = Baz2 + class PFoo2 (a :: Type) where + type Bar2 (arg :: a) (arg :: b) :: b + type Baz2 :: a + sQuux2 :: + forall a (t :: a). + SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a) + sQuux1 :: + forall a (t :: a). + SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a) + sQuux2 (sX :: Sing x) + = (applySing ((applySing ((singFun2 @Bar2Sym0) sBar2)) sX)) sBaz2 + sQuux1 (sX :: Sing x) + = (applySing ((applySing ((singFun2 @Bar1Sym0) sBar1)) sX)) + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { _ -> sBaz1 }) :: + Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) })) + instance SFoo2 a => SingI (Quux2Sym0 :: (~>) a a) where + sing = (singFun1 @Quux2Sym0) sQuux2 + instance SFoo1 a => SingI (Quux1Sym0 :: (~>) a a) where + sing = (singFun1 @Quux1Sym0) sQuux1 + class SFoo1 a where + sBar1 :: + forall b (t :: a) (t :: (~>) a b). + Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b) + sBaz1 :: Sing (Baz1Sym0 :: a) + class SFoo2 a where + sBar2 :: + forall b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b) + sBaz2 :: Sing (Baz2Sym0 :: a) + instance SFoo1 a => + SingI (Bar1Sym0 :: (~>) a ((~>) ((~>) a b) b)) where + sing = (singFun2 @Bar1Sym0) sBar1 + instance (SFoo1 a, SingI d) => + SingI (Bar1Sym1 (d :: a) :: (~>) ((~>) a b) b) where + sing = (singFun1 @(Bar1Sym1 (d :: a))) (sBar1 (sing @d)) + instance SFoo2 a => SingI (Bar2Sym0 :: (~>) a ((~>) b b)) where + sing = (singFun2 @Bar2Sym0) sBar2 + instance (SFoo2 a, SingI d) => + SingI (Bar2Sym1 (d :: a) :: (~>) b b) where + sing = (singFun1 @(Bar2Sym1 (d :: a))) (sBar2 (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T176.hs b/tests/compile-and-dump/Singletons/T176.hs --- a/tests/compile-and-dump/Singletons/T176.hs +++ b/tests/compile-and-dump/Singletons/T176.hs @@ -5,7 +5,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} module T176 where diff --git a/tests/compile-and-dump/Singletons/T178.ghc84.template b/tests/compile-and-dump/Singletons/T178.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T178.ghc84.template +++ /dev/null @@ -1,217 +0,0 @@ -Singletons/T178.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| empty :: U - empty = [] - - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] |] - ======> - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] - empty :: U - empty = [] - type StrSym0 = Str - type OptSym0 = Opt - type ManySym0 = Many - type EmptySym0 = Empty - type family Empty :: [(Symbol, Occ)] where - Empty = '[] - type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where - Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - Compare_0123456789876543210 Str Opt = LTSym0 - Compare_0123456789876543210 Str Many = LTSym0 - Compare_0123456789876543210 Opt Str = GTSym0 - Compare_0123456789876543210 Opt Many = LTSym0 - Compare_0123456789876543210 Many Str = GTSym0 - Compare_0123456789876543210 Many Opt = GTSym0 - type Compare_0123456789876543210Sym2 (t :: Occ) (t :: Occ) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Occ) (l :: TyFun Occ Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Occ (TyFun Occ Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Occ where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: Nat) (t :: Occ) (t :: Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: Nat) (l :: Occ) (l :: TyFun Symbol Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Occ (TyFun Symbol Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Occ (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow Occ where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where - Equals_0123456789876543210 Str Str = TrueSym0 - Equals_0123456789876543210 Opt Opt = TrueSym0 - Equals_0123456789876543210 Many Many = TrueSym0 - Equals_0123456789876543210 (_ :: Occ) (_ :: Occ) = FalseSym0 - instance PEq Occ where - type (==) a b = Equals_0123456789876543210 a b - sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)]) - sEmpty = Data.Singletons.Prelude.Instances.SNil - data instance Sing (z :: Occ) - where - SStr :: Sing Str - SOpt :: Sing Opt - SMany :: Sing Many - type SOcc = (Sing :: Occ -> GHC.Types.Type) - instance SingKind Occ where - type Demote Occ = Occ - fromSing SStr = Str - fromSing SOpt = Opt - fromSing SMany = Many - toSing Str = SomeSing SStr - toSing Opt = SomeSing SOpt - toSing Many = SomeSing SMany - instance SOrd Occ where - sCompare :: - forall (t1 :: Occ) (t2 :: Occ). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ (TyFun Occ Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare SStr SStr - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - Data.Singletons.Prelude.Instances.SNil - sCompare SOpt SOpt - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - Data.Singletons.Prelude.Instances.SNil - sCompare SMany SMany - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - Data.Singletons.Prelude.Instances.SNil - sCompare SStr SOpt = SLT - sCompare SStr SMany = SLT - sCompare SOpt SStr = SGT - sCompare SOpt SMany = SLT - sCompare SMany SStr = SGT - sCompare SMany SOpt = SGT - instance SShow Occ where - sShowsPrec :: - forall (t1 :: Nat) (t2 :: Occ) (t3 :: Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Nat (TyFun Occ (TyFun Symbol Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - SStr - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Str"))) - sA_0123456789876543210 - sShowsPrec - _ - SOpt - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Opt"))) - sA_0123456789876543210 - sShowsPrec - _ - SMany - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "Many"))) - sA_0123456789876543210 - instance SEq Occ where - (%==) SStr SStr = STrue - (%==) SStr SOpt = SFalse - (%==) SStr SMany = SFalse - (%==) SOpt SStr = SFalse - (%==) SOpt SOpt = STrue - (%==) SOpt SMany = SFalse - (%==) SMany SStr = SFalse - (%==) SMany SOpt = SFalse - (%==) SMany SMany = STrue - instance SDecide Occ where - (%~) SStr SStr = Proved Refl - (%~) SStr SOpt = Disproved (\ x -> case x of) - (%~) SStr SMany = Disproved (\ x -> case x of) - (%~) SOpt SStr = Disproved (\ x -> case x of) - (%~) SOpt SOpt = Proved Refl - (%~) SOpt SMany = Disproved (\ x -> case x of) - (%~) SMany SStr = Disproved (\ x -> case x of) - (%~) SMany SOpt = Disproved (\ x -> case x of) - (%~) SMany SMany = Proved Refl - instance Data.Singletons.ShowSing.ShowSing Occ where - Data.Singletons.ShowSing.showsSingPrec _ SStr = showString "SStr" - Data.Singletons.ShowSing.showsSingPrec _ SOpt = showString "SOpt" - Data.Singletons.ShowSing.showsSingPrec _ SMany = showString "SMany" - instance Show (Sing (z :: Occ)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI Str where - sing = SStr - instance SingI Opt where - sing = SOpt - instance SingI Many where - sing = SMany diff --git a/tests/compile-and-dump/Singletons/T178.ghc86.template b/tests/compile-and-dump/Singletons/T178.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T178.ghc86.template @@ -0,0 +1,210 @@ +Singletons/T178.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| empty :: U + empty = [] + + data Occ + = Str | Opt | Many + deriving (Eq, Ord, Show) + type U = [(Symbol, Occ)] |] + ======> + data Occ + = Str | Opt | Many + deriving (Eq, Ord, Show) + type U = [(Symbol, Occ)] + empty :: U + empty = [] + type USym0 = U + type StrSym0 = Str + type OptSym0 = Opt + type ManySym0 = Many + type EmptySym0 = Empty + type family Empty :: [(Symbol, Occ)] where + Empty = '[] + type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where + Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789876543210 Str Opt = LTSym0 + Compare_0123456789876543210 Str Many = LTSym0 + Compare_0123456789876543210 Opt Str = GTSym0 + Compare_0123456789876543210 Opt Many = LTSym0 + Compare_0123456789876543210 Many Str = GTSym0 + Compare_0123456789876543210 Many Opt = GTSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Occ) :: (~>) Occ Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Occ where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210 + ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Occ ((~>) Symbol Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) Nat ((~>) Occ ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow Occ where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where + Equals_0123456789876543210 Str Str = TrueSym0 + Equals_0123456789876543210 Opt Opt = TrueSym0 + Equals_0123456789876543210 Many Many = TrueSym0 + Equals_0123456789876543210 (_ :: Occ) (_ :: Occ) = FalseSym0 + instance PEq Occ where + type (==) a b = Equals_0123456789876543210 a b + sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)]) + sEmpty = Data.Singletons.Prelude.Instances.SNil + data instance Sing :: Occ -> GHC.Types.Type + where + SStr :: Sing Str + SOpt :: Sing Opt + SMany :: Sing Many + type SOcc = (Sing :: Occ -> GHC.Types.Type) + instance SingKind Occ where + type Demote Occ = Occ + fromSing SStr = Str + fromSing SOpt = Opt + fromSing SMany = Many + toSing Str = SomeSing SStr + toSing Opt = SomeSing SOpt + toSing Many = SomeSing SMany + instance SOrd Occ where + sCompare :: + forall (t1 :: Occ) (t2 :: Occ). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ ((~>) Occ Ordering) + -> GHC.Types.Type) t1) t2) + sCompare SStr SStr + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SOpt SOpt + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SMany SMany + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + sCompare SStr SOpt = SLT + sCompare SStr SMany = SLT + sCompare SOpt SStr = SGT + sCompare SOpt SMany = SLT + sCompare SMany SStr = SGT + sCompare SMany SOpt = SGT + instance SShow Occ where + sShowsPrec :: + forall (t1 :: Nat) (t2 :: Occ) (t3 :: Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Nat ((~>) Occ ((~>) Symbol Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + SStr + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Str"))) + sA_0123456789876543210 + sShowsPrec + _ + SOpt + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Opt"))) + sA_0123456789876543210 + sShowsPrec + _ + SMany + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "Many"))) + sA_0123456789876543210 + instance SEq Occ where + (%==) SStr SStr = STrue + (%==) SStr SOpt = SFalse + (%==) SStr SMany = SFalse + (%==) SOpt SStr = SFalse + (%==) SOpt SOpt = STrue + (%==) SOpt SMany = SFalse + (%==) SMany SStr = SFalse + (%==) SMany SOpt = SFalse + (%==) SMany SMany = STrue + instance SDecide Occ where + (%~) SStr SStr = Proved Refl + (%~) SStr SOpt = Disproved (\ x -> case x of) + (%~) SStr SMany = Disproved (\ x -> case x of) + (%~) SOpt SStr = Disproved (\ x -> case x of) + (%~) SOpt SOpt = Proved Refl + (%~) SOpt SMany = Disproved (\ x -> case x of) + (%~) SMany SStr = Disproved (\ x -> case x of) + (%~) SMany SOpt = Disproved (\ x -> case x of) + (%~) SMany SMany = Proved Refl + deriving instance Show (Sing (z :: Occ)) + instance SingI Str where + sing = SStr + instance SingI Opt where + sing = SOpt + instance SingI Many where + sing = SMany diff --git a/tests/compile-and-dump/Singletons/T183.ghc86.template b/tests/compile-and-dump/Singletons/T183.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T183.ghc86.template @@ -0,0 +1,512 @@ +Singletons/T183.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| f1 (x :: Maybe Bool) = (x :: Maybe Bool) + f2 (x :: Maybe a) = (x :: Maybe a) + f3 (Just a :: Maybe Bool) = "hi" + g x = case Just x of { (Just y :: Maybe Bool) -> (y :: Bool) } + foo1 :: Maybe a -> a + foo1 (Just x :: Maybe a) = (x :: a) + foo2, foo3 :: forall a. Maybe a -> a + foo2 (Just x :: Maybe a) = (x :: a) + foo3 (Just x) = (x :: a) + foo4 :: (a, b) -> (b, a) + foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a) + foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) + foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) + = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) + foo6 (Just x :: Maybe (Maybe a)) + = case x :: Maybe a of { + (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) } + foo7 :: a -> b -> a + foo7 (x :: a) (_ :: b) = (x :: a) + foo8 :: forall a. Maybe a -> Maybe a + foo8 x@(Just (_ :: a) :: Maybe a) = x + foo9 :: a -> a + foo9 (x :: a) + = let + g :: a -> b -> a + g y _ = y + in g x () |] + ======> + f1 (x :: Maybe Bool) = x :: Maybe Bool + f2 (x :: Maybe a) = x :: Maybe a + f3 (Just a :: Maybe Bool) = "hi" + g x = case Just x of { (Just y :: Maybe Bool) -> y :: Bool } + foo1 :: Maybe a -> a + foo1 (Just x :: Maybe a) = x :: a + foo2 :: forall a. Maybe a -> a + foo3 :: forall a. Maybe a -> a + foo2 (Just x :: Maybe a) = x :: a + foo3 (Just x) = x :: a + foo4 :: (a, b) -> (b, a) + foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a) + foo5 :: Maybe (Maybe a) -> Maybe (Maybe a) + foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) + foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) + = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) + foo6 (Just x :: Maybe (Maybe a)) + = case x :: Maybe a of { + (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) } + foo7 :: a -> b -> a + foo7 (x :: a) (_ :: b) = x :: a + foo8 :: forall a. Maybe a -> Maybe a + foo8 x@(Just (_ :: a) :: Maybe a) = x + foo9 :: a -> a + foo9 (x :: a) + = let + g :: a -> b -> a + g y _ = y + in (g x) () + type Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) = + Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210GSym2KindInference) ()) + data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: forall b0123456789876543210. + (~>) b0123456789876543210 a + where + Let0123456789876543210GSym2KindInference :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) => + Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) a0123456789876543210 = Let0123456789876543210G a0123456789876543210 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210GSym1KindInference) ()) + data Let0123456789876543210GSym1 x0123456789876543210 :: forall b0123456789876543210 + a. + (~>) a ((~>) b0123456789876543210 a) + where + Let0123456789876543210GSym1KindInference :: forall x0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 arg) => + Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210GSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210GSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210GSym0KindInference) ()) + data Let0123456789876543210GSym0 x0123456789876543210 + where + Let0123456789876543210GSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) => + Let0123456789876543210GSym0 x0123456789876543210 + type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 + type family Let0123456789876543210G x (a :: a) (a :: b) :: a where + Let0123456789876543210G x y _ = y + type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210X wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210XSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210XSym0KindInference) ()) + data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => + Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 + type family Let0123456789876543210X wild_0123456789876543210 where + Let0123456789876543210X wild_0123456789876543210 = (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a) + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 x where + Let0123456789876543210Scrutinee_0123456789876543210 x = (x :: Maybe a) + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x ( 'Just (y :: a) :: Maybe a) = Apply JustSym0 (Apply JustSym0 (y :: a) :: Maybe a) + type family Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 '((x :: a), + (y :: b)) = Apply (Apply Tuple2Sym0 (y :: b)) (x :: a) + type family Lambda_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 x where + Let0123456789876543210Scrutinee_0123456789876543210 x = Apply JustSym0 x + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x ( 'Just y :: Maybe Bool) = (y :: Bool) + type Foo9Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo9 a0123456789876543210 + instance SuppressUnusedWarnings Foo9Sym0 where + suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) + data Foo9Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + Foo9Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => + Foo9Sym0 a0123456789876543210 + type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo8 a0123456789876543210 + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) + data Foo8Sym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) (Maybe a0123456789876543210) + where + Foo8Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => + Foo8Sym0 a0123456789876543210 + type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 + type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo7 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) + data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Foo7Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => + Foo7Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) + data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo7Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0 a0123456789876543210 + type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 + type Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + Foo6 a0123456789876543210 + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) + data Foo6Sym0 :: forall a0123456789876543210. + (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210)) + where + Foo6Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => + Foo6Sym0 a0123456789876543210 + type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 + type Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + Foo5 a0123456789876543210 + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) + data Foo5Sym0 :: forall a0123456789876543210. + (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210)) + where + Foo5Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => + Foo5Sym0 a0123456789876543210 + type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: (a0123456789876543210, + b0123456789876543210)) = + Foo4 a0123456789876543210 + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) + data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) (a0123456789876543210, + b0123456789876543210) (b0123456789876543210, a0123456789876543210) + where + Foo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => + Foo4Sym0 a0123456789876543210 + type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo3 a0123456789876543210 + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) + data Foo3Sym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => + Foo3Sym0 a0123456789876543210 + type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 + type Foo2Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) + data Foo2Sym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => + Foo2Sym0 a0123456789876543210 + type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 + type Foo1Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 + type GSym1 a0123456789876543210 = G a0123456789876543210 + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) + data GSym0 a0123456789876543210 + where + GSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0 a0123456789876543210 + type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 + type F3Sym1 a0123456789876543210 = F3 a0123456789876543210 + instance SuppressUnusedWarnings F3Sym0 where + suppressUnusedWarnings = snd (((,) F3Sym0KindInference) ()) + data F3Sym0 a0123456789876543210 + where + F3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply F3Sym0 arg) (F3Sym1 arg) => + F3Sym0 a0123456789876543210 + type instance Apply F3Sym0 a0123456789876543210 = F3 a0123456789876543210 + type F2Sym1 a0123456789876543210 = F2 a0123456789876543210 + instance SuppressUnusedWarnings F2Sym0 where + suppressUnusedWarnings = snd (((,) F2Sym0KindInference) ()) + data F2Sym0 a0123456789876543210 + where + F2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply F2Sym0 arg) (F2Sym1 arg) => + F2Sym0 a0123456789876543210 + type instance Apply F2Sym0 a0123456789876543210 = F2 a0123456789876543210 + type F1Sym1 a0123456789876543210 = F1 a0123456789876543210 + instance SuppressUnusedWarnings F1Sym0 where + suppressUnusedWarnings = snd (((,) F1Sym0KindInference) ()) + data F1Sym0 a0123456789876543210 + where + F1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply F1Sym0 arg) (F1Sym1 arg) => + F1Sym0 a0123456789876543210 + type instance Apply F1Sym0 a0123456789876543210 = F1 a0123456789876543210 + type family Foo9 (a :: a) :: a where + Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym1 x) x) Tuple0Sym0 + type family Foo8 (a :: Maybe a) :: Maybe a where + Foo8 ( 'Just (wild_0123456789876543210 :: a) :: Maybe a) = Let0123456789876543210XSym1 wild_0123456789876543210 + type family Foo7 (a :: a) (a :: b) :: a where + Foo7 (x :: a) (wild_0123456789876543210 :: b) = (x :: a) + type family Foo6 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where + Foo6 ( 'Just x :: Maybe (Maybe a)) = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + type family Foo5 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where + Foo5 ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a)) + type family Foo4 (a :: (a, b)) :: (b, a) where + Foo4 a_0123456789876543210 = Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210 + type family Foo3 (a :: Maybe a) :: a where + Foo3 ( 'Just x) = (x :: a) + type family Foo2 (a :: Maybe a) :: a where + Foo2 ( 'Just x :: Maybe a) = (x :: a) + type family Foo1 (a :: Maybe a) :: a where + Foo1 ( 'Just x :: Maybe a) = (x :: a) + type family G a where + G x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + type family F3 a where + F3 ( 'Just a :: Maybe Bool) = "hi" + type family F2 a where + F2 (x :: Maybe a) = (x :: Maybe a) + type family F1 a where + F1 (x :: Maybe Bool) = (x :: Maybe Bool) + sFoo9 :: forall a (t :: a). Sing t -> Sing (Apply Foo9Sym0 t :: a) + sFoo8 :: + forall a (t :: Maybe a). + Sing t -> Sing (Apply Foo8Sym0 t :: Maybe a) + sFoo7 :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: a) + sFoo6 :: + forall a (t :: Maybe (Maybe a)). + Sing t -> Sing (Apply Foo6Sym0 t :: Maybe (Maybe a)) + sFoo5 :: + forall a (t :: Maybe (Maybe a)). + Sing t -> Sing (Apply Foo5Sym0 t :: Maybe (Maybe a)) + sFoo4 :: + forall a b (t :: (a, b)). + Sing t -> Sing (Apply Foo4Sym0 t :: (b, a)) + sFoo3 :: + forall a (t :: Maybe a). Sing t -> Sing (Apply Foo3Sym0 t :: a) + sFoo2 :: + forall a (t :: Maybe a). Sing t -> Sing (Apply Foo2Sym0 t :: a) + sFoo1 :: + forall a (t :: Maybe a). Sing t -> Sing (Apply Foo1Sym0 t :: a) + sG :: forall arg. Sing arg -> Sing (Apply GSym0 arg) + sF3 :: forall arg. Sing arg -> Sing (Apply F3Sym0 arg) + sF2 :: forall arg. Sing arg -> Sing (Apply F2Sym0 arg) + sF1 :: forall arg. Sing arg -> Sing (Apply F1Sym0 arg) + sFoo9 (sX :: Sing x) + = case sX :: Sing x of { + (_ :: Sing (x :: a)) + -> let + sG :: + forall b (t :: a) (t :: b). + Sing t + -> Sing t + -> Sing (Apply (Apply (Let0123456789876543210GSym1 x) t) t :: a) + sG (sY :: Sing y) _ = sY + in + (applySing + ((applySing ((singFun2 @(Let0123456789876543210GSym1 x)) sG)) sX)) + STuple0 } + sFoo8 + (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + = case + ((,) (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + (SJust + (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) + of { + (,) (_ :: Sing (wild_0123456789876543210 :: a)) + (_ :: Sing ( 'Just (wild_0123456789876543210 :: a) :: Maybe a)) + -> let + sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) + sX + = (applySing ((singFun1 @JustSym0) SJust)) + (sWild_0123456789876543210 :: + Sing (wild_0123456789876543210 :: a)) :: + Sing (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a) + in sX } + sFoo7 + (sX :: Sing x) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + = case + ((,) (sX :: Sing x)) + (sWild_0123456789876543210 :: Sing wild_0123456789876543210) + of { + (,) (_ :: Sing (x :: a)) + (_ :: Sing (wild_0123456789876543210 :: b)) + -> sX :: Sing (x :: a) } + sFoo6 (SJust (sX :: Sing x)) + = case SJust (sX :: Sing x) of { + (_ :: Sing ( 'Just x :: Maybe (Maybe a))) + -> let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + sScrutinee_0123456789876543210 = sX :: Sing (x :: Maybe a) + in (case sScrutinee_0123456789876543210 of { + SJust (sY :: Sing y) + -> case ((,) (sY :: Sing y)) (SJust (sY :: Sing y)) of { + (,) (_ :: Sing (y :: a)) (_ :: Sing ( 'Just (y :: a) :: Maybe a)) + -> (applySing ((singFun1 @JustSym0) SJust)) + ((applySing ((singFun1 @JustSym0) SJust)) + (sY :: Sing (y :: a)) :: + Sing (Apply JustSym0 (y :: a) :: Maybe a)) } }) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: Maybe (Maybe a)) } + sFoo5 (SJust (SJust (sX :: Sing x))) + = case + (((,,) (sX :: Sing x)) (SJust (sX :: Sing x))) + (SJust (SJust (sX :: Sing x))) + of { + (,,) (_ :: Sing (x :: a)) + (_ :: Sing ( 'Just (x :: a) :: Maybe a)) + (_ :: Sing ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a))) + -> (applySing ((singFun1 @JustSym0) SJust)) + ((applySing ((singFun1 @JustSym0) SJust)) (sX :: Sing (x :: a)) :: + Sing (Apply JustSym0 (x :: a) :: Maybe a)) :: + Sing (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a)) } + sFoo4 (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((singFun1 + @(Apply Lambda_0123456789876543210Sym0 a_0123456789876543210)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { + STuple2 (sX :: Sing x) (sY :: Sing y) + -> case ((,) (sX :: Sing x)) (sY :: Sing y) of { + (,) (_ :: Sing (x :: a)) (_ :: Sing (y :: b)) + -> (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + (sY :: Sing (y :: b)))) + (sX :: Sing (x :: a)) } }) :: + Sing (Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) + sA_0123456789876543210 + sFoo3 (SJust (sX :: Sing x)) = sX :: Sing (x :: a) + sFoo2 (SJust (sX :: Sing x)) + = case SJust (sX :: Sing x) of { + (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) } + sFoo1 (SJust (sX :: Sing x)) + = case SJust (sX :: Sing x) of { + (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) } + sG (sX :: Sing x) + = let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) + sScrutinee_0123456789876543210 + = (applySing ((singFun1 @JustSym0) SJust)) sX + in (case sScrutinee_0123456789876543210 of { + SJust (sY :: Sing y) + -> case SJust (sY :: Sing y) of { + (_ :: Sing ( 'Just y :: Maybe Bool)) + -> sY :: Sing (y :: Bool) } }) :: + Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)) + sF3 (SJust (sA :: Sing a)) + = case SJust (sA :: Sing a) of { + (_ :: Sing ( 'Just a :: Maybe Bool)) -> sing :: Sing "hi" } + sF2 (sX :: Sing x) + = case sX :: Sing x of { + (_ :: Sing (x :: Maybe a)) -> sX :: Sing (x :: Maybe a) } + sF1 (sX :: Sing x) + = case sX :: Sing x of { + (_ :: Sing (x :: Maybe Bool)) -> sX :: Sing (x :: Maybe Bool) } + instance SingI (Foo9Sym0 :: (~>) a a) where + sing = (singFun1 @Foo9Sym0) sFoo9 + instance SingI (Foo8Sym0 :: (~>) (Maybe a) (Maybe a)) where + sing = (singFun1 @Foo8Sym0) sFoo8 + instance SingI (Foo7Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Foo7Sym0) sFoo7 + instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d)) + instance SingI (Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where + sing = (singFun1 @Foo6Sym0) sFoo6 + instance SingI (Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where + sing = (singFun1 @Foo5Sym0) sFoo5 + instance SingI (Foo4Sym0 :: (~>) (a, b) (b, a)) where + sing = (singFun1 @Foo4Sym0) sFoo4 + instance SingI (Foo3Sym0 :: (~>) (Maybe a) a) where + sing = (singFun1 @Foo3Sym0) sFoo3 + instance SingI (Foo2Sym0 :: (~>) (Maybe a) a) where + sing = (singFun1 @Foo2Sym0) sFoo2 + instance SingI (Foo1Sym0 :: (~>) (Maybe a) a) where + sing = (singFun1 @Foo1Sym0) sFoo1 + instance SingI GSym0 where + sing = (singFun1 @GSym0) sG + instance SingI F3Sym0 where + sing = (singFun1 @F3Sym0) sF3 + instance SingI F2Sym0 where + sing = (singFun1 @F2Sym0) sF2 + instance SingI F1Sym0 where + sing = (singFun1 @F1Sym0) sF1 diff --git a/tests/compile-and-dump/Singletons/T183.hs b/tests/compile-and-dump/Singletons/T183.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T183.hs @@ -0,0 +1,65 @@ +module T183 where + +import Data.Singletons.Prelude +import Data.Singletons.TH + +$(singletons [d| + ----- + -- Examples from #183 + ----- + + f1 (x :: Maybe Bool) = (x :: Maybe Bool) + f2 (x :: Maybe a) = (x :: Maybe a) + f3 (Just a :: Maybe Bool) = "hi" + + g x = case Just x of + (Just y :: Maybe Bool) -> (y :: Bool) + + ----- + -- Using explicit type signatures + ----- + + -- No explicit forall + foo1 :: Maybe a -> a + foo1 (Just x :: Maybe a) = (x :: a) + + -- Explicit forall + foo2, foo3 :: forall a. Maybe a -> a + foo2 (Just x :: Maybe a) = (x :: a) + foo3 (Just x) = (x :: a) + + ----- + -- Multiple pattern signatures + ----- + + foo4 :: (a, b) -> (b, a) + foo4 = \(x :: a, y :: b) -> (y :: b, x :: a) + + foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) + foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) + = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) + foo6 (Just x :: Maybe (Maybe a)) + = case x :: Maybe a of + (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) + + ----- + -- Other pattern features + ----- + + foo7 :: a -> b -> a + foo7 (x :: a) (_ :: b) = (x :: a) + + foo8 :: forall a. Maybe a -> Maybe a + foo8 x@(Just (_ :: a) :: Maybe a) = x + -- foo8 x@(Nothing :: Maybe a) = x -- #296 + + ----- + -- Type variable scoping (vis-à-vis #297) + ----- + + foo9 :: a -> a + foo9 (x :: a) + = let g :: a -> b -> a + g y _ = y + in g x () + |]) diff --git a/tests/compile-and-dump/Singletons/T184.ghc86.template b/tests/compile-and-dump/Singletons/T184.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T184.ghc86.template @@ -0,0 +1,499 @@ +Singletons/T184.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| boogie :: Maybe a -> Maybe Bool -> Maybe a + boogie ma mb + = do a <- ma + b <- mb + guard b + return a + zip' :: [a] -> [b] -> [(a, b)] + zip' xs ys = [(x, y) | x <- xs | y <- ys] + cartProd :: [a] -> [b] -> [(a, b)] + cartProd xs ys = [(x, y) | x <- xs, y <- ys] + trues :: [Bool] -> [Bool] + trues xs = [x | x <- xs, x] |] + ======> + boogie :: Maybe a -> Maybe Bool -> Maybe a + boogie ma mb + = do a <- ma + b <- mb + guard b + return a + zip' :: [a] -> [b] -> [(a, b)] + zip' xs ys = [(x, y) | x <- xs | y <- ys] + cartProd :: [a] -> [b] -> [(a, b)] + cartProd xs ys = [(x, y) | x <- xs, y <- ys] + trues :: [Bool] -> [Bool] + trues xs = [x | x <- xs, x] + type family Lambda_0123456789876543210 xs t where + Lambda_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x) + type Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Lambda_0123456789876543210 xs ys x t where + Lambda_0123456789876543210 xs ys x y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) + type Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x) + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Case_0123456789876543210 xs ys arg_0123456789876543210 t where + Case_0123456789876543210 xs ys arg_0123456789876543210 '(x, + y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210 + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 + type family Lambda_0123456789876543210 ma mb a t where + Lambda_0123456789876543210 ma mb a b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) + type Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + a0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 ma0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 ma0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 + type family Lambda_0123456789876543210 ma mb t where + Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a) + type Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 ma0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 ma0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 + type TruesSym1 (a0123456789876543210 :: [Bool]) = + Trues a0123456789876543210 + instance SuppressUnusedWarnings TruesSym0 where + suppressUnusedWarnings = snd (((,) TruesSym0KindInference) ()) + data TruesSym0 :: (~>) [Bool] [Bool] + where + TruesSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TruesSym0 arg) (TruesSym1 arg) => + TruesSym0 a0123456789876543210 + type instance Apply TruesSym0 a0123456789876543210 = Trues a0123456789876543210 + type CartProdSym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + CartProd a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) CartProdSym1KindInference) ()) + data CartProdSym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. + (~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)] + where + CartProdSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) => + CartProdSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings CartProdSym0 where + suppressUnusedWarnings = snd (((,) CartProdSym0KindInference) ()) + data CartProdSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)]) + where + CartProdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) => + CartProdSym0 a0123456789876543210 + type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210 + type Zip'Sym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + Zip' a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Zip'Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Zip'Sym1KindInference) ()) + data Zip'Sym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. + (~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)] + where + Zip'Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Zip'Sym1 a0123456789876543210) arg) (Zip'Sym2 a0123456789876543210 arg) => + Zip'Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Zip'Sym1 a0123456789876543210) a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Zip'Sym0 where + suppressUnusedWarnings = snd (((,) Zip'Sym0KindInference) ()) + data Zip'Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)]) + where + Zip'Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) => + Zip'Sym0 a0123456789876543210 + type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210 + type BoogieSym2 (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: Maybe Bool) = + Boogie a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) BoogieSym1KindInference) ()) + data BoogieSym1 (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe Bool) (Maybe a0123456789876543210) + where + BoogieSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) => + BoogieSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (BoogieSym1 a0123456789876543210) a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings BoogieSym0 where + suppressUnusedWarnings = snd (((,) BoogieSym0KindInference) ()) + data BoogieSym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) ((~>) (Maybe Bool) (Maybe a0123456789876543210)) + where + BoogieSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) => + BoogieSym0 a0123456789876543210 + type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210 + type family Trues (a :: [Bool]) :: [Bool] where + Trues xs = Apply (Apply (>>=@#@$) xs) (Apply Lambda_0123456789876543210Sym0 xs) + type family CartProd (a :: [a]) (a :: [b]) :: [(a, b)] where + CartProd xs ys = Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) + type family Zip' (a :: [a]) (a :: [b]) :: [(a, b)] where + Zip' xs ys = Apply (Apply (>>=@#@$) (Apply (Apply MzipSym0 (Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))) (Apply (Apply (>>=@#@$) ys) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)))) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) + type family Boogie (a :: Maybe a) (a :: Maybe Bool) :: Maybe a where + Boogie ma mb = Apply (Apply (>>=@#@$) ma) (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) + sTrues :: + forall (t :: [Bool]). Sing t -> Sing (Apply TruesSym0 t :: [Bool]) + sCartProd :: + forall a b (t :: [a]) (t :: [b]). + Sing t + -> Sing t -> Sing (Apply (Apply CartProdSym0 t) t :: [(a, b)]) + sZip' :: + forall a b (t :: [a]) (t :: [b]). + Sing t -> Sing t -> Sing (Apply (Apply Zip'Sym0 t) t :: [(a, b)]) + sBoogie :: + forall a (t :: Maybe a) (t :: Maybe Bool). + Sing t -> Sing t -> Sing (Apply (Apply BoogieSym0 t) t :: Maybe a) + sTrues (sXs :: Sing xs) + = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) + ((singFun1 @(Apply Lambda_0123456789876543210Sym0 xs)) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (applySing + ((applySing ((singFun2 @(>>@#@$)) (%>>))) + ((applySing ((singFun1 @GuardSym0) sGuard)) sX))) + ((applySing ((singFun1 @ReturnSym0) sReturn)) sX) })) + sCartProd (sXs :: Sing xs) (sYs :: Sing ys) + = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs)) + ((singFun1 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x)) + (\ sY + -> case sY of { + (_ :: Sing y) + -> (applySing ((singFun1 @ReturnSym0) sReturn)) + ((applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) + sY) })) })) + sZip' (sXs :: Sing xs) (sYs :: Sing ys) + = (applySing + ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) + ((applySing + ((applySing ((singFun2 @MzipSym0) sMzip)) + ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (applySing ((singFun1 @ReturnSym0) sReturn)) sX }))))) + ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs)) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) + (\ sY + -> case sY of { + (_ :: Sing y) + -> (applySing ((singFun1 @ReturnSym0) sReturn)) sY })))))) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) + (\ sArg_0123456789876543210 + -> case sArg_0123456789876543210 of { + (_ :: Sing arg_0123456789876543210) + -> (case sArg_0123456789876543210 of { + STuple2 (sX :: Sing x) (sY :: Sing y) + -> (applySing ((singFun1 @ReturnSym0) sReturn)) + ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) + sY) }) :: + Sing (Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210) })) + sBoogie (sMa :: Sing ma) (sMb :: Sing mb) + = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMa)) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 ma) mb)) + (\ sA + -> case sA of { + (_ :: Sing a) + -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMb)) + ((singFun1 + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a)) + (\ sB + -> case sB of { + (_ :: Sing b) + -> (applySing + ((applySing ((singFun2 @(>>@#@$)) (%>>))) + ((applySing ((singFun1 @GuardSym0) sGuard)) sB))) + ((applySing ((singFun1 @ReturnSym0) sReturn)) + sA) })) })) + instance SingI (TruesSym0 :: (~>) [Bool] [Bool]) where + sing = (singFun1 @TruesSym0) sTrues + instance SingI (CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)])) where + sing = (singFun2 @CartProdSym0) sCartProd + instance SingI d => + SingI (CartProdSym1 (d :: [a]) :: (~>) [b] [(a, b)]) where + sing = (singFun1 @(CartProdSym1 (d :: [a]))) (sCartProd (sing @d)) + instance SingI (Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)])) where + sing = (singFun2 @Zip'Sym0) sZip' + instance SingI d => + SingI (Zip'Sym1 (d :: [a]) :: (~>) [b] [(a, b)]) where + sing = (singFun1 @(Zip'Sym1 (d :: [a]))) (sZip' (sing @d)) + instance SingI (BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a))) where + sing = (singFun2 @BoogieSym0) sBoogie + instance SingI d => + SingI (BoogieSym1 (d :: Maybe a) :: (~>) (Maybe Bool) (Maybe a)) where + sing = (singFun1 @(BoogieSym1 (d :: Maybe a))) (sBoogie (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T184.hs b/tests/compile-and-dump/Singletons/T184.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T184.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE ParallelListComp #-} +module T184 where + +import Control.Monad +import Data.Singletons.Prelude +import Data.Singletons.Prelude.Monad +import Data.Singletons.Prelude.Monad.Zip +import Data.Singletons.TH + +$(singletons [d| + boogie :: Maybe a -> Maybe Bool -> Maybe a + boogie ma mb = do + a <- ma + b <- mb + guard b + return a + + zip' :: [a] -> [b] -> [(a, b)] + zip' xs ys = [(x, y) | x <- xs | y <- ys] + + cartProd :: [a] -> [b] -> [(a, b)] + cartProd xs ys = [(x, y) | x <- xs, y <- ys] + + trues :: [Bool] -> [Bool] + trues xs = [x | x <- xs, x] + |]) diff --git a/tests/compile-and-dump/Singletons/T187.ghc84.template b/tests/compile-and-dump/Singletons/T187.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T187.ghc84.template +++ /dev/null @@ -1,58 +0,0 @@ -Singletons/T187.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Empty - - deriving instance Ord Empty - deriving instance Eq Empty |] - ======> - data Empty - deriving instance Eq Empty - deriving instance Ord Empty - type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where - Compare_0123456789876543210 _ _ = EQSym0 - type Compare_0123456789876543210Sym2 (t :: Empty) (t :: Empty) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Empty) (l :: TyFun Empty Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun Empty (TyFun Empty Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd Empty where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where - Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 - instance PEq Empty where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: Empty) - type SEmpty = (Sing :: Empty -> GHC.Types.Type) - instance SingKind Empty where - type Demote Empty = Empty - fromSing x = case x of - toSing x = SomeSing (case x of) - instance SOrd Empty where - sCompare :: - forall (t1 :: Empty) (t2 :: Empty). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty (TyFun Empty Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare _ _ = SEQ - instance SEq Empty where - (%==) _ _ = STrue - instance SDecide Empty where - (%~) x _ = Proved (case x of) diff --git a/tests/compile-and-dump/Singletons/T187.ghc86.template b/tests/compile-and-dump/Singletons/T187.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T187.ghc86.template @@ -0,0 +1,57 @@ +Singletons/T187.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Empty + + deriving instance Ord Empty + deriving instance Eq Empty |] + ======> + data Empty + deriving instance Eq Empty + deriving instance Ord Empty + type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where + Compare_0123456789876543210 _ _ = EQSym0 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd Empty where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where + Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 + instance PEq Empty where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: Empty -> GHC.Types.Type + type SEmpty = (Sing :: Empty -> GHC.Types.Type) + instance SingKind Empty where + type Demote Empty = Empty + fromSing x = case x of + toSing x = SomeSing (case x of) + instance SOrd Empty where + sCompare :: + forall (t1 :: Empty) (t2 :: Empty). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty ((~>) Empty Ordering) + -> GHC.Types.Type) t1) t2) + sCompare _ _ = SEQ + instance SEq Empty where + (%==) _ _ = STrue + instance SDecide Empty where + (%~) x _ = Proved (case x of) diff --git a/tests/compile-and-dump/Singletons/T190.ghc84.template b/tests/compile-and-dump/Singletons/T190.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T190.ghc84.template +++ /dev/null @@ -1,194 +0,0 @@ -Singletons/T190.hs:0:0:: Splicing declarations - singletons - [d| data T - = T - deriving (Eq, Ord, Enum, Bounded, Show) |] - ======> - data T - = T - deriving (Eq, Ord, Enum, Bounded, Show) - type TSym0 = T - type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where - Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - type Compare_0123456789876543210Sym2 (t :: T) (t :: T) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: T) (l :: TyFun T Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun T (TyFun T Ordering - -> GHC.Types.Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd T where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n True = TSym0 - Case_0123456789876543210 n False = Apply ErrorSym0 "toEnum: bad argument" - type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (t :: GHC.Types.Nat) = - ToEnum_0123456789876543210 t - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat T) - = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0KindInference - type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l - type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where - FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0 - type FromEnum_0123456789876543210Sym1 (t :: T) = - FromEnum_0123456789876543210 t - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data FromEnum_0123456789876543210Sym0 (l :: TyFun T GHC.Types.Nat) - = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0KindInference - type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l - instance PEnum T where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - type family MinBound_0123456789876543210 :: T where - MinBound_0123456789876543210 = TSym0 - type MinBound_0123456789876543210Sym0 = - MinBound_0123456789876543210 - type family MaxBound_0123456789876543210 :: T where - MaxBound_0123456789876543210 = TSym0 - type MaxBound_0123456789876543210Sym0 = - MaxBound_0123456789876543210 - instance PBounded T where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (t :: GHC.Types.Nat) (t :: T) (t :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 t t t - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) => - ShowsPrec_0123456789876543210Sym2KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) => - ShowsPrec_0123456789876543210Sym1KindInference - type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0KindInference - type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l - instance PShow T where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where - Equals_0123456789876543210 T T = TrueSym0 - Equals_0123456789876543210 (_ :: T) (_ :: T) = FalseSym0 - instance PEq T where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: T) where ST :: Sing T - type ST = (Sing :: T -> GHC.Types.Type) - instance SingKind T where - type Demote T = T - fromSing ST = T - toSing T = SomeSing ST - instance SOrd T where - sCompare :: - forall (t1 :: T) (t2 :: T). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun T (TyFun T Ordering - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) - sCompare ST ST - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - Data.Singletons.Prelude.Instances.SNil - instance SEnum T where - sToEnum :: - forall (t :: GHC.Types.Nat). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat T - -> GHC.Types.Type) t) - sFromEnum :: - forall (t :: T). - Sing t - -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun T GHC.Types.Nat - -> GHC.Types.Type) t) - sToEnum (sN :: Sing n) - = case - (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) - (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) - of - STrue -> ST - SFalse -> sError (sing :: Sing "toEnum: bad argument") :: - Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) - sFromEnum ST - = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) - instance SBounded T where - sMinBound :: Sing (MinBoundSym0 :: T) - sMaxBound :: Sing (MaxBoundSym0 :: T) - sMinBound = ST - sMaxBound = ST - instance SShow T where - sShowsPrec :: - forall (t1 :: GHC.Types.Nat) (t2 :: T) (t3 :: GHC.Types.Symbol). - Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol - -> GHC.Types.Type) - -> GHC.Types.Type) - -> GHC.Types.Type) t1) t2) t3) - sShowsPrec - _ - ST - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - ((applySing ((singFun2 @ShowStringSym0) sShowString)) - (sing :: Sing "T"))) - sA_0123456789876543210 - instance SEq T where - (%==) ST ST = STrue - instance SDecide T where - (%~) ST ST = Proved Refl - instance Data.Singletons.ShowSing.ShowSing T where - Data.Singletons.ShowSing.showsSingPrec _ ST = showString "ST" - instance Show (Sing (z :: T)) where - showsPrec = Data.Singletons.ShowSing.showsSingPrec - instance SingI T where - sing = ST diff --git a/tests/compile-and-dump/Singletons/T190.ghc86.template b/tests/compile-and-dump/Singletons/T190.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T190.ghc86.template @@ -0,0 +1,188 @@ +Singletons/T190.hs:0:0:: Splicing declarations + singletons + [d| data T + = T + deriving (Eq, Ord, Enum, Bounded, Show) |] + ======> + data T + = T + deriving (Eq, Ord, Enum, Bounded, Show) + type TSym0 = T + type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where + Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T) :: (~>) T Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd T where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Case_0123456789876543210 n t where + Case_0123456789876543210 n 'True = TSym0 + Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" + type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where + ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) + data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat T + where + ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => + ToEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 + type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where + FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) = + FromEnum_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) + data FromEnum_0123456789876543210Sym0 :: (~>) T GHC.Types.Nat + where + FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => + FromEnum_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 + instance PEnum T where + type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a + type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a + type family MinBound_0123456789876543210 :: T where + MinBound_0123456789876543210 = TSym0 + type MinBound_0123456789876543210Sym0 = + MinBound_0123456789876543210 + type family MaxBound_0123456789876543210 :: T where + MaxBound_0123456789876543210 = TSym0 + type MaxBound_0123456789876543210Sym0 = + MaxBound_0123456789876543210 + instance PBounded T where + type MinBound = MinBound_0123456789876543210Sym0 + type MaxBound = MaxBound_0123456789876543210Sym0 + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + where + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) + data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol) + where + ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + instance PShow T where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where + Equals_0123456789876543210 T T = TrueSym0 + Equals_0123456789876543210 (_ :: T) (_ :: T) = FalseSym0 + instance PEq T where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: T -> GHC.Types.Type where ST :: Sing T + type ST = (Sing :: T -> GHC.Types.Type) + instance SingKind T where + type Demote T = T + fromSing ST = T + toSing T = SomeSing ST + instance SOrd T where + sCompare :: + forall (t1 :: T) (t2 :: T). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun T ((~>) T Ordering) + -> GHC.Types.Type) t1) t2) + sCompare ST ST + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + Data.Singletons.Prelude.Instances.SNil + instance SEnum T where + sToEnum :: + forall (t :: GHC.Types.Nat). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat T + -> GHC.Types.Type) t) + sFromEnum :: + forall (t :: T). + Sing t + -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun T GHC.Types.Nat + -> GHC.Types.Type) t) + sToEnum (sN :: Sing n) + = (case + (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) + (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) + of + STrue -> ST + SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: + Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) + sFromEnum ST + = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) + instance SBounded T where + sMinBound :: Sing (MinBoundSym0 :: T) + sMaxBound :: Sing (MaxBoundSym0 :: T) + sMinBound = ST + sMaxBound = ST + instance SShow T where + sShowsPrec :: + forall (t1 :: GHC.Types.Nat) (t2 :: T) (t3 :: GHC.Types.Symbol). + Sing t1 + -> Sing t2 + -> Sing t3 + -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + -> GHC.Types.Type) t1) t2) t3) + sShowsPrec + _ + ST + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @ShowStringSym0) sShowString)) + (sing :: Sing "T"))) + sA_0123456789876543210 + instance SEq T where + (%==) ST ST = STrue + instance SDecide T where + (%~) ST ST = Proved Refl + deriving instance Show (Sing (z :: T)) + instance SingI T where + sing = ST diff --git a/tests/compile-and-dump/Singletons/T190.hs b/tests/compile-and-dump/Singletons/T190.hs --- a/tests/compile-and-dump/Singletons/T190.hs +++ b/tests/compile-and-dump/Singletons/T190.hs @@ -4,7 +4,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} module T190 where diff --git a/tests/compile-and-dump/Singletons/T197.ghc84.template b/tests/compile-and-dump/Singletons/T197.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T197.ghc84.template +++ /dev/null @@ -1,33 +0,0 @@ -Singletons/T197.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixl 5 $$: - - ($$:) :: Bool -> Bool -> Bool - _ $$: _ = False |] - ======> - infixl 5 $$: - ($$:) :: Bool -> Bool -> Bool - ($$:) _ _ = False - type ($$:@#@$$$) (t :: Bool) (t :: Bool) = ($$:) t t - instance SuppressUnusedWarnings ($$:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.()) - data ($$:@#@$$) (l :: Bool) (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) => - (:$$:@#@$$###) - type instance Apply (($$:@#@$$) l) l = ($$:) l l - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.()) - data ($$:@#@$) (l :: TyFun Bool (TyFun Bool Bool - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - (:$$:@#@$###) - type instance Apply ($$:@#@$) l = ($$:@#@$$) l - type family ($$:) (a :: Bool) (a :: Bool) :: Bool where - ($$:) _ _ = FalseSym0 - infixl 5 %$$: - (%$$:) :: - forall (t :: Bool) (t :: Bool). - Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: Bool) - (%$$:) _ _ = SFalse diff --git a/tests/compile-and-dump/Singletons/T197.ghc86.template b/tests/compile-and-dump/Singletons/T197.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197.ghc86.template @@ -0,0 +1,43 @@ +Singletons/T197.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixl 5 $$: + + ($$:) :: Bool -> Bool -> Bool + _ $$: _ = False |] + ======> + infixl 5 $$: + ($$:) :: Bool -> Bool -> Bool + ($$:) _ _ = False + type ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = + ($$:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) + data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool + where + (:$$:@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => + ($$:@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 + infixl 5 $$:@#@$$ + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) + data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) + where + (:$$:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + ($$:@#@$) a0123456789876543210 + type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 + infixl 5 $$:@#@$ + type family ($$:) (a :: Bool) (a :: Bool) :: Bool where + ($$:) _ _ = FalseSym0 + infixl 5 %$$: + (%$$:) :: + forall (t :: Bool) (t :: Bool). + Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: Bool) + (%$$:) _ _ = SFalse + instance SingI (($$:@#@$) :: (~>) Bool ((~>) Bool Bool)) where + sing = (singFun2 @($$:@#@$)) (%$$:) + instance SingI d => + SingI (($$:@#@$$) (d :: Bool) :: (~>) Bool Bool) where + sing = (singFun1 @(($$:@#@$$) (d :: Bool))) ((%$$:) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T197b.ghc84.template b/tests/compile-and-dump/Singletons/T197b.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T197b.ghc84.template +++ /dev/null @@ -1,81 +0,0 @@ -Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixr 9 `Pair`, `MkPair` - - data a :*: b = a :*: b - data Pair a b = MkPair a b |] - ======> - data (:*:) a b = a :*: b - data Pair a b = MkPair a b - infixr 9 `Pair` - infixr 9 `MkPair` - type (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) = - (:*:) t t - instance SuppressUnusedWarnings (:*:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.()) - data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) => - (::*:@#@$$###) - type instance Apply ((:*:@#@$$) l) l = (:*:) l l - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.()) - data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (::*:@#@$###) - type instance Apply (:*:@#@$) l = (:*:@#@$$) l - type MkPairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) = - MkPair t t - instance SuppressUnusedWarnings MkPairSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkPairSym1KindInference) GHC.Tuple.()) - data MkPairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply (MkPairSym1 l) arg) (MkPairSym2 l arg) => - MkPairSym1KindInference - type instance Apply (MkPairSym1 l) l = MkPair l l - instance SuppressUnusedWarnings MkPairSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkPairSym0KindInference) GHC.Tuple.()) - data MkPairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => - MkPairSym0KindInference - type instance Apply MkPairSym0 l = MkPairSym1 l - infixr 9 `SMkPair` - infixr 9 `SPair` - data instance Sing (z :: (:*:) a b) - where - (:%*:) :: forall (n :: a) (n :: b). - (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) - type %:*: = (Sing :: (:*:) a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind ((:*:) a b) where - type Demote ((:*:) a b) = (:*:) (Demote a) (Demote b) - fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) - toSing ((:*:) (b :: Demote a) (b :: Demote b)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%*:) c) c) } - data instance Sing (z :: Pair a b) - where - SMkPair :: forall (n :: a) (n :: b). - (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (MkPair n n) - type SPair = (Sing :: Pair a b -> GHC.Types.Type) - instance (SingKind a, SingKind b) => SingKind (Pair a b) where - type Demote (Pair a b) = Pair (Demote a) (Demote b) - fromSing (SMkPair b b) = (MkPair (fromSing b)) (fromSing b) - toSing (MkPair (b :: Demote a) (b :: Demote b)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing ((SMkPair c) c) } - instance (SingI n, SingI n) => - SingI ((:*:) (n :: a) (n :: b)) where - sing = ((:%*:) sing) sing - instance (SingI n, SingI n) => - SingI (MkPair (n :: a) (n :: b)) where - sing = (SMkPair sing) sing diff --git a/tests/compile-and-dump/Singletons/T197b.ghc86.template b/tests/compile-and-dump/Singletons/T197b.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T197b.ghc86.template @@ -0,0 +1,106 @@ +Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixr 9 `Pair`, `MkPair` + + data a :*: b = a :*: b + data Pair a b = MkPair a b |] + ======> + data (:*:) a b = a :*: b + data Pair a b = MkPair a b + infixr 9 `Pair` + infixr 9 `MkPair` + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) + data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210) + where + (::*:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => + (:*:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) + where + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 + type MkPairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + MkPair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkPairSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkPairSym1KindInference) ()) + data MkPairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) + where + MkPairSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkPairSym1 t0123456789876543210) arg) (MkPairSym2 t0123456789876543210 arg) => + MkPairSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkPairSym1 t0123456789876543210) t0123456789876543210 = MkPair t0123456789876543210 t0123456789876543210 + infixr 9 `MkPairSym1` + instance SuppressUnusedWarnings MkPairSym0 where + suppressUnusedWarnings = snd (((,) MkPairSym0KindInference) ()) + data MkPairSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + where + MkPairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => + MkPairSym0 t0123456789876543210 + type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210 + infixr 9 `MkPairSym0` + infixr 9 `SPair` + infixr 9 `SMkPair` + data instance Sing :: (:*:) a b -> GHC.Types.Type + where + (:%*:) :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) + type (%:*:) = (Sing :: (:*:) a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind ((:*:) a b) where + type Demote ((:*:) a b) = (:*:) (Demote a) (Demote b) + fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) + toSing ((:*:) (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } + data instance Sing :: Pair a b -> GHC.Types.Type + where + SMkPair :: forall a b (n :: a) (n :: b). + (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (MkPair n n) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind a, SingKind b) => SingKind (Pair a b) where + type Demote (Pair a b) = Pair (Demote a) (Demote b) + fromSing (SMkPair b b) = (MkPair (fromSing b)) (fromSing b) + toSing (MkPair (b :: Demote a) (b :: Demote b)) + = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkPair c) c) } + instance (SingI n, SingI n) => + SingI ((:*:) (n :: a) (n :: b)) where + sing = ((:%*:) sing) sing + instance SingI ((:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))) where + sing = (singFun2 @(:*:@#@$)) (:%*:) + instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b ((:*:) a b))) where + sing = (singFun2 @(TyCon2 (:*:))) (:%*:) + instance SingI d => + SingI ((:*:@#@$$) (d :: a) :: (~>) b ((:*:) a b)) where + sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b ((:*:) a b)) where + sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) + instance (SingI n, SingI n) => + SingI (MkPair (n :: a) (n :: b)) where + sing = (SMkPair sing) sing + instance SingI (MkPairSym0 :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @MkPairSym0) SMkPair + instance SingI (TyCon2 MkPair :: (~>) a ((~>) b (Pair a b))) where + sing = (singFun2 @(TyCon2 MkPair)) SMkPair + instance SingI d => + SingI (MkPairSym1 (d :: a) :: (~>) b (Pair a b)) where + sing = (singFun1 @(MkPairSym1 (d :: a))) (SMkPair (sing @d)) + instance SingI d => + SingI (TyCon1 (MkPair (d :: a)) :: (~>) b (Pair a b)) where + sing = (singFun1 @(TyCon1 (MkPair (d :: a)))) (SMkPair (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T200.ghc84.template b/tests/compile-and-dump/Singletons/T200.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T200.ghc84.template +++ /dev/null @@ -1,154 +0,0 @@ -Singletons/T200.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - x $$: y = x :$$: y - (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - x <>: y = x :<>: y - - data ErrorMessage - = ErrorMessage :$$: ErrorMessage | - ErrorMessage :<>: ErrorMessage | - EM [Bool] |] - ======> - data ErrorMessage - = ErrorMessage :$$: ErrorMessage | - ErrorMessage :<>: ErrorMessage | - EM [Bool] - ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - ($$:) x y = (x :$$: y) - (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - (<>:) x y = (x :<>: y) - type (:$$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = - (:$$:) t t - instance SuppressUnusedWarnings (:$$:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::$$:@#@$$###)) GHC.Tuple.()) - data (:$$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) - = forall arg. SameKind (Apply ((:$$:@#@$$) l) arg) ((:$$:@#@$$$) l arg) => - (::$$:@#@$$###) - type instance Apply ((:$$:@#@$$) l) l = (:$$:) l l - instance SuppressUnusedWarnings (:$$:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::$$:@#@$###)) GHC.Tuple.()) - data (:$$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => - (::$$:@#@$###) - type instance Apply (:$$:@#@$) l = (:$$:@#@$$) l - type (:<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = - (:<>:) t t - instance SuppressUnusedWarnings (:<>:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::<>:@#@$$###)) GHC.Tuple.()) - data (:<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) - = forall arg. SameKind (Apply ((:<>:@#@$$) l) arg) ((:<>:@#@$$$) l arg) => - (::<>:@#@$$###) - type instance Apply ((:<>:@#@$$) l) l = (:<>:) l l - instance SuppressUnusedWarnings (:<>:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (::<>:@#@$###)) GHC.Tuple.()) - data (:<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => - (::<>:@#@$###) - type instance Apply (:<>:@#@$) l = (:<>:@#@$$) l - type EMSym1 (t :: [Bool]) = EM t - instance SuppressUnusedWarnings EMSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) EMSym0KindInference) GHC.Tuple.()) - data EMSym0 (l :: TyFun [Bool] ErrorMessage) - = forall arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) => - EMSym0KindInference - type instance Apply EMSym0 l = EM l - type (<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = - (<>:) t t - instance SuppressUnusedWarnings (<>:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<>:@#@$$###)) GHC.Tuple.()) - data (<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) - = forall arg. SameKind (Apply ((<>:@#@$$) l) arg) ((<>:@#@$$$) l arg) => - (:<>:@#@$$###) - type instance Apply ((<>:@#@$$) l) l = (<>:) l l - instance SuppressUnusedWarnings (<>:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:<>:@#@$###)) GHC.Tuple.()) - data (<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => - (:<>:@#@$###) - type instance Apply (<>:@#@$) l = (<>:@#@$$) l - type ($$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) = - ($$:) t t - instance SuppressUnusedWarnings ($$:@#@$$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.()) - data ($$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage) - = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) => - (:$$:@#@$$###) - type instance Apply (($$:@#@$$) l) l = ($$:) l l - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.()) - data ($$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage - -> GHC.Types.Type)) - = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - (:$$:@#@$###) - type instance Apply ($$:@#@$) l = ($$:@#@$$) l - type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where - (<>:) x y = Apply (Apply (:<>:@#@$) x) y - type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where - ($$:) x y = Apply (Apply (:$$:@#@$) x) y - (%<>:) :: - forall (t :: ErrorMessage) (t :: ErrorMessage). - Sing t - -> Sing t -> Sing (Apply (Apply (<>:@#@$) t) t :: ErrorMessage) - (%$$:) :: - forall (t :: ErrorMessage) (t :: ErrorMessage). - Sing t - -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage) - (%<>:) (sX :: Sing x) (sY :: Sing y) - = (applySing ((applySing ((singFun2 @(:<>:@#@$)) (:%<>:))) sX)) sY - (%$$:) (sX :: Sing x) (sY :: Sing y) - = (applySing ((applySing ((singFun2 @(:$$:@#@$)) (:%$$:))) sX)) sY - data instance Sing (z :: ErrorMessage) - where - (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). - (Sing (n :: ErrorMessage)) - -> (Sing (n :: ErrorMessage)) -> Sing ((:$$:) n n) - (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). - (Sing (n :: ErrorMessage)) - -> (Sing (n :: ErrorMessage)) -> Sing ((:<>:) n n) - SEM :: forall (n :: [Bool]). (Sing (n :: [Bool])) -> Sing (EM n) - type SErrorMessage = (Sing :: ErrorMessage -> GHC.Types.Type) - instance SingKind ErrorMessage where - type Demote ErrorMessage = ErrorMessage - fromSing ((:%$$:) b b) = ((:$$:) (fromSing b)) (fromSing b) - fromSing ((:%<>:) b b) = ((:<>:) (fromSing b)) (fromSing b) - fromSing (SEM b) = EM (fromSing b) - toSing - ((:$$:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage)) - (toSing b :: SomeSing ErrorMessage) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%$$:) c) c) } - toSing - ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage)) - (toSing b :: SomeSing ErrorMessage) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) - -> SomeSing (((:%<>:) c) c) } - toSing (EM (b :: Demote [Bool])) - = case toSing b :: SomeSing [Bool] of { - SomeSing c -> SomeSing (SEM c) } - instance (SingI n, SingI n) => - SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where - sing = ((:%$$:) sing) sing - instance (SingI n, SingI n) => - SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where - sing = ((:%<>:) sing) sing - instance SingI n => SingI (EM (n :: [Bool])) where - sing = SEM sing diff --git a/tests/compile-and-dump/Singletons/T200.ghc86.template b/tests/compile-and-dump/Singletons/T200.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T200.ghc86.template @@ -0,0 +1,204 @@ +Singletons/T200.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x $$: y = x :$$: y + (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + x <>: y = x :<>: y + + data ErrorMessage + = ErrorMessage :$$: ErrorMessage | + ErrorMessage :<>: ErrorMessage | + EM [Bool] |] + ======> + data ErrorMessage + = ErrorMessage :$$: ErrorMessage | + ErrorMessage :<>: ErrorMessage | + EM [Bool] + ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + ($$:) x y = (x :$$: y) + (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage + (<>:) x y = (x :<>: y) + type (:$$:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = + (:$$:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:$$:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::$$:@#@$$###)) ()) + data (:$$:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage + where + (::$$:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:$$:@#@$$) t0123456789876543210) arg) ((:$$:@#@$$$) t0123456789876543210 arg) => + (:$$:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:$$:@#@$$) t0123456789876543210) t0123456789876543210 = (:$$:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:$$:@#@$) where + suppressUnusedWarnings = snd (((,) (::$$:@#@$###)) ()) + data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (::$$:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => + (:$$:@#@$) t0123456789876543210 + type instance Apply (:$$:@#@$) t0123456789876543210 = (:$$:@#@$$) t0123456789876543210 + type (:<>:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = + (:<>:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ((:<>:@#@$$) t0123456789876543210) where + suppressUnusedWarnings = snd (((,) (::<>:@#@$$###)) ()) + data (:<>:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage + where + (::<>:@#@$$###) :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply ((:<>:@#@$$) t0123456789876543210) arg) ((:<>:@#@$$$) t0123456789876543210 arg) => + (:<>:@#@$$) t0123456789876543210 t0123456789876543210 + type instance Apply ((:<>:@#@$$) t0123456789876543210) t0123456789876543210 = (:<>:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:<>:@#@$) where + suppressUnusedWarnings = snd (((,) (::<>:@#@$###)) ()) + data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (::<>:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => + (:<>:@#@$) t0123456789876543210 + type instance Apply (:<>:@#@$) t0123456789876543210 = (:<>:@#@$$) t0123456789876543210 + type EMSym1 (t0123456789876543210 :: [Bool]) = + EM t0123456789876543210 + instance SuppressUnusedWarnings EMSym0 where + suppressUnusedWarnings = snd (((,) EMSym0KindInference) ()) + data EMSym0 :: (~>) [Bool] ErrorMessage + where + EMSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) => + EMSym0 t0123456789876543210 + type instance Apply EMSym0 t0123456789876543210 = EM t0123456789876543210 + type (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = + (<>:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<>:@#@$$###)) ()) + data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage + where + (:<>:@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) => + (<>:@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (<>:@#@$) where + suppressUnusedWarnings = snd (((,) (:<>:@#@$###)) ()) + data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (:<>:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => + (<>:@#@$) a0123456789876543210 + type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210 + type ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = + ($$:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) + data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage + where + (:$$:@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => + ($$:@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) + data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (:$$:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + ($$:@#@$) a0123456789876543210 + type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 + type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where + (<>:) x y = Apply (Apply (:<>:@#@$) x) y + type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where + ($$:) x y = Apply (Apply (:$$:@#@$) x) y + (%<>:) :: + forall (t :: ErrorMessage) (t :: ErrorMessage). + Sing t + -> Sing t -> Sing (Apply (Apply (<>:@#@$) t) t :: ErrorMessage) + (%$$:) :: + forall (t :: ErrorMessage) (t :: ErrorMessage). + Sing t + -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage) + (%<>:) (sX :: Sing x) (sY :: Sing y) + = (applySing ((applySing ((singFun2 @(:<>:@#@$)) (:%<>:))) sX)) sY + (%$$:) (sX :: Sing x) (sY :: Sing y) + = (applySing ((applySing ((singFun2 @(:$$:@#@$)) (:%$$:))) sX)) sY + instance SingI ((<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @(<>:@#@$)) (%<>:) + instance SingI d => + SingI ((<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @((<>:@#@$$) (d :: ErrorMessage))) ((%<>:) (sing @d)) + instance SingI (($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @($$:@#@$)) (%$$:) + instance SingI d => + SingI (($$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @(($$:@#@$$) (d :: ErrorMessage))) ((%$$:) (sing @d)) + data instance Sing :: ErrorMessage -> GHC.Types.Type + where + (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). + (Sing (n :: ErrorMessage)) + -> (Sing (n :: ErrorMessage)) -> Sing ((:$$:) n n) + (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). + (Sing (n :: ErrorMessage)) + -> (Sing (n :: ErrorMessage)) -> Sing ((:<>:) n n) + SEM :: forall (n :: [Bool]). (Sing (n :: [Bool])) -> Sing (EM n) + type SErrorMessage = (Sing :: ErrorMessage -> GHC.Types.Type) + instance SingKind ErrorMessage where + type Demote ErrorMessage = ErrorMessage + fromSing ((:%$$:) b b) = ((:$$:) (fromSing b)) (fromSing b) + fromSing ((:%<>:) b b) = ((:<>:) (fromSing b)) (fromSing b) + fromSing (SEM b) = EM (fromSing b) + toSing + ((:$$:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) + = case + ((,) (toSing b :: SomeSing ErrorMessage)) + (toSing b :: SomeSing ErrorMessage) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%$$:) c) c) } + toSing + ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) + = case + ((,) (toSing b :: SomeSing ErrorMessage)) + (toSing b :: SomeSing ErrorMessage) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%<>:) c) c) } + toSing (EM (b :: Demote [Bool])) + = case toSing b :: SomeSing [Bool] of { + SomeSing c -> SomeSing (SEM c) } + instance (SingI n, SingI n) => + SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where + sing = ((:%$$:) sing) sing + instance SingI ((:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @(:$$:@#@$)) (:%$$:) + instance SingI (TyCon2 (:$$:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @(TyCon2 (:$$:))) (:%$$:) + instance SingI d => + SingI ((:$$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @((:$$:@#@$$) (d :: ErrorMessage))) ((:%$$:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:$$:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @(TyCon1 ((:$$:) (d :: ErrorMessage)))) + ((:%$$:) (sing @d)) + instance (SingI n, SingI n) => + SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where + sing = ((:%<>:) sing) sing + instance SingI ((:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @(:<>:@#@$)) (:%<>:) + instance SingI (TyCon2 (:<>:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where + sing = (singFun2 @(TyCon2 (:<>:))) (:%<>:) + instance SingI d => + SingI ((:<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @((:<>:@#@$$) (d :: ErrorMessage))) ((:%<>:) (sing @d)) + instance SingI d => + SingI (TyCon1 ((:<>:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where + sing + = (singFun1 @(TyCon1 ((:<>:) (d :: ErrorMessage)))) + ((:%<>:) (sing @d)) + instance SingI n => SingI (EM (n :: [Bool])) where + sing = SEM sing + instance SingI (EMSym0 :: (~>) [Bool] ErrorMessage) where + sing = (singFun1 @EMSym0) SEM + instance SingI (TyCon1 EM :: (~>) [Bool] ErrorMessage) where + sing = (singFun1 @(TyCon1 EM)) SEM diff --git a/tests/compile-and-dump/Singletons/T206.ghc84.template b/tests/compile-and-dump/Singletons/T206.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T206.ghc84.template +++ /dev/null diff --git a/tests/compile-and-dump/Singletons/T206.ghc86.template b/tests/compile-and-dump/Singletons/T206.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T206.ghc86.template diff --git a/tests/compile-and-dump/Singletons/T209.ghc84.template b/tests/compile-and-dump/Singletons/T209.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T209.ghc84.template +++ /dev/null @@ -1,68 +0,0 @@ -Singletons/T209.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| m :: a -> b -> Bool -> Bool - m _ _ x = x - - class C a b - data Hm - = Hm - deriving anyclass (C Bool) - - deriving anyclass instance C a a => C a (Maybe a) |] - ======> - class C a b - m :: a -> b -> Bool -> Bool - m _ _ x = x - data Hm - = Hm - deriving anyclass (C Bool) - deriving anyclass instance C a a => C a (Maybe a) - type HmSym0 = Hm - type MSym3 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: Bool) = - M t t t - instance SuppressUnusedWarnings MSym2 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MSym2KindInference) GHC.Tuple.()) - data MSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply (MSym2 l l) arg) (MSym3 l l arg) => - MSym2KindInference - type instance Apply (MSym2 l l) l = M l l l - instance SuppressUnusedWarnings MSym1 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MSym1KindInference) GHC.Tuple.()) - data MSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun Bool Bool - -> GHC.Types.Type)) - = forall arg. SameKind (Apply (MSym1 l) arg) (MSym2 l arg) => - MSym1KindInference - type instance Apply (MSym1 l) l = MSym2 l l - instance SuppressUnusedWarnings MSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MSym0KindInference) GHC.Tuple.()) - data MSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun Bool Bool - -> GHC.Types.Type) - -> GHC.Types.Type)) - = forall arg. SameKind (Apply MSym0 arg) (MSym1 arg) => - MSym0KindInference - type instance Apply MSym0 l = MSym1 l - type family M (a :: a) (a :: b) (a :: Bool) :: Bool where - M _ _ x = x - class PC (a :: GHC.Types.Type) (b :: GHC.Types.Type) - instance PC Bool Hm - instance PC a (Maybe a) - sM :: - forall (t :: a) (t :: b) (t :: Bool). - Sing t - -> Sing t - -> Sing t -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool) - sM _ _ (sX :: Sing x) = sX - data instance Sing (z :: Hm) where SHm :: Sing Hm - type SHm = (Sing :: Hm -> GHC.Types.Type) - instance SingKind Hm where - type Demote Hm = Hm - fromSing SHm = Hm - toSing Hm = SomeSing SHm - class SC a b - instance SC Bool Hm - instance SC a a => SC a (Maybe a) - instance SingI Hm where - sing = SHm diff --git a/tests/compile-and-dump/Singletons/T209.ghc86.template b/tests/compile-and-dump/Singletons/T209.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T209.ghc86.template @@ -0,0 +1,82 @@ +Singletons/T209.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| m :: a -> b -> Bool -> Bool + m _ _ x = x + + class C a b + data Hm + = Hm + deriving anyclass (C Bool) + + deriving anyclass instance C a a => C a (Maybe a) |] + ======> + class C a b + m :: a -> b -> Bool -> Bool + m _ _ x = x + data Hm + = Hm + deriving anyclass (C Bool) + deriving anyclass instance C a a => C a (Maybe a) + type HmSym0 = Hm + type MSym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: Bool) = + M a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) MSym2KindInference) ()) + data MSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) Bool Bool + where + MSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) => + MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) MSym1KindInference) ()) + data MSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 ((~>) Bool Bool) + where + MSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) => + MSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings MSym0 where + suppressUnusedWarnings = snd (((,) MSym0KindInference) ()) + data MSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) Bool Bool)) + where + MSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply MSym0 arg) (MSym1 arg) => + MSym0 a0123456789876543210 + type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210 + type family M (a :: a) (a :: b) (a :: Bool) :: Bool where + M _ _ x = x + class PC (a :: GHC.Types.Type) (b :: GHC.Types.Type) + instance PC Bool Hm + instance PC a (Maybe a) + sM :: + forall a b (t :: a) (t :: b) (t :: Bool). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool) + sM _ _ (sX :: Sing x) = sX + instance SingI (MSym0 :: (~>) a ((~>) b ((~>) Bool Bool))) where + sing = (singFun3 @MSym0) sM + instance SingI d => + SingI (MSym1 (d :: a) :: (~>) b ((~>) Bool Bool)) where + sing = (singFun2 @(MSym1 (d :: a))) (sM (sing @d)) + instance (SingI d, SingI d) => + SingI (MSym2 (d :: a) (d :: b) :: (~>) Bool Bool) where + sing + = (singFun1 @(MSym2 (d :: a) (d :: b))) ((sM (sing @d)) (sing @d)) + data instance Sing :: Hm -> GHC.Types.Type where SHm :: Sing Hm + type SHm = (Sing :: Hm -> GHC.Types.Type) + instance SingKind Hm where + type Demote Hm = Hm + fromSing SHm = Hm + toSing Hm = SomeSing SHm + class SC a b + instance SC Bool Hm + instance SC a a => SC a (Maybe a) + instance SingI Hm where + sing = SHm diff --git a/tests/compile-and-dump/Singletons/T216.ghc86.template b/tests/compile-and-dump/Singletons/T216.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T216.ghc86.template @@ -0,0 +1,56 @@ +Singletons/T216.hs:0:0:: Splicing declarations + genDefunSymbols [''MyProxy, ''Symmetry] + ======> + type MyProxySym2 (k0123456789876543210 :: Type) (a0123456789876543210 :: k0123456789876543210) = + MyProxy k0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where + suppressUnusedWarnings = snd (((,) MyProxySym1KindInference) ()) + data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type + where + MyProxySym1KindInference :: forall k0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) => + MyProxySym1 k0123456789876543210 a0123456789876543210 + type instance Apply (MyProxySym1 k0123456789876543210) a0123456789876543210 = MyProxy k0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings MyProxySym0 where + suppressUnusedWarnings = snd (((,) MyProxySym0KindInference) ()) + data MyProxySym0 :: forall (k0123456789876543210 :: Type). + (~>) Type ((~>) k0123456789876543210 Type) + where + MyProxySym0KindInference :: forall k0123456789876543210 + arg. SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) => + MyProxySym0 k0123456789876543210 + type instance Apply MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210 + type SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) = + Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) + data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type + where + SymmetrySym2KindInference :: forall a0123456789876543210 + y0123456789876543210 + e0123456789876543210 + arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => + SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) + data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: forall (y0123456789876543210 :: t0123456789876543210). + (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) + where + SymmetrySym1KindInference :: forall a0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => + SymmetrySym1 a0123456789876543210 y0123456789876543210 + type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings SymmetrySym0 where + suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) + data SymmetrySym0 :: forall t0123456789876543210 + (a0123456789876543210 :: t0123456789876543210) + (y0123456789876543210 :: t0123456789876543210). + (~>) t0123456789876543210 ((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)) + where + SymmetrySym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => + SymmetrySym0 a0123456789876543210 + type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T216.hs b/tests/compile-and-dump/Singletons/T216.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T216.hs @@ -0,0 +1,12 @@ +module T216 where + +import Data.Kind +import Data.Singletons.TH + +type family MyProxy k (a :: k) :: Type where + MyProxy _ a = Proxy a + +type family Symmetry (a :: t) (y :: t) (e :: a :~: y) :: Type where + Symmetry a y _ = y :~: a + +$(genDefunSymbols [''MyProxy, ''Symmetry]) diff --git a/tests/compile-and-dump/Singletons/T226.ghc84.template b/tests/compile-and-dump/Singletons/T226.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T226.ghc84.template +++ /dev/null @@ -1,6 +0,0 @@ -Singletons/T226.hs:0:0:: Splicing declarations - singletons [d| class a ~> b |] - ======> - class (~>) a b - class (#~>) (a :: GHC.Types.Type) (b :: GHC.Types.Type) - class (%~>) a b diff --git a/tests/compile-and-dump/Singletons/T226.ghc86.template b/tests/compile-and-dump/Singletons/T226.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T226.ghc86.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/T229.ghc84.template b/tests/compile-and-dump/Singletons/T229.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T229.ghc84.template +++ /dev/null @@ -1,20 +0,0 @@ -Singletons/T229.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| ___foo :: Bool -> Bool - ___foo _ = True |] - ======> - ___foo :: Bool -> Bool - ___foo _ = True - type US___fooSym1 (t :: Bool) = US___foo t - instance SuppressUnusedWarnings US___fooSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) US___fooSym0KindInference) GHC.Tuple.()) - data US___fooSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => - US___fooSym0KindInference - type instance Apply US___fooSym0 l = US___foo l - type family US___foo (a :: Bool) :: Bool where - US___foo _ = TrueSym0 - ___sfoo :: - forall (t :: Bool). Sing t -> Sing (Apply US___fooSym0 t :: Bool) - ___sfoo _ = STrue diff --git a/tests/compile-and-dump/Singletons/T229.ghc86.template b/tests/compile-and-dump/Singletons/T229.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T229.ghc86.template @@ -0,0 +1,24 @@ +Singletons/T229.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| ___foo :: Bool -> Bool + ___foo _ = True |] + ======> + ___foo :: Bool -> Bool + ___foo _ = True + type US___fooSym1 (a0123456789876543210 :: Bool) = + US___foo a0123456789876543210 + instance SuppressUnusedWarnings US___fooSym0 where + suppressUnusedWarnings = snd (((,) US___fooSym0KindInference) ()) + data US___fooSym0 :: (~>) Bool Bool + where + US___fooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => + US___fooSym0 a0123456789876543210 + type instance Apply US___fooSym0 a0123456789876543210 = US___foo a0123456789876543210 + type family US___foo (a :: Bool) :: Bool where + US___foo _ = TrueSym0 + ___sfoo :: + forall (t :: Bool). Sing t -> Sing (Apply US___fooSym0 t :: Bool) + ___sfoo _ = STrue + instance SingI (US___fooSym0 :: (~>) Bool Bool) where + sing = (singFun1 @US___fooSym0) ___sfoo diff --git a/tests/compile-and-dump/Singletons/T249.ghc84.template b/tests/compile-and-dump/Singletons/T249.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T249.ghc84.template +++ /dev/null @@ -1,69 +0,0 @@ -Singletons/T249.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Foo1 a = MkFoo1 a - data Foo2 a where MkFoo2 :: x -> Foo2 x - data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |] - ======> - data Foo1 a = MkFoo1 a - data Foo2 a where MkFoo2 :: x -> Foo2 x - data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x - type MkFoo1Sym1 (t :: a0123456789876543210) = MkFoo1 t - instance SuppressUnusedWarnings MkFoo1Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo1Sym0KindInference) GHC.Tuple.()) - data MkFoo1Sym0 (l :: TyFun a0123456789876543210 (Foo1 a0123456789876543210)) - = forall arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => - MkFoo1Sym0KindInference - type instance Apply MkFoo1Sym0 l = MkFoo1 l - type MkFoo2Sym1 (t :: x0123456789876543210) = MkFoo2 t - instance SuppressUnusedWarnings MkFoo2Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo2Sym0KindInference) GHC.Tuple.()) - data MkFoo2Sym0 (l :: TyFun x0123456789876543210 (Foo2 a0123456789876543210)) - = forall arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => - MkFoo2Sym0KindInference - type instance Apply MkFoo2Sym0 l = MkFoo2 l - type MkFoo3Sym1 (t :: x0123456789876543210) = MkFoo3 t - instance SuppressUnusedWarnings MkFoo3Sym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.()) - data MkFoo3Sym0 (l :: TyFun x0123456789876543210 (Foo3 a0123456789876543210)) - = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => - MkFoo3Sym0KindInference - type instance Apply MkFoo3Sym0 l = MkFoo3 l - data instance Sing (z :: Foo1 a) - where - SMkFoo1 :: forall (n :: a). (Sing (n :: a)) -> Sing (MkFoo1 n) - type SFoo1 = (Sing :: Foo1 a -> Type) - instance SingKind a => SingKind (Foo1 a) where - type Demote (Foo1 a) = Foo1 (Demote a) - fromSing (SMkFoo1 b) = MkFoo1 (fromSing b) - toSing (MkFoo1 (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SMkFoo1 c) } - data instance Sing (z :: Foo2 a) - where - SMkFoo2 :: forall (n :: x). (Sing (n :: x)) -> Sing (MkFoo2 n) - type SFoo2 = (Sing :: Foo2 a -> Type) - instance SingKind a => SingKind (Foo2 a) where - type Demote (Foo2 a) = Foo2 (Demote a) - fromSing (SMkFoo2 b) = MkFoo2 (fromSing b) - toSing (MkFoo2 (b :: Demote x)) - = case toSing b :: SomeSing x of { - SomeSing c -> SomeSing (SMkFoo2 c) } - data instance Sing (z :: Foo3 a) - where - SMkFoo3 :: forall (n :: x). (Sing (n :: x)) -> Sing (MkFoo3 n) - type SFoo3 = (Sing :: Foo3 a -> Type) - instance SingKind a => SingKind (Foo3 a) where - type Demote (Foo3 a) = Foo3 (Demote a) - fromSing (SMkFoo3 b) = MkFoo3 (fromSing b) - toSing (MkFoo3 (b :: Demote x)) - = case toSing b :: SomeSing x of { - SomeSing c -> SomeSing (SMkFoo3 c) } - instance SingI n => SingI (MkFoo1 (n :: a)) where - sing = SMkFoo1 sing - instance SingI n => SingI (MkFoo2 (n :: x)) where - sing = SMkFoo2 sing - instance SingI n => SingI (MkFoo3 (n :: x)) where - sing = SMkFoo3 sing diff --git a/tests/compile-and-dump/Singletons/T249.ghc86.template b/tests/compile-and-dump/Singletons/T249.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T249.ghc86.template @@ -0,0 +1,90 @@ +Singletons/T249.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo1 a = MkFoo1 a + data Foo2 a where MkFoo2 :: x -> Foo2 x + data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |] + ======> + data Foo1 a = MkFoo1 a + data Foo2 a where MkFoo2 :: x -> Foo2 x + data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x + type MkFoo1Sym1 (t0123456789876543210 :: a0123456789876543210) = + MkFoo1 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo1Sym0 where + suppressUnusedWarnings = snd (((,) MkFoo1Sym0KindInference) ()) + data MkFoo1Sym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 (Foo1 a0123456789876543210) + where + MkFoo1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => + MkFoo1Sym0 t0123456789876543210 + type instance Apply MkFoo1Sym0 t0123456789876543210 = MkFoo1 t0123456789876543210 + type MkFoo2Sym1 (t0123456789876543210 :: x0123456789876543210) = + MkFoo2 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo2Sym0 where + suppressUnusedWarnings = snd (((,) MkFoo2Sym0KindInference) ()) + data MkFoo2Sym0 :: forall x0123456789876543210. + (~>) x0123456789876543210 (Foo2 x0123456789876543210) + where + MkFoo2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => + MkFoo2Sym0 t0123456789876543210 + type instance Apply MkFoo2Sym0 t0123456789876543210 = MkFoo2 t0123456789876543210 + type MkFoo3Sym1 (t0123456789876543210 :: x0123456789876543210) = + MkFoo3 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo3Sym0 where + suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) + data MkFoo3Sym0 :: forall x0123456789876543210. + (~>) x0123456789876543210 (Foo3 x0123456789876543210) + where + MkFoo3Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => + MkFoo3Sym0 t0123456789876543210 + type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3 t0123456789876543210 + data instance Sing :: Foo1 a -> Type + where + SMkFoo1 :: forall a (n :: a). (Sing (n :: a)) -> Sing (MkFoo1 n) + type SFoo1 = (Sing :: Foo1 a -> Type) + instance SingKind a => SingKind (Foo1 a) where + type Demote (Foo1 a) = Foo1 (Demote a) + fromSing (SMkFoo1 b) = MkFoo1 (fromSing b) + toSing (MkFoo1 (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SMkFoo1 c) } + data instance Sing :: Foo2 a -> Type + where + SMkFoo2 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo2 n) + type SFoo2 = (Sing :: Foo2 a -> Type) + instance SingKind a => SingKind (Foo2 a) where + type Demote (Foo2 a) = Foo2 (Demote a) + fromSing (SMkFoo2 b) = MkFoo2 (fromSing b) + toSing (MkFoo2 (b :: Demote x)) + = case toSing b :: SomeSing x of { + SomeSing c -> SomeSing (SMkFoo2 c) } + data instance Sing :: Foo3 a -> Type + where + SMkFoo3 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo3 n) + type SFoo3 = (Sing :: Foo3 a -> Type) + instance SingKind a => SingKind (Foo3 a) where + type Demote (Foo3 a) = Foo3 (Demote a) + fromSing (SMkFoo3 b) = MkFoo3 (fromSing b) + toSing (MkFoo3 (b :: Demote x)) + = case toSing b :: SomeSing x of { + SomeSing c -> SomeSing (SMkFoo3 c) } + instance SingI n => SingI (MkFoo1 (n :: a)) where + sing = SMkFoo1 sing + instance SingI (MkFoo1Sym0 :: (~>) a (Foo1 a)) where + sing = (singFun1 @MkFoo1Sym0) SMkFoo1 + instance SingI (TyCon1 MkFoo1 :: (~>) a (Foo1 a)) where + sing = (singFun1 @(TyCon1 MkFoo1)) SMkFoo1 + instance SingI n => SingI (MkFoo2 (n :: x)) where + sing = SMkFoo2 sing + instance SingI (MkFoo2Sym0 :: (~>) x (Foo2 x)) where + sing = (singFun1 @MkFoo2Sym0) SMkFoo2 + instance SingI (TyCon1 MkFoo2 :: (~>) x (Foo2 x)) where + sing = (singFun1 @(TyCon1 MkFoo2)) SMkFoo2 + instance SingI n => SingI (MkFoo3 (n :: x)) where + sing = SMkFoo3 sing + instance SingI (MkFoo3Sym0 :: (~>) x (Foo3 x)) where + sing = (singFun1 @MkFoo3Sym0) SMkFoo3 + instance SingI (TyCon1 MkFoo3 :: (~>) x (Foo3 x)) where + sing = (singFun1 @(TyCon1 MkFoo3)) SMkFoo3 diff --git a/tests/compile-and-dump/Singletons/T271.ghc84.template b/tests/compile-and-dump/Singletons/T271.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T271.ghc84.template +++ /dev/null @@ -1,179 +0,0 @@ -Singletons/T271.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| newtype Constant (a :: Type) (b :: Type) - = Constant a - deriving (Eq, Ord) - data Identity :: Type -> Type - where Identity :: a -> Identity a - deriving (Eq, Ord) |] - ======> - newtype Constant (a :: Type) (b :: Type) - = Constant a - deriving (Eq, Ord) - data Identity :: Type -> Type - where Identity :: a -> Identity a - deriving (Eq, Ord) - type ConstantSym1 (t :: a0123456789876543210) = Constant t - instance SuppressUnusedWarnings ConstantSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) ConstantSym0KindInference) GHC.Tuple.()) - data ConstantSym0 (l :: TyFun a0123456789876543210 (Constant a0123456789876543210 b0123456789876543210)) - = forall arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => - ConstantSym0KindInference - type instance Apply ConstantSym0 l = Constant l - type IdentitySym1 (t :: a0123456789876543210) = Identity t - instance SuppressUnusedWarnings IdentitySym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) IdentitySym0KindInference) GHC.Tuple.()) - data IdentitySym0 (l :: TyFun a0123456789876543210 (Identity a0123456789876543210)) - = forall arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => - IdentitySym0KindInference - type instance Apply IdentitySym0 l = Identity l - type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where - Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - type Compare_0123456789876543210Sym2 (t :: Constant a0123456789876543210 b0123456789876543210) (t :: Constant a0123456789876543210 b0123456789876543210) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Constant a0123456789876543210 b0123456789876543210) (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) (TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd (Constant a b) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where - Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - type Compare_0123456789876543210Sym2 (t :: Identity a0123456789876543210) (t :: Identity a0123456789876543210) = - Compare_0123456789876543210 t t - instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym1 (l :: Identity a0123456789876543210) (l :: TyFun (Identity a0123456789876543210) Ordering) - = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) => - Compare_0123456789876543210Sym1KindInference - type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Compare_0123456789876543210Sym0 (l :: TyFun (Identity a0123456789876543210) (TyFun (Identity a0123456789876543210) Ordering - -> Type)) - = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0KindInference - type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l - instance POrd (Identity a) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where - Equals_0123456789876543210 (Constant a) (Constant b) = (==) a b - Equals_0123456789876543210 (_ :: Constant a b) (_ :: Constant a b) = FalseSym0 - instance PEq (Constant a b) where - type (==) a b = Equals_0123456789876543210 a b - type family Equals_0123456789876543210 (a :: Identity a) (b :: Identity a) :: Bool where - Equals_0123456789876543210 (Identity a) (Identity b) = (==) a b - Equals_0123456789876543210 (_ :: Identity a) (_ :: Identity a) = FalseSym0 - instance PEq (Identity a) where - type (==) a b = Equals_0123456789876543210 a b - data instance Sing (z :: Constant a b) - where - SConstant :: forall (n :: a). (Sing (n :: a)) -> Sing (Constant n) - type SConstant = (Sing :: Constant a b -> Type) - instance (SingKind a, SingKind b) => SingKind (Constant a b) where - type Demote (Constant a b) = Constant (Demote a) (Demote b) - fromSing (SConstant b) = Constant (fromSing b) - toSing (Constant (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SConstant c) } - data instance Sing (z :: Identity a) - where - SIdentity :: forall (n :: a). (Sing (n :: a)) -> Sing (Identity n) - type SIdentity = (Sing :: Identity a -> Type) - instance SingKind a => SingKind (Identity a) where - type Demote (Identity a) = Identity (Demote a) - fromSing (SIdentity b) = Identity (fromSing b) - toSing (Identity (b :: Demote a)) - = case toSing b :: SomeSing a of { - SomeSing c -> SomeSing (SIdentity c) } - instance SOrd a => SOrd (Constant a b) where - sCompare :: - forall (t1 :: Constant a b) (t2 :: Constant a b). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun (Constant a b) (TyFun (Constant a b) Ordering - -> Type) - -> Type) t1) t2) - sCompare - (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing - ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - Data.Singletons.Prelude.Instances.SNil) - instance SOrd a => SOrd (Identity a) where - sCompare :: - forall (t1 :: Identity a) (t2 :: Identity a). - Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun (Identity a) (TyFun (Identity a) Ordering - -> Type) - -> Type) t1) t2) - sCompare - (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = (applySing - ((applySing - ((applySing ((singFun3 @FoldlSym0) sFoldl)) - ((singFun2 @ThenCmpSym0) sThenCmp))) - SEQ)) - ((applySing - ((applySing - ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) - ((applySing - ((applySing ((singFun2 @CompareSym0) sCompare)) - sA_0123456789876543210)) - sB_0123456789876543210))) - Data.Singletons.Prelude.Instances.SNil) - instance SEq a => SEq (Constant a b) where - (%==) (SConstant a) (SConstant b) = ((%==) a) b - instance SDecide a => SDecide (Constant a b) where - (%~) (SConstant a) (SConstant b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SEq a => SEq (Identity a) where - (%==) (SIdentity a) (SIdentity b) = ((%==) a) b - instance SDecide a => SDecide (Identity a) where - (%~) (SIdentity a) (SIdentity b) - = case ((%~) a) b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) - instance SingI n => SingI (Constant (n :: a)) where - sing = SConstant sing - instance SingI n => SingI (Identity (n :: a)) where - sing = SIdentity sing diff --git a/tests/compile-and-dump/Singletons/T271.ghc86.template b/tests/compile-and-dump/Singletons/T271.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T271.ghc86.template @@ -0,0 +1,199 @@ +Singletons/T271.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| newtype Constant (a :: Type) (b :: Type) + = Constant a + deriving (Eq, Ord) + data Identity :: Type -> Type + where Identity :: a -> Identity a + deriving (Eq, Ord) |] + ======> + newtype Constant (a :: Type) (b :: Type) + = Constant a + deriving (Eq, Ord) + data Identity :: Type -> Type + where Identity :: a -> Identity a + deriving (Eq, Ord) + type ConstantSym1 (t0123456789876543210 :: a0123456789876543210) = + Constant t0123456789876543210 + instance SuppressUnusedWarnings ConstantSym0 where + suppressUnusedWarnings = snd (((,) ConstantSym0KindInference) ()) + data ConstantSym0 :: forall (a0123456789876543210 :: Type) + (b0123456789876543210 :: Type). + (~>) a0123456789876543210 (Constant (a0123456789876543210 :: Type) (b0123456789876543210 :: Type)) + where + ConstantSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => + ConstantSym0 t0123456789876543210 + type instance Apply ConstantSym0 t0123456789876543210 = Constant t0123456789876543210 + type IdentitySym1 (t0123456789876543210 :: a0123456789876543210) = + Identity t0123456789876543210 + instance SuppressUnusedWarnings IdentitySym0 where + suppressUnusedWarnings = snd (((,) IdentitySym0KindInference) ()) + data IdentitySym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 (Identity a0123456789876543210) + where + IdentitySym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => + IdentitySym0 t0123456789876543210 + type instance Apply IdentitySym0 t0123456789876543210 = Identity t0123456789876543210 + type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where + Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) :: (~>) (Constant a0123456789876543210 b0123456789876543210) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) (Constant a0123456789876543210 b0123456789876543210) ((~>) (Constant a0123456789876543210 b0123456789876543210) Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd (Constant a b) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where + Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a0123456789876543210) (a0123456789876543210 :: Identity a0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a0123456789876543210) :: (~>) (Identity a0123456789876543210) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) (Identity a0123456789876543210) ((~>) (Identity a0123456789876543210) Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance POrd (Identity a) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where + Equals_0123456789876543210 (Constant a) (Constant b) = (==) a b + Equals_0123456789876543210 (_ :: Constant a b) (_ :: Constant a b) = FalseSym0 + instance PEq (Constant a b) where + type (==) a b = Equals_0123456789876543210 a b + type family Equals_0123456789876543210 (a :: Identity a) (b :: Identity a) :: Bool where + Equals_0123456789876543210 (Identity a) (Identity b) = (==) a b + Equals_0123456789876543210 (_ :: Identity a) (_ :: Identity a) = FalseSym0 + instance PEq (Identity a) where + type (==) a b = Equals_0123456789876543210 a b + data instance Sing :: Constant a b -> Type + where + SConstant :: forall a (n :: a). + (Sing (n :: a)) -> Sing (Constant n) + type SConstant = (Sing :: Constant a b -> Type) + instance (SingKind a, SingKind b) => SingKind (Constant a b) where + type Demote (Constant a b) = Constant (Demote a) (Demote b) + fromSing (SConstant b) = Constant (fromSing b) + toSing (Constant (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SConstant c) } + data instance Sing :: Identity a -> Type + where + SIdentity :: forall a (n :: a). + (Sing (n :: a)) -> Sing (Identity n) + type SIdentity = (Sing :: Identity a -> Type) + instance SingKind a => SingKind (Identity a) where + type Demote (Identity a) = Identity (Demote a) + fromSing (SIdentity b) = Identity (fromSing b) + toSing (Identity (b :: Demote a)) + = case toSing b :: SomeSing a of { + SomeSing c -> SomeSing (SIdentity c) } + instance SOrd a => SOrd (Constant a b) where + sCompare :: + forall (t1 :: Constant a b) (t2 :: Constant a b). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Constant a b) ((~>) (Constant a b) Ordering) + -> Type) t1) t2) + sCompare + (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) + Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + instance SOrd a => SOrd (Identity a) where + sCompare :: + forall (t1 :: Identity a) (t2 :: Identity a). + Sing t1 + -> Sing t2 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Identity a) ((~>) (Identity a) Ordering) + -> Type) t1) t2) + sCompare + (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210)) + (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210)) + = (applySing + ((applySing + ((applySing ((singFun3 @FoldlSym0) sFoldl)) + ((singFun2 @ThenCmpSym0) sThenCmp))) + SEQ)) + ((applySing + ((applySing + ((singFun2 @(:@#@$)) + Data.Singletons.Prelude.Instances.SCons)) + ((applySing + ((applySing ((singFun2 @CompareSym0) sCompare)) + sA_0123456789876543210)) + sB_0123456789876543210))) + Data.Singletons.Prelude.Instances.SNil) + instance SEq a => SEq (Constant a b) where + (%==) (SConstant a) (SConstant b) = ((%==) a) b + instance SDecide a => SDecide (Constant a b) where + (%~) (SConstant a) (SConstant b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SEq a => SEq (Identity a) where + (%==) (SIdentity a) (SIdentity b) = ((%==) a) b + instance SDecide a => SDecide (Identity a) where + (%~) (SIdentity a) (SIdentity b) + = case ((%~) a) b of + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + instance SingI n => SingI (Constant (n :: a)) where + sing = SConstant sing + instance SingI (ConstantSym0 :: (~>) a (Constant (a :: Type) (b :: Type))) where + sing = (singFun1 @ConstantSym0) SConstant + instance SingI (TyCon1 Constant :: (~>) a (Constant (a :: Type) (b :: Type))) where + sing = (singFun1 @(TyCon1 Constant)) SConstant + instance SingI n => SingI (Identity (n :: a)) where + sing = SIdentity sing + instance SingI (IdentitySym0 :: (~>) a (Identity a)) where + sing = (singFun1 @IdentitySym0) SIdentity + instance SingI (TyCon1 Identity :: (~>) a (Identity a)) where + sing = (singFun1 @(TyCon1 Identity)) SIdentity diff --git a/tests/compile-and-dump/Singletons/T271.hs b/tests/compile-and-dump/Singletons/T271.hs --- a/tests/compile-and-dump/Singletons/T271.hs +++ b/tests/compile-and-dump/Singletons/T271.hs @@ -1,6 +1,6 @@ module T271 where -import Data.Kind +import Data.Kind (Type) import Data.Singletons.TH $(singletons diff --git a/tests/compile-and-dump/Singletons/T287.ghc86.template b/tests/compile-and-dump/Singletons/T287.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T287.ghc86.template @@ -0,0 +1,116 @@ +Singletons/T287.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class S a where + (<<>>) :: a -> a -> a + + instance S b => S (a -> b) where + f <<>> g = \ x -> f x <<>> g x |] + ======> + class S a where + (<<>>) :: a -> a -> a + instance S b => S (a -> b) where + (<<>>) f g = \ x -> (f x <<>> g x) + type (<<>>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<<>>) arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings ((<<>>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<<>>@#@$$###)) ()) + data (<<>>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 + where + (:<<>>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<<>>@#@$$) arg0123456789876543210) arg) ((<<>>@#@$$$) arg0123456789876543210 arg) => + (<<>>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<<>>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<<>>) arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (<<>>@#@$) where + suppressUnusedWarnings = snd (((,) (:<<>>@#@$###)) ()) + data (<<>>@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) + where + (:<<>>@#@$###) :: forall arg0123456789876543210 + arg. SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) => + (<<>>@#@$) arg0123456789876543210 + type instance Apply (<<>>@#@$) arg0123456789876543210 = (<<>>@#@$$) arg0123456789876543210 + class PS (a :: GHC.Types.Type) where + type (<<>>) (arg :: a) (arg :: a) :: a + type family Lambda_0123456789876543210 f g t where + Lambda_0123456789876543210 f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x) + type Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall f0123456789876543210 + g0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 g0123456789876543210 f0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 f0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall f0123456789876543210 + g0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) arg) (Lambda_0123456789876543210Sym2 f0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) g0123456789876543210 = Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 f0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall f0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 f0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210 + type family TFHelper_0123456789876543210 (a :: (~>) a b) (a :: (~>) a b) :: (~>) a b where + TFHelper_0123456789876543210 f g = Apply (Apply Lambda_0123456789876543210Sym0 f) g + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance PS ((~>) a b) where + type (<<>>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a + class SS a where + (%<<>>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: a) + instance SS b => SS ((~>) a b) where + (%<<>>) :: + forall (t :: (~>) a b) (t :: (~>) a b). + Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: (~>) a b) + (%<<>>) (sF :: Sing f) (sG :: Sing g) + = (singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 f) g)) + (\ sX + -> case sX of { + (_ :: Sing x) + -> (applySing + ((applySing ((singFun2 @(<<>>@#@$)) (%<<>>))) ((applySing sF) sX))) + ((applySing sG) sX) }) + instance SS a => SingI ((<<>>@#@$) :: (~>) a ((~>) a a)) where + sing = (singFun2 @(<<>>@#@$)) (%<<>>) + instance (SS a, SingI d) => + SingI ((<<>>@#@$$) (d :: a) :: (~>) a a) where + sing = (singFun1 @((<<>>@#@$$) (d :: a))) ((%<<>>) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T287.hs b/tests/compile-and-dump/Singletons/T287.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T287.hs @@ -0,0 +1,11 @@ +module T287 where + +import Data.Singletons.TH + +$(singletons [d| + class S a where + (<<>>) :: a -> a -> a + + instance S b => S (a -> b) where + f <<>> g = \x -> f x <<>> g x + |]) diff --git a/tests/compile-and-dump/Singletons/T29.ghc84.template b/tests/compile-and-dump/Singletons/T29.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T29.ghc84.template +++ /dev/null @@ -1,99 +0,0 @@ -Singletons/T29.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: Bool -> Bool - foo x = not $ x - bar :: Bool -> Bool - bar x = not . not . not $ x - baz :: Bool -> Bool - baz x = not $! x - ban :: Bool -> Bool - ban x = not . not . not $! x |] - ======> - foo :: Bool -> Bool - foo x = (not $ x) - bar :: Bool -> Bool - bar x = ((not . (not . not)) $ x) - baz :: Bool -> Bool - baz x = (not $! x) - ban :: Bool -> Bool - ban x = ((not . (not . not)) $! x) - type BanSym1 (t :: Bool) = Ban t - instance SuppressUnusedWarnings BanSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BanSym0KindInference) GHC.Tuple.()) - data BanSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => - BanSym0KindInference - type instance Apply BanSym0 l = Ban l - type BazSym1 (t :: Bool) = Baz t - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.()) - data BazSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0KindInference - type instance Apply BazSym0 l = Baz l - type BarSym1 (t :: Bool) = Bar t - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = Bar l - type FooSym1 (t :: Bool) = Foo t - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.()) - data FooSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0KindInference - type instance Apply FooSym0 l = Foo l - type family Ban (a :: Bool) :: Bool where - Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x - type family Baz (a :: Bool) :: Bool where - Baz x = Apply (Apply ($!@#@$) NotSym0) x - type family Bar (a :: Bool) :: Bool where - Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x - type family Foo (a :: Bool) :: Bool where - Foo x = Apply (Apply ($@#@$) NotSym0) x - sBan :: - forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) - sBaz :: - forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) - sBar :: - forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) - sFoo :: - forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) - sBan (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($!@#@$)) (%$!))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @NotSym0) sNot))) - ((singFun1 @NotSym0) sNot))))) - sX - sBaz (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($!@#@$)) (%$!))) - ((singFun1 @NotSym0) sNot))) - sX - sBar (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($@#@$)) (%$))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun3 @(.@#@$)) (%.))) - ((singFun1 @NotSym0) sNot))) - ((singFun1 @NotSym0) sNot))))) - sX - sFoo (sX :: Sing x) - = (applySing - ((applySing ((singFun2 @($@#@$)) (%$))) - ((singFun1 @NotSym0) sNot))) - sX diff --git a/tests/compile-and-dump/Singletons/T29.ghc86.template b/tests/compile-and-dump/Singletons/T29.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T29.ghc86.template @@ -0,0 +1,115 @@ +Singletons/T29.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo x = not $ x + bar :: Bool -> Bool + bar x = not . not . not $ x + baz :: Bool -> Bool + baz x = not $! x + ban :: Bool -> Bool + ban x = not . not . not $! x |] + ======> + foo :: Bool -> Bool + foo x = (not $ x) + bar :: Bool -> Bool + bar x = ((not . (not . not)) $ x) + baz :: Bool -> Bool + baz x = (not $! x) + ban :: Bool -> Bool + ban x = ((not . (not . not)) $! x) + type BanSym1 (a0123456789876543210 :: Bool) = + Ban a0123456789876543210 + instance SuppressUnusedWarnings BanSym0 where + suppressUnusedWarnings = snd (((,) BanSym0KindInference) ()) + data BanSym0 :: (~>) Bool Bool + where + BanSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => + BanSym0 a0123456789876543210 + type instance Apply BanSym0 a0123456789876543210 = Ban a0123456789876543210 + type BazSym1 (a0123456789876543210 :: Bool) = + Baz a0123456789876543210 + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) + data BazSym0 :: (~>) Bool Bool + where + BazSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0 a0123456789876543210 + type instance Apply BazSym0 a0123456789876543210 = Baz a0123456789876543210 + type BarSym1 (a0123456789876543210 :: Bool) = + Bar a0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bool Bool + where + BarSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 a0123456789876543210 + type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) Bool Bool + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Ban (a :: Bool) :: Bool where + Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x + type family Baz (a :: Bool) :: Bool where + Baz x = Apply (Apply ($!@#@$) NotSym0) x + type family Bar (a :: Bool) :: Bool where + Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x + type family Foo (a :: Bool) :: Bool where + Foo x = Apply (Apply ($@#@$) NotSym0) x + sBan :: + forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) + sBaz :: + forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBan (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($!@#@$)) (%$!))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((singFun1 @NotSym0) sNot))))) + sX + sBaz (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($!@#@$)) (%$!))) + ((singFun1 @NotSym0) sNot))) + sX + sBar (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($@#@$)) (%$))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun3 @(.@#@$)) (%.))) + ((singFun1 @NotSym0) sNot))) + ((singFun1 @NotSym0) sNot))))) + sX + sFoo (sX :: Sing x) + = (applySing + ((applySing ((singFun2 @($@#@$)) (%$))) + ((singFun1 @NotSym0) sNot))) + sX + instance SingI (BanSym0 :: (~>) Bool Bool) where + sing = (singFun1 @BanSym0) sBan + instance SingI (BazSym0 :: (~>) Bool Bool) where + sing = (singFun1 @BazSym0) sBaz + instance SingI (BarSym0 :: (~>) Bool Bool) where + sing = (singFun1 @BarSym0) sBar + instance SingI (FooSym0 :: (~>) Bool Bool) where + sing = (singFun1 @FooSym0) sFoo diff --git a/tests/compile-and-dump/Singletons/T297.ghc86.template b/tests/compile-and-dump/Singletons/T297.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T297.ghc86.template @@ -0,0 +1,59 @@ +Singletons/T297.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| f MyProxy + = let + x = let + z :: MyProxy a + z = MyProxy + in z + in x + + data MyProxy (a :: Type) = MyProxy |] + ======> + data MyProxy (a :: Type) = MyProxy + f MyProxy + = let + x = let + z :: MyProxy a + z = MyProxy + in z + in x + type MyProxySym0 = MyProxy + type Let0123456789876543210ZSym0 = Let0123456789876543210Z + type family Let0123456789876543210Z :: MyProxy a where + Let0123456789876543210Z = MyProxySym0 + type Let0123456789876543210XSym0 = Let0123456789876543210X + type family Let0123456789876543210X where + Let0123456789876543210X = Let0123456789876543210ZSym0 + type FSym1 a0123456789876543210 = F a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 a0123456789876543210 + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 + type family F a where + F MyProxy = Let0123456789876543210XSym0 + sF :: forall arg. Sing arg -> Sing (Apply FSym0 arg) + sF SMyProxy + = let + sX :: Sing Let0123456789876543210XSym0 + sX + = let + sZ :: forall a. Sing (Let0123456789876543210ZSym0 :: MyProxy a) + sZ = SMyProxy + in sZ + in sX + instance SingI FSym0 where + sing = (singFun1 @FSym0) sF + data instance Sing :: MyProxy a -> Type + where SMyProxy :: Sing MyProxy + type SMyProxy = (Sing :: MyProxy a -> Type) + instance SingKind a => SingKind (MyProxy a) where + type Demote (MyProxy a) = MyProxy (Demote a) + fromSing SMyProxy = MyProxy + toSing MyProxy = SomeSing SMyProxy + instance SingI MyProxy where + sing = SMyProxy diff --git a/tests/compile-and-dump/Singletons/T297.hs b/tests/compile-and-dump/Singletons/T297.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T297.hs @@ -0,0 +1,13 @@ +module T297 where + +import Data.Kind +import Data.Singletons.TH + +$(singletons [d| + data MyProxy (a :: Type) = MyProxy + + f MyProxy = + let x = let z :: MyProxy a -- When singled, this `a` should be explicitly quantified + z = MyProxy in z + in x + |]) diff --git a/tests/compile-and-dump/Singletons/T312.ghc86.template b/tests/compile-and-dump/Singletons/T312.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T312.ghc86.template @@ -0,0 +1,215 @@ +Singletons/T312.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class Foo a where + bar :: a -> b -> b + bar _ x = x + baz :: forall b. a -> b -> b + baz + = h + where + h :: forall c. c -> b -> b + h _ x = x |] + ======> + class Foo a where + bar :: a -> b -> b + baz :: forall b. a -> b -> b + bar _ x = x + baz + = h + where + h :: forall c. c -> b -> b + h _ x = x + type BarSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Bar arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (BarSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) + data BarSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + BarSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (BarSym1 arg0123456789876543210) arg) (BarSym2 arg0123456789876543210 arg) => + BarSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (BarSym1 arg0123456789876543210) arg0123456789876543210 = Bar arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + BarSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 arg0123456789876543210 + type instance Apply BarSym0 arg0123456789876543210 = BarSym1 arg0123456789876543210 + type BazSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Baz arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings (BazSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) + data BazSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + BazSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (BazSym1 arg0123456789876543210) arg) (BazSym2 arg0123456789876543210 arg) => + BazSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (BazSym1 arg0123456789876543210) arg0123456789876543210 = Baz arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) + data BazSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + BazSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0 arg0123456789876543210 + type instance Apply BazSym0 arg0123456789876543210 = BazSym1 arg0123456789876543210 + type family Bar_0123456789876543210 (a :: a) (a :: b) :: b where + Bar_0123456789876543210 _ x = x + type Bar_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Bar_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Bar_0123456789876543210Sym1KindInference) ()) + data Bar_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Bar_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Bar_0123456789876543210Sym1 a0123456789876543210) arg) (Bar_0123456789876543210Sym2 a0123456789876543210 arg) => + Bar_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Bar_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Bar_0123456789876543210Sym0KindInference) ()) + data Bar_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Bar_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) => + Bar_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210 + type Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210HSym3KindInference) ()) + data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Let0123456789876543210HSym3KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) => + Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210H a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210HSym2KindInference) ()) + data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: forall b0123456789876543210 + c0123456789876543210. + (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Let0123456789876543210HSym2KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210HSym1KindInference) ()) + data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Let0123456789876543210HSym1KindInference :: forall a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 arg) => + Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210HSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210HSym0KindInference) ()) + data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 + where + Let0123456789876543210HSym0KindInference :: forall a_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) => + Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 + type family Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 (a :: c) (a :: b) :: b where + Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 _ x = x + type family Baz_0123456789876543210 (a :: a) (a :: b) :: b where + Baz_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 + type Baz_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Baz_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Baz_0123456789876543210Sym1KindInference) ()) + data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Baz_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Baz_0123456789876543210Sym1 a0123456789876543210) arg) (Baz_0123456789876543210Sym2 a0123456789876543210 arg) => + Baz_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Baz_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Baz_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Baz_0123456789876543210Sym0KindInference) ()) + data Baz_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Baz_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Baz_0123456789876543210Sym0 arg) (Baz_0123456789876543210Sym1 arg) => + Baz_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Baz_0123456789876543210Sym0 a0123456789876543210 = Baz_0123456789876543210Sym1 a0123456789876543210 + class PFoo (a :: GHC.Types.Type) where + type Bar (arg :: a) (arg :: b) :: b + type Baz (arg :: a) (arg :: b) :: b + type Bar a a = Apply (Apply Bar_0123456789876543210Sym0 a) a + type Baz a a = Apply (Apply Baz_0123456789876543210Sym0 a) a + class SFoo a where + sBar :: + forall b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b) + sBaz :: + forall b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b) + default sBar :: + forall b (t :: a) (t :: b). + (Apply (Apply BarSym0 t) t :: b) + ~ Apply (Apply Bar_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b) + default sBaz :: + forall b (t :: a) (t :: b). + (Apply (Apply BazSym0 t) t :: b) + ~ Apply (Apply Baz_0123456789876543210Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b) + sBar _ (sX :: Sing x) = sX + sBaz + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing + (let + sH :: + forall c (t :: c) (t :: b). + Sing t + -> Sing t + -> Sing (Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) t) t :: b) + sH _ (sX :: Sing x) = sX + in + (singFun2 + @(Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210)) + sH)) + sA_0123456789876543210)) + sA_0123456789876543210 + instance SFoo a => SingI (BarSym0 :: (~>) a ((~>) b b)) where + sing = (singFun2 @BarSym0) sBar + instance (SFoo a, SingI d) => + SingI (BarSym1 (d :: a) :: (~>) b b) where + sing = (singFun1 @(BarSym1 (d :: a))) (sBar (sing @d)) + instance SFoo a => SingI (BazSym0 :: (~>) a ((~>) b b)) where + sing = (singFun2 @BazSym0) sBaz + instance (SFoo a, SingI d) => + SingI (BazSym1 (d :: a) :: (~>) b b) where + sing = (singFun1 @(BazSym1 (d :: a))) (sBaz (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T312.hs b/tests/compile-and-dump/Singletons/T312.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T312.hs @@ -0,0 +1,14 @@ +module T312 where + +import Data.Singletons.TH + +$(singletons [d| + class Foo a where + bar :: a -> b -> b + bar _ x = x + + baz :: forall b. a -> b -> b + baz = h where + h :: forall c. c -> b -> b + h _ x = x + |]) diff --git a/tests/compile-and-dump/Singletons/T313.ghc86.template b/tests/compile-and-dump/Singletons/T313.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T313.ghc86.template @@ -0,0 +1,130 @@ +Singletons/T313.hs:(0,0)-(0,0): Splicing declarations + promote + [d| type PFoo1 a = Maybe a + type family PFoo2 a + type family PFoo3 a where + PFoo3 a = Maybe a + class PC (a :: Type) where + type PFoo4 a + type PFoo4 a = Maybe a + + type instance PFoo2 a = Maybe a + instance PC a where + type PFoo4 a = Maybe a |] + ======> + type PFoo1 a = Maybe a + type family PFoo2 a + type instance PFoo2 a = Maybe a + type family PFoo3 a where + PFoo3 a = Maybe a + class PC (a :: Type) where + type PFoo4 a + type PFoo4 a = Maybe a + instance PC a where + type PFoo4 a = Maybe a + type PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210 + instance SuppressUnusedWarnings PFoo1Sym0 where + suppressUnusedWarnings = snd (((,) PFoo1Sym0KindInference) ()) + data PFoo1Sym0 a0123456789876543210 + where + PFoo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) => + PFoo1Sym0 a0123456789876543210 + type instance Apply PFoo1Sym0 a0123456789876543210 = PFoo1 a0123456789876543210 + type PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210 + instance SuppressUnusedWarnings PFoo3Sym0 where + suppressUnusedWarnings = snd (((,) PFoo3Sym0KindInference) ()) + data PFoo3Sym0 a0123456789876543210 + where + PFoo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) => + PFoo3Sym0 a0123456789876543210 + type instance Apply PFoo3Sym0 a0123456789876543210 = PFoo3 a0123456789876543210 + type PFoo2Sym1 (a0123456789876543210 :: Type) = + PFoo2 a0123456789876543210 + instance SuppressUnusedWarnings PFoo2Sym0 where + suppressUnusedWarnings = snd (((,) PFoo2Sym0KindInference) ()) + data PFoo2Sym0 :: (~>) Type Type + where + PFoo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) => + PFoo2Sym0 a0123456789876543210 + type instance Apply PFoo2Sym0 a0123456789876543210 = PFoo2 a0123456789876543210 + type PFoo4Sym1 (a0123456789876543210 :: Type) = + PFoo4 a0123456789876543210 + instance SuppressUnusedWarnings PFoo4Sym0 where + suppressUnusedWarnings = snd (((,) PFoo4Sym0KindInference) ()) + data PFoo4Sym0 :: (~>) Type Type + where + PFoo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) => + PFoo4Sym0 a0123456789876543210 + type instance Apply PFoo4Sym0 a0123456789876543210 = PFoo4 a0123456789876543210 + class PPC (a :: Type) + instance PPC a +Singletons/T313.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| type SFoo1 a = Maybe a + type family SFoo2 a + type family SFoo3 a where + SFoo3 a = Maybe a + class SC (a :: Type) where + type SFoo4 a + type SFoo4 a = Maybe a + + type instance SFoo2 a = Maybe a + instance SC a where + type SFoo4 a = Maybe a |] + ======> + type SFoo1 a = Maybe a + type family SFoo2 a + type instance SFoo2 a = Maybe a + type family SFoo3 a where + SFoo3 a = Maybe a + class SC (a :: Type) where + type SFoo4 a + type SFoo4 a = Maybe a + instance SC a where + type SFoo4 a = Maybe a + type SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210 + instance SuppressUnusedWarnings SFoo1Sym0 where + suppressUnusedWarnings = snd (((,) SFoo1Sym0KindInference) ()) + data SFoo1Sym0 a0123456789876543210 + where + SFoo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) => + SFoo1Sym0 a0123456789876543210 + type instance Apply SFoo1Sym0 a0123456789876543210 = SFoo1 a0123456789876543210 + type SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210 + instance SuppressUnusedWarnings SFoo3Sym0 where + suppressUnusedWarnings = snd (((,) SFoo3Sym0KindInference) ()) + data SFoo3Sym0 a0123456789876543210 + where + SFoo3Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) => + SFoo3Sym0 a0123456789876543210 + type instance Apply SFoo3Sym0 a0123456789876543210 = SFoo3 a0123456789876543210 + type SFoo2Sym1 (a0123456789876543210 :: Type) = + SFoo2 a0123456789876543210 + instance SuppressUnusedWarnings SFoo2Sym0 where + suppressUnusedWarnings = snd (((,) SFoo2Sym0KindInference) ()) + data SFoo2Sym0 :: (~>) Type Type + where + SFoo2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) => + SFoo2Sym0 a0123456789876543210 + type instance Apply SFoo2Sym0 a0123456789876543210 = SFoo2 a0123456789876543210 + type SFoo4Sym1 (a0123456789876543210 :: Type) = + SFoo4 a0123456789876543210 + instance SuppressUnusedWarnings SFoo4Sym0 where + suppressUnusedWarnings = snd (((,) SFoo4Sym0KindInference) ()) + data SFoo4Sym0 :: (~>) Type Type + where + SFoo4Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) => + SFoo4Sym0 a0123456789876543210 + type instance Apply SFoo4Sym0 a0123456789876543210 = SFoo4 a0123456789876543210 + class PSC (a :: Type) + instance PSC a + class SSC (a :: Type) + instance SSC a diff --git a/tests/compile-and-dump/Singletons/T313.hs b/tests/compile-and-dump/Singletons/T313.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T313.hs @@ -0,0 +1,38 @@ +module T313 where + +import Data.Kind +import Data.Singletons.TH + +$(promote [d| + type PFoo1 a = Maybe a + + type family PFoo2 a + type instance PFoo2 a = Maybe a + + type family PFoo3 a where + PFoo3 a = Maybe a + + class PC (a :: Type) where + type PFoo4 a + type PFoo4 a = Maybe a + + instance PC a where + type PFoo4 a = Maybe a + |]) + +$(singletons [d| + type SFoo1 a = Maybe a + + type family SFoo2 a + type instance SFoo2 a = Maybe a + + type family SFoo3 a where + SFoo3 a = Maybe a + + class SC (a :: Type) where + type SFoo4 a + type SFoo4 a = Maybe a + + instance SC a where + type SFoo4 a = Maybe a + |]) diff --git a/tests/compile-and-dump/Singletons/T316.ghc86.template b/tests/compile-and-dump/Singletons/T316.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T316.ghc86.template @@ -0,0 +1,40 @@ +Singletons/T316.hs:(0,0)-(0,0): Splicing declarations + promoteOnly + [d| replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] + replaceAllGTypes f types as = zipWith f as types |] + ======> + type ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a0123456789876543210]) = + ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ReplaceAllGTypesSym2KindInference) ()) + data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) :: (~>) [a0123456789876543210] [a0123456789876543210] + where + ReplaceAllGTypesSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) => + ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) ReplaceAllGTypesSym1KindInference) ()) + data ReplaceAllGTypesSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) :: (~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210]) + where + ReplaceAllGTypesSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) => + ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where + suppressUnusedWarnings + = snd (((,) ReplaceAllGTypesSym0KindInference) ()) + data ReplaceAllGTypesSym0 :: forall a0123456789876543210. + (~>) ((~>) a0123456789876543210 ((~>) Type a0123456789876543210)) ((~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210])) + where + ReplaceAllGTypesSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) => + ReplaceAllGTypesSym0 a0123456789876543210 + type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210 + type family ReplaceAllGTypes (a :: (~>) a ((~>) Type a)) (a :: [Type]) (a :: [a]) :: [a] where + ReplaceAllGTypes f types as = Apply (Apply (Apply ZipWithSym0 f) as) types diff --git a/tests/compile-and-dump/Singletons/T316.hs b/tests/compile-and-dump/Singletons/T316.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T316.hs @@ -0,0 +1,10 @@ +module T316 where + +import Data.Kind +import Data.Singletons.Prelude +import Data.Singletons.TH + +$(promoteOnly [d| + replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] + replaceAllGTypes f types as = zipWith f as types + |]) diff --git a/tests/compile-and-dump/Singletons/T322.ghc86.template b/tests/compile-and-dump/Singletons/T322.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T322.ghc86.template @@ -0,0 +1,49 @@ +Singletons/T322.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infixr 2 ! + + (!) :: Bool -> Bool -> Bool + (!) = (||) |] + ======> + (!) :: Bool -> Bool -> Bool + (!) = (||) + infixr 2 ! + type (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = + (:!) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:!@#@$$###)) ()) + data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool + where + (:!@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) => + (!@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (:!) a0123456789876543210 a0123456789876543210 + infixr 2 !@#@$$ + instance SuppressUnusedWarnings (!@#@$) where + suppressUnusedWarnings = snd (((,) (:!@#@$###)) ()) + data (!@#@$) :: (~>) Bool ((~>) Bool Bool) + where + (:!@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => + (!@#@$) a0123456789876543210 + type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 + infixr 2 !@#@$ + type family (:!) (a :: Bool) (a :: Bool) :: Bool where + (:!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210 + infixr 2 :! + infixr 2 %! + (%!) :: + forall (t :: Bool) (t :: Bool). + Sing t -> Sing t -> Sing (Apply (Apply (!@#@$) t) t :: Bool) + (%!) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((applySing ((singFun2 @(||@#@$)) (%||))) sA_0123456789876543210)) + sA_0123456789876543210 + instance SingI ((!@#@$) :: (~>) Bool ((~>) Bool Bool)) where + sing = (singFun2 @(!@#@$)) (%!) + instance SingI d => + SingI ((!@#@$$) (d :: Bool) :: (~>) Bool Bool) where + sing = (singFun1 @((!@#@$$) (d :: Bool))) ((%!) (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T322.hs b/tests/compile-and-dump/Singletons/T322.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T322.hs @@ -0,0 +1,13 @@ +module T322 where + +import Data.Singletons.Prelude +import Data.Singletons.TH + +$(singletons [d| + (!) :: Bool -> Bool -> Bool + (!) = (||) + infixr 2 ! + |]) + +f1 :: (False && True :! True) :~: True +f1 = Refl diff --git a/tests/compile-and-dump/Singletons/T323.ghc86.template b/tests/compile-and-dump/Singletons/T323.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T323.ghc86.template diff --git a/tests/compile-and-dump/Singletons/T323.hs b/tests/compile-and-dump/Singletons/T323.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T323.hs @@ -0,0 +1,7 @@ +module T323 where + +import Data.Singletons.Prelude +import Data.Type.Equality + +test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h +test = Refl diff --git a/tests/compile-and-dump/Singletons/T33.ghc84.template b/tests/compile-and-dump/Singletons/T33.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T33.ghc84.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 '(_, _) = 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.ghc86.template b/tests/compile-and-dump/Singletons/T33.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T33.ghc86.template @@ -0,0 +1,36 @@ +Singletons/T33.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: (Bool, Bool) -> () + foo ~(_, _) = () |] + ======> + foo :: (Bool, Bool) -> () + foo ~(_, _) = () + type FooSym1 (a0123456789876543210 :: (Bool, Bool)) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) (Bool, Bool) () + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Foo (a :: (Bool, Bool)) :: () where + Foo '(_, _) = Tuple0Sym0 + sFoo :: + forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo (STuple2 _ _) = STuple0 + instance SingI (FooSym0 :: (~>) (Bool, Bool) ()) where + sing = (singFun1 @FooSym0) sFoo + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern in promotion + | +6 | $(singletons [d| + | ^^^^^^^^^^^^^^... + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern during singleton generation. + | +6 | $(singletons [d| + | ^^^^^^^^^^^^^^... diff --git a/tests/compile-and-dump/Singletons/T332.ghc86.template b/tests/compile-and-dump/Singletons/T332.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T332.ghc86.template @@ -0,0 +1,57 @@ +Singletons/T332.hs:(0,0)-(0,0): Splicing declarations + promote + [d| f :: Foo -> () + f MkFoo {} = () + + data Foo = MkFoo |] + ======> + data Foo = MkFoo + f :: Foo -> () + f MkFoo {} = () + type FSym1 (a0123456789876543210 :: Foo) = F a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 :: (~>) Foo () + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 + type family F (a :: Foo) :: () where + F MkFoo = Tuple0Sym0 + type MkFooSym0 = MkFoo +Singletons/T332.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| b :: Bar -> () + b MkBar {} = () + + data Bar = MkBar |] + ======> + data Bar = MkBar + b :: Bar -> () + b MkBar {} = () + type MkBarSym0 = MkBar + type BSym1 (a0123456789876543210 :: Bar) = B a0123456789876543210 + instance SuppressUnusedWarnings BSym0 where + suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) + data BSym0 :: (~>) Bar () + where + BSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BSym0 arg) (BSym1 arg) => + BSym0 a0123456789876543210 + type instance Apply BSym0 a0123456789876543210 = B a0123456789876543210 + type family B (a :: Bar) :: () where + B MkBar = Tuple0Sym0 + sB :: forall (t :: Bar). Sing t -> Sing (Apply BSym0 t :: ()) + sB SMkBar = STuple0 + instance SingI (BSym0 :: (~>) Bar ()) where + sing = (singFun1 @BSym0) sB + data instance Sing :: Bar -> GHC.Types.Type + where SMkBar :: Sing MkBar + type SBar = (Sing :: Bar -> GHC.Types.Type) + instance SingKind Bar where + type Demote Bar = Bar + fromSing SMkBar = MkBar + toSing MkBar = SomeSing SMkBar + instance SingI MkBar where + sing = SMkBar diff --git a/tests/compile-and-dump/Singletons/T332.hs b/tests/compile-and-dump/Singletons/T332.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T332.hs @@ -0,0 +1,17 @@ +module T332 where + +import Data.Singletons.TH + +$(promote [d| + data Foo = MkFoo + + f :: Foo -> () + f MkFoo{} = () + |]) + +$(singletons [d| + data Bar = MkBar + + b :: Bar -> () + b MkBar{} = () + |]) diff --git a/tests/compile-and-dump/Singletons/T342.ghc86.template b/tests/compile-and-dump/Singletons/T342.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T342.ghc86.template @@ -0,0 +1,17 @@ +Singletons/T342.hs:(0,0)-(0,0): Splicing declarations + do synName <- newName "MyId" + a <- newName "a" + let syn = TySynD synName [PlainTV a] (VarT a) + defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName] + pure $ syn : defuns + ======> + type MyId a = a + type MyIdSym1 a0123456789876543210 = MyId a0123456789876543210 + instance SuppressUnusedWarnings MyIdSym0 where + suppressUnusedWarnings = snd (((,) MyIdSym0KindInference) ()) + data MyIdSym0 a0123456789876543210 + where + MyIdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) => + MyIdSym0 a0123456789876543210 + type instance Apply MyIdSym0 a0123456789876543210 = MyId a0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T342.hs b/tests/compile-and-dump/Singletons/T342.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T342.hs @@ -0,0 +1,12 @@ +module T342 where + +import Data.Singletons.TH +import Language.Haskell.TH +import Language.Haskell.TH.Desugar + +$(do synName <- newName "MyId" + a <- newName "a" + let syn = TySynD synName [PlainTV a] (VarT a) + defuns <- withLocalDeclarations [syn] $ + genDefunSymbols [synName] + pure $ syn:defuns) diff --git a/tests/compile-and-dump/Singletons/T353.ghc86.template b/tests/compile-and-dump/Singletons/T353.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T353.ghc86.template @@ -0,0 +1,104 @@ +Singletons/T353.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (a :: Proxy (t :: k)) + :~: + (y :: Proxy (t :: k))) :: Type where + Symmetry a y _ = y :~: a |] + ======> + type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (:~:) (a :: Proxy (t :: k)) (y :: Proxy (t :: k))) :: Type where + Symmetry a y _ = (:~:) y a + type SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) = + Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) + data SymmetrySym2 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type + where + SymmetrySym2KindInference :: forall a0123456789876543210 + y0123456789876543210 + e0123456789876543210 + arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => + SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) + data SymmetrySym1 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: forall (y0123456789876543210 :: Proxy t0123456789876543210). + (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) + where + SymmetrySym1KindInference :: forall a0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => + SymmetrySym1 a0123456789876543210 y0123456789876543210 + type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings SymmetrySym0 where + suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) + data SymmetrySym0 :: forall k0123456789876543210 + (t0123456789876543210 :: k0123456789876543210) + (a0123456789876543210 :: Proxy t0123456789876543210) + (y0123456789876543210 :: Proxy t0123456789876543210). + (~>) (Proxy t0123456789876543210) ((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)) + where + SymmetrySym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => + SymmetrySym0 a0123456789876543210 + type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 +Singletons/T353.hs:0:0:: Splicing declarations + genDefunSymbols [''Prod] + ======> + type MkProdSym2 (t0123456789876543210 :: f0123456789876543210 p0123456789876543210) (t0123456789876543210 :: g0123456789876543210 p0123456789876543210) = + 'MkProd t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkProdSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkProdSym1KindInference) ()) + data MkProdSym1 (t0123456789876543210 :: (f0123456789876543210 :: k0123456789876543210 + -> Type) (p0123456789876543210 :: k0123456789876543210)) :: forall (g0123456789876543210 :: k0123456789876543210 + -> Type). + (~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 + -> Type) (g0123456789876543210 :: k0123456789876543210 + -> Type) (p0123456789876543210 :: k0123456789876543210)) + where + MkProdSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkProdSym1 t0123456789876543210) arg) (MkProdSym2 t0123456789876543210 arg) => + MkProdSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkProdSym1 t0123456789876543210) t0123456789876543210 = 'MkProd t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkProdSym0 where + suppressUnusedWarnings = snd (((,) MkProdSym0KindInference) ()) + data MkProdSym0 :: forall k0123456789876543210 + (f0123456789876543210 :: k0123456789876543210 -> Type) + (g0123456789876543210 :: k0123456789876543210 -> Type) + (p0123456789876543210 :: k0123456789876543210). + (~>) (f0123456789876543210 p0123456789876543210) ((~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 + -> Type) (g0123456789876543210 :: k0123456789876543210 + -> Type) (p0123456789876543210 :: k0123456789876543210))) + where + MkProdSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) => + MkProdSym0 t0123456789876543210 + type instance Apply MkProdSym0 t0123456789876543210 = MkProdSym1 t0123456789876543210 +Singletons/T353.hs:0:0:: Splicing declarations + genDefunSymbols [''Foo] + ======> + type MkFooSym2 (t0123456789876543210 :: Proxy a0123456789876543210) (t0123456789876543210 :: Proxy b0123456789876543210) = + 'MkFoo t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (MkFooSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkFooSym1KindInference) ()) + data MkFooSym1 (t0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) :: forall k0123456789876543210 + (b0123456789876543210 :: k0123456789876543210). + (~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210)) + where + MkFooSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkFooSym1 t0123456789876543210) arg) (MkFooSym2 t0123456789876543210 arg) => + MkFooSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkFooSym1 t0123456789876543210) t0123456789876543210 = 'MkFoo t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkFooSym0 where + suppressUnusedWarnings = snd (((,) MkFooSym0KindInference) ()) + data MkFooSym0 :: forall k0123456789876543210 + (a0123456789876543210 :: k0123456789876543210) + k0123456789876543210 + (b0123456789876543210 :: k0123456789876543210). + (~>) (Proxy a0123456789876543210) ((~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210))) + where + MkFooSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) => + MkFooSym0 t0123456789876543210 + type instance Apply MkFooSym0 t0123456789876543210 = MkFooSym1 t0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T353.hs b/tests/compile-and-dump/Singletons/T353.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T353.hs @@ -0,0 +1,17 @@ +module T353 where + +import Data.Kind +import Data.Proxy +import Data.Singletons.TH + +$(singletons [d| + type family Symmetry (a :: Proxy t) (y :: Proxy t) + (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where + Symmetry a y _ = y :~: a + |]) + +data Prod f g p = MkProd (f p) (g p) +$(genDefunSymbols [''Prod]) + +data Foo a b = MkFoo (Proxy a) (Proxy b) +$(genDefunSymbols [''Foo]) diff --git a/tests/compile-and-dump/Singletons/T358.ghc86.template b/tests/compile-and-dump/Singletons/T358.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T358.ghc86.template @@ -0,0 +1,116 @@ +Singletons/T358.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class C1 (f :: k -> Type) where + method1 :: f a + class C2 a where + method2a, method2b :: forall b. b -> a + + instance C1 [] where + method1 :: [a] + method1 = [] + instance C2 [a] where + method2a _ = [] + method2b :: forall b. b -> [a] + method2b _ = [] |] + ======> + class C1 (f :: k -> Type) where + method1 :: f a + instance C1 [] where + method1 :: [a] + method1 = [] + class C2 a where + method2a :: forall b. b -> a + method2b :: forall b. b -> a + instance C2 [a] where + method2b :: forall b. b -> [a] + method2a _ = [] + method2b _ = [] + type Method1Sym0 = Method1 + class PC1 (f :: k -> Type) where + type Method1 :: f a + type Method2aSym1 (arg0123456789876543210 :: b0123456789876543210) = + Method2a arg0123456789876543210 + instance SuppressUnusedWarnings Method2aSym0 where + suppressUnusedWarnings = snd (((,) Method2aSym0KindInference) ()) + data Method2aSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Method2aSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) => + Method2aSym0 arg0123456789876543210 + type instance Apply Method2aSym0 arg0123456789876543210 = Method2a arg0123456789876543210 + type Method2bSym1 (arg0123456789876543210 :: b0123456789876543210) = + Method2b arg0123456789876543210 + instance SuppressUnusedWarnings Method2bSym0 where + suppressUnusedWarnings = snd (((,) Method2bSym0KindInference) ()) + data Method2bSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Method2bSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) => + Method2bSym0 arg0123456789876543210 + type instance Apply Method2bSym0 arg0123456789876543210 = Method2b arg0123456789876543210 + class PC2 (a :: Type) where + type Method2a (arg :: b) :: a + type Method2b (arg :: b) :: a + type family Method1_0123456789876543210 :: [a] where + Method1_0123456789876543210 = '[] + type Method1_0123456789876543210Sym0 = Method1_0123456789876543210 + instance PC1 [] where + type Method1 = Method1_0123456789876543210Sym0 + type family Method2a_0123456789876543210 (a :: b) :: [a] where + Method2a_0123456789876543210 _ = '[] + type Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = + Method2a_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Method2a_0123456789876543210Sym0KindInference) ()) + data Method2a_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) b0123456789876543210 [a0123456789876543210] + where + Method2a_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Method2a_0123456789876543210Sym0 arg) (Method2a_0123456789876543210Sym1 arg) => + Method2a_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Method2a_0123456789876543210Sym0 a0123456789876543210 = Method2a_0123456789876543210 a0123456789876543210 + type family Method2b_0123456789876543210 (a :: b) :: [a] where + Method2b_0123456789876543210 _ = '[] + type Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = + Method2b_0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Method2b_0123456789876543210Sym0KindInference) ()) + data Method2b_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) b0123456789876543210 [a0123456789876543210] + where + Method2b_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Method2b_0123456789876543210Sym0 arg) (Method2b_0123456789876543210Sym1 arg) => + Method2b_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Method2b_0123456789876543210Sym0 a0123456789876543210 = Method2b_0123456789876543210 a0123456789876543210 + instance PC2 [a] where + type Method2a a = Apply Method2a_0123456789876543210Sym0 a + type Method2b a = Apply Method2b_0123456789876543210Sym0 a + class SC1 (f :: k -> Type) where + sMethod1 :: forall a. Sing (Method1Sym0 :: f a) + class SC2 a where + sMethod2a :: + forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: a) + sMethod2b :: + forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: a) + instance SC1 [] where + sMethod1 :: forall a. Sing (Method1Sym0 :: [a]) + sMethod1 = Data.Singletons.Prelude.Instances.SNil + instance SC2 [a] where + sMethod2a :: + forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: [a]) + sMethod2b :: + forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: [a]) + sMethod2a _ = Data.Singletons.Prelude.Instances.SNil + sMethod2b _ = Data.Singletons.Prelude.Instances.SNil + instance SC2 a => SingI (Method2aSym0 :: (~>) b a) where + sing = (singFun1 @Method2aSym0) sMethod2a + instance SC2 a => SingI (Method2bSym0 :: (~>) b a) where + sing = (singFun1 @Method2bSym0) sMethod2b diff --git a/tests/compile-and-dump/Singletons/T358.hs b/tests/compile-and-dump/Singletons/T358.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T358.hs @@ -0,0 +1,24 @@ +module T358 where + +import Data.Kind +import Data.Singletons.TH + +$(singletons [d| + class C1 (f :: k -> Type) where + method1 :: f a + + instance C1 [] where + method1 :: [a] + method1 = [] + + class C2 a where + method2a, method2b :: forall b. b -> a + + -- Test that variables bound by instance head aren't quantified by the + -- generated InstanceSigs + instance C2 [a] where + method2a _ = [] + + method2b :: forall b. b -> [a] + method2b _ = [] + |]) diff --git a/tests/compile-and-dump/Singletons/T54.ghc84.template b/tests/compile-and-dump/Singletons/T54.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T54.ghc84.template +++ /dev/null @@ -1,48 +0,0 @@ -Singletons/T54.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| g :: Bool -> Bool - g e = (case [not] of { [_] -> not }) e |] - ======> - g :: Bool -> Bool - g e = (case [not] of { [_] -> not }) e - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 t = - Let0123456789876543210Scrutinee_0123456789876543210 t - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((GHC.Tuple.(,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - GHC.Tuple.()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l - = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l - type family Let0123456789876543210Scrutinee_0123456789876543210 e where - Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[] - type family Case_0123456789876543210 e t where - Case_0123456789876543210 e '[_] = NotSym0 - type GSym1 (t :: Bool) = G t - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings - = snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) - data GSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0KindInference - type instance Apply GSym0 l = G l - type family G (a :: Bool) :: Bool where - G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e - sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) - sG (sE :: Sing e) - = (applySing - (let - sScrutinee_0123456789876543210 :: - Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) - sScrutinee_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((singFun1 @NotSym0) sNot))) - SNil - in case sScrutinee_0123456789876543210 of { - SCons _ SNil -> (singFun1 @NotSym0) sNot } :: - Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)))) - sE diff --git a/tests/compile-and-dump/Singletons/T54.ghc86.template b/tests/compile-and-dump/Singletons/T54.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T54.ghc86.template @@ -0,0 +1,53 @@ +Singletons/T54.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| g :: Bool -> Bool + g e = (case [not] of { [_] -> not }) e |] + ======> + g :: Bool -> Bool + g e = (case [not] of { [_] -> not }) e + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall e0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 + type family Let0123456789876543210Scrutinee_0123456789876543210 e where + Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[] + type family Case_0123456789876543210 e t where + Case_0123456789876543210 e '[_] = NotSym0 + type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) + data GSym0 :: (~>) Bool Bool + where + GSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0 a0123456789876543210 + type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 + type family G (a :: Bool) :: Bool where + G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sG (sE :: Sing e) + = (applySing + (let + sScrutinee_0123456789876543210 :: + Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) + sScrutinee_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((singFun1 @NotSym0) sNot))) + SNil + in (case sScrutinee_0123456789876543210 of { + SCons _ SNil -> (singFun1 @NotSym0) sNot }) :: + Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)))) + sE + instance SingI (GSym0 :: (~>) Bool Bool) where + sing = (singFun1 @GSym0) sG diff --git a/tests/compile-and-dump/Singletons/T78.ghc84.template b/tests/compile-and-dump/Singletons/T78.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/T78.ghc84.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.ghc86.template b/tests/compile-and-dump/Singletons/T78.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T78.ghc86.template @@ -0,0 +1,32 @@ +Singletons/T78.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False |] + ======> + foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False + type FooSym1 (a0123456789876543210 :: Maybe Bool) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) (Maybe Bool) Bool + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Foo (a :: Maybe Bool) :: Bool where + Foo ( 'Just 'False) = FalseSym0 + Foo ( 'Just 'True) = TrueSym0 + Foo 'Nothing = FalseSym0 + sFoo :: + forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sFoo (SJust SFalse) = SFalse + sFoo (SJust STrue) = STrue + sFoo SNothing = SFalse + instance SingI (FooSym0 :: (~>) (Maybe Bool) Bool) where + sing = (singFun1 @FooSym0) sFoo diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc84.template +++ /dev/null @@ -1,308 +0,0 @@ -Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data Bool = False | True - data Foo = Bar Bool Bool |] - ======> - data Bool = False | True - data Foo = Bar Bool Bool - type FalseSym0 = False - type TrueSym0 = True - type BarSym2 (t :: Bool) (t :: Bool) = Bar t t - instance SuppressUnusedWarnings BarSym1 where - suppressUnusedWarnings - = Data.Tuple.snd - ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.()) - data BarSym1 (l :: Bool) (l :: TyFun Bool Foo) - = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) => - BarSym1KindInference - type instance Apply (BarSym1 l) l = Bar l l - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = Data.Tuple.snd - ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.()) - data BarSym0 (l :: TyFun Bool (TyFun Bool Foo -> GHC.Types.Type)) - = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0KindInference - type instance Apply BarSym0 l = BarSym1 l - data instance Sing (z :: Bool) - where - SFalse :: Sing False - STrue :: Sing True - type SBool = (Sing :: Bool -> GHC.Types.Type) - instance SingKind Bool where - type Demote Bool = Bool - fromSing SFalse = False - fromSing STrue = True - toSing False = SomeSing SFalse - toSing True = SomeSing STrue - data instance Sing (z :: Foo) - where - SBar :: forall (n :: Bool) (n :: Bool). - (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Bar n n) - type SFoo = (Sing :: Foo -> GHC.Types.Type) - instance SingKind Foo where - type Demote Foo = Foo - fromSing (SBar b b) = (Bar (fromSing b)) (fromSing b) - toSing (Bar (b :: Demote Bool) (b :: Demote Bool)) - = case - (GHC.Tuple.(,) (toSing b :: SomeSing Bool)) - (toSing b :: SomeSing Bool) - of { - GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SBar c) c) } - instance SingI False where - sing = SFalse - instance SingI True where - sing = STrue - instance (SingI n, SingI n) => - SingI (Bar (n :: Bool) (n :: Bool)) where - sing = (SBar sing) sing -Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| otherwise :: Bool - otherwise = True - id :: a -> a - id x = x - not :: Bool -> Bool - not True = False - not False = True - false_ = False - f, g :: Bool -> Bool - [f, g] = [not, id] - h, i :: Bool -> Bool - (h, i) = (f, g) - j, k :: Bool - (Bar j k) = Bar True (h False) - l, m :: Bool - [l, m] = [not True, id False] |] - ======> - otherwise :: Bool - otherwise = True - id :: a -> a - id x = x - not :: Bool -> Bool - not True = False - not False = True - false_ = False - f :: Bool -> Bool - g :: Bool -> Bool - [f, g] = [not, id] - h :: Bool -> Bool - i :: Bool -> Bool - (h, i) = (f, g) - j :: Bool - k :: Bool - Bar j k = (Bar True) (h False) - l :: Bool - m :: Bool - [l, m] = [not True, id False] - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, - _] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[_, - y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, - _) = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(_, - y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Bar y_0123456789876543210 _) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 (Bar _ y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[y_0123456789876543210, - _] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - y_0123456789876543210] = y_0123456789876543210 - type False_Sym0 = False_ - type NotSym1 (t :: Bool) = Not t - instance SuppressUnusedWarnings NotSym0 where - suppressUnusedWarnings - = Data.Tuple.snd - ((GHC.Tuple.(,) NotSym0KindInference) GHC.Tuple.()) - data NotSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => - NotSym0KindInference - type instance Apply NotSym0 l = Not l - type IdSym1 (t :: a0123456789876543210) = Id t - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.()) - data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210) - = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0KindInference - type instance Apply IdSym0 l = Id l - type FSym1 (t :: Bool) = F t - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.()) - data FSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0KindInference - type instance Apply FSym0 l = F l - type GSym1 (t :: Bool) = G t - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.()) - data GSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0KindInference - type instance Apply GSym0 l = G l - type HSym1 (t :: Bool) = H t - instance SuppressUnusedWarnings HSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((GHC.Tuple.(,) HSym0KindInference) GHC.Tuple.()) - data HSym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply HSym0 arg) (HSym1 arg) => - HSym0KindInference - type instance Apply HSym0 l = H l - type ISym1 (t :: Bool) = I t - instance SuppressUnusedWarnings ISym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((GHC.Tuple.(,) ISym0KindInference) GHC.Tuple.()) - data ISym0 (l :: TyFun Bool Bool) - = forall arg. SameKind (Apply ISym0 arg) (ISym1 arg) => - ISym0KindInference - type instance Apply ISym0 l = I l - type JSym0 = J - type KSym0 = K - type LSym0 = L - type MSym0 = M - type OtherwiseSym0 = Otherwise - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type family False_ where - False_ = FalseSym0 - type family Not (a :: Bool) :: Bool where - Not True = FalseSym0 - Not False = TrueSym0 - type family Id (a :: a) :: a where - Id x = x - type family F (a :: Bool) :: Bool where - F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family G (a :: Bool) :: Bool where - G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family H (a :: Bool) :: Bool where - H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family I (a :: Bool) :: Bool where - I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family J :: Bool where - J = Case_0123456789876543210 X_0123456789876543210Sym0 - type family K :: Bool where - K = Case_0123456789876543210 X_0123456789876543210Sym0 - type family L :: Bool where - L = Case_0123456789876543210 X_0123456789876543210Sym0 - type family M :: Bool where - M = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Otherwise :: Bool where - Otherwise = TrueSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) - sFalse_ :: Sing False_Sym0 - sNot :: - forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) - sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) - sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) - sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) - sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) - sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) - sJ :: Sing (JSym0 :: Bool) - sK :: Sing (KSym0 :: Bool) - sL :: Sing (LSym0 :: Bool) - sM :: Sing (MSym0 :: Bool) - sOtherwise :: Sing (OtherwiseSym0 :: Bool) - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sFalse_ = SFalse - sNot STrue = SFalse - sNot SFalse = STrue - sId (sX :: Sing x) = sX - sF (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sG (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sH (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sI (sA_0123456789876543210 :: Sing a_0123456789876543210) - = (applySing - (case sX_0123456789876543210 of { - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) - sA_0123456789876543210 - sJ - = case sX_0123456789876543210 of { - SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sK - = case sX_0123456789876543210 of { - SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sL - = case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sM - = case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210 } :: - Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) - sOtherwise = STrue - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((singFun1 @NotSym0) sNot))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId))) - SNil) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - ((singFun1 @FSym0) sF))) - ((singFun1 @GSym0) sG) - sX_0123456789876543210 - = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) - ((applySing ((singFun1 @HSym0) sH)) SFalse) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @NotSym0) sNot)) STrue))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @IdSym0) sId)) SFalse))) - SNil) diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template @@ -0,0 +1,347 @@ +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Bool = False | True + data Foo = Bar Bool Bool |] + ======> + data Bool = False | True + data Foo = Bar Bool Bool + type FalseSym0 = False + type TrueSym0 = True + type BarSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + Bar t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where + suppressUnusedWarnings + = Data.Tuple.snd (((,) BarSym1KindInference) ()) + data BarSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo + where + BarSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => + BarSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bool ((~>) Bool Foo) + where + BarSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 t0123456789876543210 + type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 + data instance Sing :: Bool -> GHC.Types.Type + where + SFalse :: Sing False + STrue :: Sing True + type SBool = (Sing :: Bool -> GHC.Types.Type) + instance SingKind Bool where + type Demote Bool = Bool + fromSing SFalse = False + fromSing STrue = True + toSing False = SomeSing SFalse + toSing True = SomeSing STrue + data instance Sing :: Foo -> GHC.Types.Type + where + SBar :: forall (n :: Bool) (n :: Bool). + (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Bar n n) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind Foo where + type Demote Foo = Foo + fromSing (SBar b b) = (Bar (fromSing b)) (fromSing b) + toSing (Bar (b :: Demote Bool) (b :: Demote Bool)) + = case + ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) + of { + (,) (SomeSing c) (SomeSing c) -> SomeSing ((SBar c) c) } + instance SingI False where + sing = SFalse + instance SingI True where + sing = STrue + instance (SingI n, SingI n) => + SingI (Bar (n :: Bool) (n :: Bool)) where + sing = (SBar sing) sing + instance SingI (BarSym0 :: (~>) Bool ((~>) Bool Foo)) where + sing = (singFun2 @BarSym0) SBar + instance SingI (TyCon2 Bar :: (~>) Bool ((~>) Bool Foo)) where + sing = (singFun2 @(TyCon2 Bar)) SBar + instance SingI d => + SingI (BarSym1 (d :: Bool) :: (~>) Bool Foo) where + sing = (singFun1 @(BarSym1 (d :: Bool))) (SBar (sing @d)) + instance SingI d => + SingI (TyCon1 (Bar (d :: Bool)) :: (~>) Bool Foo) where + sing = (singFun1 @(TyCon1 (Bar (d :: Bool)))) (SBar (sing @d)) +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| otherwise :: Bool + otherwise = True + id :: a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f, g :: Bool -> Bool + [f, g] = [not, id] + h, i :: Bool -> Bool + (h, i) = (f, g) + j, k :: Bool + (Bar j k) = Bar True (h False) + l, m :: Bool + [l, m] = [not True, id False] |] + ======> + otherwise :: Bool + otherwise = True + id :: a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f :: Bool -> Bool + g :: Bool -> Bool + [f, g] = [not, id] + h :: Bool -> Bool + i :: Bool -> Bool + (h, i) = (f, g) + j :: Bool + k :: Bool + Bar j k = (Bar True) (h False) + l :: Bool + m :: Bool + [l, m] = [not True, id False] + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, + _] = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(_, + y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Bar y_0123456789876543210 _) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Bar _ y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[y_0123456789876543210, + _] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 + type False_Sym0 = False_ + type NotSym1 (a0123456789876543210 :: Bool) = + Not a0123456789876543210 + instance SuppressUnusedWarnings NotSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) NotSym0KindInference) ()) + data NotSym0 :: (~>) Bool Bool + where + NotSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => + NotSym0 a0123456789876543210 + type instance Apply NotSym0 a0123456789876543210 = Not a0123456789876543210 + type IdSym1 (a0123456789876543210 :: a0123456789876543210) = + Id a0123456789876543210 + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) IdSym0KindInference) ()) + data IdSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + IdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => + IdSym0 a0123456789876543210 + type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 + type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) FSym0KindInference) ()) + data FSym0 :: (~>) Bool Bool + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 + type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) GSym0KindInference) ()) + data GSym0 :: (~>) Bool Bool + where + GSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0 a0123456789876543210 + type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 + type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 + instance SuppressUnusedWarnings HSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) HSym0KindInference) ()) + data HSym0 :: (~>) Bool Bool + where + HSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply HSym0 arg) (HSym1 arg) => + HSym0 a0123456789876543210 + type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210 + type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210 + instance SuppressUnusedWarnings ISym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) ISym0KindInference) ()) + data ISym0 :: (~>) Bool Bool + where + ISym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ISym0 arg) (ISym1 arg) => + ISym0 a0123456789876543210 + type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210 + type JSym0 = J + type KSym0 = K + type LSym0 = L + type MSym0 = M + type OtherwiseSym0 = Otherwise + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type family False_ where + False_ = FalseSym0 + type family Not (a :: Bool) :: Bool where + Not 'True = FalseSym0 + Not 'False = TrueSym0 + type family Id (a :: a) :: a where + Id x = x + type family F (a :: Bool) :: Bool where + F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family G (a :: Bool) :: Bool where + G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family H (a :: Bool) :: Bool where + H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family I (a :: Bool) :: Bool where + I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family J :: Bool where + J = Case_0123456789876543210 X_0123456789876543210Sym0 + type family K :: Bool where + K = Case_0123456789876543210 X_0123456789876543210Sym0 + type family L :: Bool where + L = Case_0123456789876543210 X_0123456789876543210Sym0 + type family M :: Bool where + M = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Otherwise :: Bool where + Otherwise = TrueSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) + sFalse_ :: Sing False_Sym0 + sNot :: + forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) + sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) + sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) + sJ :: Sing (JSym0 :: Bool) + sK :: Sing (KSym0 :: Bool) + sL :: Sing (LSym0 :: Bool) + sM :: Sing (MSym0 :: Bool) + sOtherwise :: Sing (OtherwiseSym0 :: Bool) + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sFalse_ = SFalse + sNot STrue = SFalse + sNot SFalse = STrue + sId (sX :: Sing x) = sX + sF (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((case sX_0123456789876543210 of { + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sG (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sH (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((case sX_0123456789876543210 of { + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sI (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (applySing + ((case sX_0123456789876543210 of { + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) + sA_0123456789876543210 + sJ + = (case sX_0123456789876543210 of { + SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sK + = (case sX_0123456789876543210 of { + SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sL + = (case sX_0123456789876543210 of { + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sM + = (case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + -> sY_0123456789876543210 }) :: + Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) + sOtherwise = STrue + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((singFun1 @NotSym0) sNot))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId))) + SNil) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + ((singFun1 @FSym0) sF))) + ((singFun1 @GSym0) sG) + sX_0123456789876543210 + = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) + ((applySing ((singFun1 @HSym0) sH)) SFalse) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @NotSym0) sNot)) STrue))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @IdSym0) sId)) SFalse))) + SNil) + instance SingI (NotSym0 :: (~>) Bool Bool) where + sing = (singFun1 @NotSym0) sNot + instance SingI (IdSym0 :: (~>) a a) where + sing = (singFun1 @IdSym0) sId + instance SingI (FSym0 :: (~>) Bool Bool) where + sing = (singFun1 @FSym0) sF + instance SingI (GSym0 :: (~>) Bool Bool) where + sing = (singFun1 @GSym0) sG + instance SingI (HSym0 :: (~>) Bool Bool) where + sing = (singFun1 @HSym0) sH + instance SingI (ISym0 :: (~>) Bool Bool) where + sing = (singFun1 @ISym0) sI diff --git a/tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template b/tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template diff --git a/tests/compile-and-dump/Singletons/TypeRepTYPE.hs b/tests/compile-and-dump/Singletons/TypeRepTYPE.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/TypeRepTYPE.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE MagicHash #-} +module TypeRepTYPE where + +import Data.Kind (Type) +import Data.Singletons.Decide +import Data.Singletons.Prelude +import Data.Singletons.TypeRepTYPE +import GHC.Exts (Char#, RuntimeRep(..), TYPE, Word#) +import Type.Reflection (Typeable, typeRep) + +eqTYPETest1 :: (Type == Type) :~: 'True +eqTYPETest1 = Refl + +eqTYPETest2 :: (Type == TYPE 'IntRep) :~: 'False +eqTYPETest2 = Refl + +f :: Sing (a :: Type) -> Maybe a +f tr + | Proved Refl <- tr %~ sing @Bool + = Just True + | Proved Refl <- tr %~ sing @Ordering + = Just EQ + | otherwise + = Nothing + +data MaybeWordRep (a :: TYPE 'WordRep) + = NothingWordRep + | JustWordRep a + +g :: Sing (a :: TYPE 'WordRep) -> MaybeWordRep a +g tr + | Proved Refl <- tr %~ sing @Word# + = JustWordRep 42## + | Proved Refl <- tr %~ sing @Char# + = JustWordRep 'j'# + | otherwise + = NothingWordRep + +h :: forall (rep :: RuntimeRep) (a :: TYPE rep). Typeable a => Sing a +h = STypeRep (typeRep @a) diff --git a/tests/compile-and-dump/Singletons/Undef.ghc84.template b/tests/compile-and-dump/Singletons/Undef.ghc84.template deleted file mode 100644 --- a/tests/compile-and-dump/Singletons/Undef.ghc84.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 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.ghc86.template b/tests/compile-and-dump/Singletons/Undef.ghc86.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Undef.ghc86.template @@ -0,0 +1,47 @@ +Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" |] + ======> + foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" + type BarSym1 (a0123456789876543210 :: Bool) = + Bar a0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bool Bool + where + BarSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 a0123456789876543210 + type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) + data FooSym0 :: (~>) Bool Bool + where + FooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => + FooSym0 a0123456789876543210 + type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 + type family Bar (a :: Bool) :: Bool where + Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 + type family Foo (a :: Bool) :: Bool where + Foo a_0123456789876543210 = Apply UndefinedSym0 a_0123456789876543210 + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBar (sA_0123456789876543210 :: Sing a_0123456789876543210) + = (sError (sing :: Sing "urk")) sA_0123456789876543210 + sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210) + = sUndefined sA_0123456789876543210 + instance SingI (BarSym0 :: (~>) Bool Bool) where + sing = (singFun1 @BarSym0) sBar + instance SingI (FooSym0 :: (~>) Bool Bool) where + sing = (singFun1 @FooSym0) sFoo