singletons 2.5.1 → 3.0.4
raw patch · 270 files changed
Files
- CHANGES.md +318/−2
- LICENSE +1/−1
- README.md +18/−761
- Setup.hs +1/−137
- singletons.cabal +46/−123
- src/Data/Singletons.hs +1336/−164
- src/Data/Singletons/CustomStar.hs +0/−151
- src/Data/Singletons/Decide.hs +46/−15
- src/Data/Singletons/Deriving/Bounded.hs +0/−59
- src/Data/Singletons/Deriving/Enum.hs +0/−55
- src/Data/Singletons/Deriving/Foldable.hs +0/−99
- src/Data/Singletons/Deriving/Functor.hs +0/−95
- src/Data/Singletons/Deriving/Infer.hs +0/−163
- src/Data/Singletons/Deriving/Ord.hs +0/−71
- src/Data/Singletons/Deriving/Show.hs +0/−162
- src/Data/Singletons/Deriving/Traversable.hs +0/−69
- src/Data/Singletons/Deriving/Util.hs +0/−313
- src/Data/Singletons/Internal.hs +0/−430
- src/Data/Singletons/Names.hs +0/−362
- src/Data/Singletons/Partition.hs +0/−306
- src/Data/Singletons/Prelude.hs +0/−279
- src/Data/Singletons/Prelude/Applicative.hs +0/−73
- src/Data/Singletons/Prelude/Base.hs +0/−115
- src/Data/Singletons/Prelude/Bool.hs +0/−108
- src/Data/Singletons/Prelude/Const.hs +0/−141
- src/Data/Singletons/Prelude/Either.hs +0/−112
- src/Data/Singletons/Prelude/Enum.hs +0/−137
- src/Data/Singletons/Prelude/Eq.hs +0/−90
- src/Data/Singletons/Prelude/Foldable.hs +0/−645
- src/Data/Singletons/Prelude/Function.hs +0/−119
- src/Data/Singletons/Prelude/Functor.hs +0/−206
- src/Data/Singletons/Prelude/Identity.hs +0/−114
- src/Data/Singletons/Prelude/Instances.hs +0/−34
- src/Data/Singletons/Prelude/IsString.hs +0/−59
- src/Data/Singletons/Prelude/List.hs +0/−296
- src/Data/Singletons/Prelude/List/Internal.hs +0/−670
- src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs +0/−169
- src/Data/Singletons/Prelude/List/NonEmpty.hs +0/−558
- src/Data/Singletons/Prelude/Maybe.hs +0/−129
- src/Data/Singletons/Prelude/Monad.hs +0/−293
- src/Data/Singletons/Prelude/Monad/Internal.hs +0/−519
- src/Data/Singletons/Prelude/Monad/Zip.hs +0/−106
- src/Data/Singletons/Prelude/Monoid.hs +0/−212
- src/Data/Singletons/Prelude/Num.hs +0/−145
- src/Data/Singletons/Prelude/Ord.hs +0/−115
- src/Data/Singletons/Prelude/Semigroup.hs +0/−307
- src/Data/Singletons/Prelude/Semigroup/Internal.hs +0/−280
- src/Data/Singletons/Prelude/Show.hs +0/−194
- src/Data/Singletons/Prelude/Traversable.hs +0/−286
- src/Data/Singletons/Prelude/Tuple.hs +0/−72
- src/Data/Singletons/Prelude/Void.hs +0/−55
- src/Data/Singletons/Promote.hs +0/−840
- src/Data/Singletons/Promote/Defun.hs +0/−532
- src/Data/Singletons/Promote/Eq.hs +0/−70
- src/Data/Singletons/Promote/Monad.hs +0/−188
- src/Data/Singletons/Promote/Type.hs +0/−64
- src/Data/Singletons/ShowSing.hs +193/−68
- src/Data/Singletons/Sigma.hs +193/−20
- src/Data/Singletons/Single.hs +0/−874
- src/Data/Singletons/Single/Data.hs +0/−181
- src/Data/Singletons/Single/Defun.hs +0/−213
- src/Data/Singletons/Single/Eq.hs +0/−120
- src/Data/Singletons/Single/Fixity.hs +0/−33
- src/Data/Singletons/Single/Monad.hs +0/−217
- src/Data/Singletons/Single/Type.hs +0/−69
- src/Data/Singletons/SuppressUnusedWarnings.hs +0/−18
- src/Data/Singletons/Syntax.hs +0/−237
- src/Data/Singletons/TH.hs +0/−192
- src/Data/Singletons/TypeError.hs +0/−188
- src/Data/Singletons/TypeLits.hs +0/−225
- src/Data/Singletons/TypeLits/Internal.hs +0/−231
- src/Data/Singletons/TypeRepTYPE.hs +0/−100
- src/Data/Singletons/Util.hs +0/−549
- tests/ByHand.hs +362/−138
- tests/ByHand2.hs +155/−63
- tests/SingletonsTestSuite.hs +4/−121
- tests/SingletonsTestSuiteUtils.hs +0/−205
- tests/compile-and-dump/GradingClient/Database.ghc86.template +0/−2610
- tests/compile-and-dump/GradingClient/Database.hs +0/−552
- tests/compile-and-dump/GradingClient/Main.ghc86.template +0/−123
- tests/compile-and-dump/GradingClient/Main.hs +0/−54
- tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template +0/−212
- tests/compile-and-dump/InsertionSort/InsertionSortImp.hs +0/−205
- tests/compile-and-dump/Promote/Constructors.ghc86.template +0/−79
- tests/compile-and-dump/Promote/Constructors.hs +0/−13
- tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template +0/−54
- tests/compile-and-dump/Promote/GenDefunSymbols.hs +0/−17
- tests/compile-and-dump/Promote/Newtypes.ghc86.template +0/−48
- tests/compile-and-dump/Promote/Newtypes.hs +0/−10
- tests/compile-and-dump/Promote/Pragmas.ghc86.template +0/−12
- tests/compile-and-dump/Promote/Pragmas.hs +0/−10
- tests/compile-and-dump/Promote/Prelude.ghc86.template +0/−19
- tests/compile-and-dump/Promote/Prelude.hs +0/−132
- tests/compile-and-dump/Promote/T180.ghc86.template +0/−54
- tests/compile-and-dump/Promote/T180.hs +0/−10
- tests/compile-and-dump/Promote/T361.ghc86.template +0/−21
- tests/compile-and-dump/Promote/T361.hs +0/−11
- tests/compile-and-dump/Singletons/AsPattern.ghc86.template +0/−405
- tests/compile-and-dump/Singletons/AsPattern.hs +0/−32
- tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.template +0/−6
- tests/compile-and-dump/Singletons/BadBoundedDeriving.hs +0/−7
- tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.template +0/−6
- tests/compile-and-dump/Singletons/BadEnumDeriving.hs +0/−8
- tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template +0/−249
- tests/compile-and-dump/Singletons/BoundedDeriving.hs +0/−52
- tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template +0/−54
- tests/compile-and-dump/Singletons/BoxUnBox.hs +0/−10
- tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template +0/−319
- tests/compile-and-dump/Singletons/CaseExpressions.hs +0/−66
- tests/compile-and-dump/Singletons/Classes.ghc86.template +0/−577
- tests/compile-and-dump/Singletons/Classes.hs +0/−98
- tests/compile-and-dump/Singletons/Classes2.ghc86.template +0/−91
- tests/compile-and-dump/Singletons/Classes2.hs +0/−22
- tests/compile-and-dump/Singletons/Contains.ghc86.template +0/−50
- tests/compile-and-dump/Singletons/Contains.hs +0/−13
- tests/compile-and-dump/Singletons/DataValues.ghc86.template +0/−186
- tests/compile-and-dump/Singletons/DataValues.hs +0/−20
- tests/compile-and-dump/Singletons/Empty.ghc86.template +0/−10
- tests/compile-and-dump/Singletons/Empty.hs +0/−7
- tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template +0/−68
- tests/compile-and-dump/Singletons/EmptyShowDeriving.hs +0/−7
- tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template +0/−199
- tests/compile-and-dump/Singletons/EnumDeriving.hs +0/−11
- tests/compile-and-dump/Singletons/EqInstances.ghc86.template +0/−21
- tests/compile-and-dump/Singletons/EqInstances.hs +0/−8
- tests/compile-and-dump/Singletons/Error.ghc86.template +0/−30
- tests/compile-and-dump/Singletons/Error.hs +0/−11
- tests/compile-and-dump/Singletons/Fixity.ghc86.template +0/−86
- tests/compile-and-dump/Singletons/Fixity.hs +0/−16
- tests/compile-and-dump/Singletons/FunDeps.ghc86.template +0/−96
- tests/compile-and-dump/Singletons/FunDeps.hs +0/−21
- tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template +0/−1646
- tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs +0/−17
- tests/compile-and-dump/Singletons/HigherOrder.ghc86.template +0/−480
- tests/compile-and-dump/Singletons/HigherOrder.hs +0/−57
- tests/compile-and-dump/Singletons/LambdaCase.ghc86.template +0/−252
- tests/compile-and-dump/Singletons/LambdaCase.hs +0/−39
- tests/compile-and-dump/Singletons/Lambdas.ghc86.template +0/−830
- tests/compile-and-dump/Singletons/Lambdas.hs +0/−94
- tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.template +0/−71
- tests/compile-and-dump/Singletons/LambdasComprehensive.hs +0/−29
- tests/compile-and-dump/Singletons/LetStatements.ghc86.template +0/−1002
- tests/compile-and-dump/Singletons/LetStatements.hs +0/−193
- tests/compile-and-dump/Singletons/Maybe.ghc86.template +0/−140
- tests/compile-and-dump/Singletons/Maybe.hs +0/−7
- tests/compile-and-dump/Singletons/Nat.ghc86.template +0/−266
- tests/compile-and-dump/Singletons/Nat.hs +0/−18
- tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/NatSymbolReflexive.hs +0/−11
- tests/compile-and-dump/Singletons/Operators.ghc86.template +0/−128
- tests/compile-and-dump/Singletons/Operators.hs +0/−20
- tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template +0/−1235
- tests/compile-and-dump/Singletons/OrdDeriving.hs +0/−58
- tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template +0/−35
- tests/compile-and-dump/Singletons/OverloadedStrings.hs +0/−13
- tests/compile-and-dump/Singletons/PatternMatching.ghc86.template +0/−574
- tests/compile-and-dump/Singletons/PatternMatching.hs +0/−51
- tests/compile-and-dump/Singletons/PolyKinds.ghc86.template +0/−28
- tests/compile-and-dump/Singletons/PolyKinds.hs +0/−8
- tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.template +0/−12
- tests/compile-and-dump/Singletons/PolyKindsApp.hs +0/−12
- tests/compile-and-dump/Singletons/Records.ghc86.template +0/−79
- tests/compile-and-dump/Singletons/Records.hs +0/−29
- tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template +0/−98
- tests/compile-and-dump/Singletons/ReturnFunc.hs +0/−23
- tests/compile-and-dump/Singletons/Sections.ghc86.template +0/−122
- tests/compile-and-dump/Singletons/Sections.hs +0/−40
- tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template +0/−582
- tests/compile-and-dump/Singletons/ShowDeriving.hs +0/−41
- tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template +0/−447
- tests/compile-and-dump/Singletons/StandaloneDeriving.hs +0/−30
- tests/compile-and-dump/Singletons/Star.ghc86.template +0/−422
- tests/compile-and-dump/Singletons/Star.hs +0/−13
- tests/compile-and-dump/Singletons/T124.ghc86.template +0/−33
- tests/compile-and-dump/Singletons/T124.hs +0/−13
- tests/compile-and-dump/Singletons/T136.ghc86.template +0/−171
- tests/compile-and-dump/Singletons/T136.hs +0/−35
- tests/compile-and-dump/Singletons/T136b.ghc86.template +0/−53
- tests/compile-and-dump/Singletons/T136b.hs +0/−14
- tests/compile-and-dump/Singletons/T145.ghc86.template +0/−39
- tests/compile-and-dump/Singletons/T145.hs +0/−9
- tests/compile-and-dump/Singletons/T153.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/T153.hs +0/−13
- tests/compile-and-dump/Singletons/T157.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/T157.hs +0/−6
- tests/compile-and-dump/Singletons/T159.ghc86.template +0/−245
- tests/compile-and-dump/Singletons/T159.hs +0/−27
- tests/compile-and-dump/Singletons/T160.ghc86.template +0/−85
- tests/compile-and-dump/Singletons/T160.hs +0/−13
- tests/compile-and-dump/Singletons/T163.ghc86.template +0/−51
- tests/compile-and-dump/Singletons/T163.hs +0/−5
- tests/compile-and-dump/Singletons/T166.ghc86.template +0/−139
- tests/compile-and-dump/Singletons/T166.hs +0/−20
- tests/compile-and-dump/Singletons/T167.ghc86.template +0/−178
- tests/compile-and-dump/Singletons/T167.hs +0/−26
- tests/compile-and-dump/Singletons/T172.ghc86.template +0/−40
- tests/compile-and-dump/Singletons/T172.hs +0/−18
- tests/compile-and-dump/Singletons/T175.ghc86.template +0/−45
- tests/compile-and-dump/Singletons/T175.hs +0/−28
- tests/compile-and-dump/Singletons/T176.ghc86.template +0/−166
- tests/compile-and-dump/Singletons/T176.hs +0/−29
- tests/compile-and-dump/Singletons/T178.ghc86.template +0/−210
- tests/compile-and-dump/Singletons/T178.hs +0/−15
- tests/compile-and-dump/Singletons/T183.ghc86.template +0/−512
- tests/compile-and-dump/Singletons/T183.hs +0/−65
- tests/compile-and-dump/Singletons/T184.ghc86.template +0/−499
- tests/compile-and-dump/Singletons/T184.hs +0/−26
- tests/compile-and-dump/Singletons/T187.ghc86.template +0/−57
- tests/compile-and-dump/Singletons/T187.hs +0/−8
- tests/compile-and-dump/Singletons/T190.ghc86.template +0/−188
- tests/compile-and-dump/Singletons/T190.hs +0/−12
- tests/compile-and-dump/Singletons/T197.ghc86.template +0/−43
- tests/compile-and-dump/Singletons/T197.hs +0/−10
- tests/compile-and-dump/Singletons/T197b.ghc86.template +0/−106
- tests/compile-and-dump/Singletons/T197b.hs +0/−10
- tests/compile-and-dump/Singletons/T200.ghc86.template +0/−204
- tests/compile-and-dump/Singletons/T200.hs +0/−15
- tests/compile-and-dump/Singletons/T206.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/T206.hs +0/−5
- tests/compile-and-dump/Singletons/T209.ghc86.template +0/−82
- tests/compile-and-dump/Singletons/T209.hs +0/−16
- tests/compile-and-dump/Singletons/T216.ghc86.template +0/−56
- tests/compile-and-dump/Singletons/T216.hs +0/−12
- tests/compile-and-dump/Singletons/T226.ghc86.template +0/−6
- tests/compile-and-dump/Singletons/T226.hs +0/−5
- tests/compile-and-dump/Singletons/T229.ghc86.template +0/−24
- tests/compile-and-dump/Singletons/T229.hs +0/−6
- tests/compile-and-dump/Singletons/T249.ghc86.template +0/−90
- tests/compile-and-dump/Singletons/T249.hs +0/−12
- tests/compile-and-dump/Singletons/T271.ghc86.template +0/−199
- tests/compile-and-dump/Singletons/T271.hs +0/−13
- tests/compile-and-dump/Singletons/T287.ghc86.template +0/−116
- tests/compile-and-dump/Singletons/T287.hs +0/−11
- tests/compile-and-dump/Singletons/T29.ghc86.template +0/−115
- tests/compile-and-dump/Singletons/T29.hs +0/−44
- tests/compile-and-dump/Singletons/T297.ghc86.template +0/−59
- tests/compile-and-dump/Singletons/T297.hs +0/−13
- tests/compile-and-dump/Singletons/T312.ghc86.template +0/−215
- tests/compile-and-dump/Singletons/T312.hs +0/−14
- tests/compile-and-dump/Singletons/T313.ghc86.template +0/−130
- tests/compile-and-dump/Singletons/T313.hs +0/−38
- tests/compile-and-dump/Singletons/T316.ghc86.template +0/−40
- tests/compile-and-dump/Singletons/T316.hs +0/−10
- tests/compile-and-dump/Singletons/T322.ghc86.template +0/−49
- tests/compile-and-dump/Singletons/T322.hs +0/−13
- tests/compile-and-dump/Singletons/T323.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/T323.hs +0/−7
- tests/compile-and-dump/Singletons/T33.ghc86.template +0/−36
- tests/compile-and-dump/Singletons/T33.hs +0/−9
- tests/compile-and-dump/Singletons/T332.ghc86.template +0/−57
- tests/compile-and-dump/Singletons/T332.hs +0/−17
- tests/compile-and-dump/Singletons/T342.ghc86.template +0/−17
- tests/compile-and-dump/Singletons/T342.hs +0/−12
- tests/compile-and-dump/Singletons/T353.ghc86.template +0/−104
- tests/compile-and-dump/Singletons/T353.hs +0/−17
- tests/compile-and-dump/Singletons/T358.ghc86.template +0/−118
- tests/compile-and-dump/Singletons/T358.hs +0/−24
- tests/compile-and-dump/Singletons/T371.ghc86.template +0/−233
- tests/compile-and-dump/Singletons/T371.hs +0/−16
- tests/compile-and-dump/Singletons/T54.ghc86.template +0/−53
- tests/compile-and-dump/Singletons/T54.hs +0/−12
- tests/compile-and-dump/Singletons/T78.ghc86.template +0/−32
- tests/compile-and-dump/Singletons/T78.hs +0/−13
- tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template +0/−347
- tests/compile-and-dump/Singletons/TopLevelPatterns.hs +0/−40
- tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template +0/−0
- tests/compile-and-dump/Singletons/TypeRepTYPE.hs +0/−40
- tests/compile-and-dump/Singletons/Undef.ghc86.template +0/−47
- tests/compile-and-dump/Singletons/Undef.hs +0/−12
- tests/compile-and-dump/buildGoldenFiles.awk +0/−1
CHANGES.md view
@@ -1,5 +1,321 @@-Changelog for singletons project-================================+Changelog for the `singletons` project+======================================++3.0.4 [2024.12.11]+------------------+* Define `Sing` instances such that they explicitly match on their types on the+ left-hand sides (e.g., define `type instance Sing @(k1 ~> k2) = SLambda`+ instead of `type instance Sing = SLambda`. Doing so will make `singletons`+ future-proof once+ [GHC#23515](https://gitlab.haskell.org/ghc/ghc/-/issues/23515) is fixed.++3.0.3 [2024.05.12]+------------------+* Allow building with GHC 9.10.++3.0.2 [2022.08.23]+------------------+* Allow building with GHC 9.4.+* When building with GHC 9.4 or later, use the new+ [`withDict`](https://hackage.haskell.org/package/ghc-prim-0.9.0/docs/GHC-Magic-Dict.html#v:withDict)+ primitive to implement `withSingI` instead of `unsafeCoerce`. This change+ should not have any consequences for user-facing code.++3.0.1 [2021.10.30]+------------------+* Add `SingI1` and `SingI2`, higher-order versions of `SingI`, to+ `Data.Singletons`, along with various derived functions:++ * `sing{1,2}`+ * `singByProxy{1,2}` and `singByProxy{1,2}#`+ * `usingSing{1,2}`+ * `withSing{1,2}`+ * `singThat{1,2}`++3.0 [2021.03.12]+----------------+* The `singletons` library has been split into three libraries:++ * The new `singletons` library is now a minimal library that only provides+ `Data.Singletons`, `Data.Singletons.Decide`, `Data.Singletons.Sigma`, and+ `Data.Singletons.ShowSing` (if compiled with GHC 8.6 or later).+ `singletons` now supports building GHCs back to GHC 8.0, as well as GHCJS.+ * The `singletons-th` library defines Template Haskell functionality for+ promoting and singling term-level definitions, but but nothing else. This+ library continues to require the latest stable release of GHC.+ * The `singletons-base` library defines promoted and singled versions of+ definitions from the `base` library, including the `Prelude`. This library+ continues to require the latest stable release of GHC.++ Consult the changelogs for `singletons-th` and `singletons-base` for changes+ specific to those libraries. For more information on this split, see the+ [relevant GitHub discussion](https://github.com/goldfirere/singletons/issues/420).+* The internals of `ShowSing` have been tweaked to make it possible to derive+ `Show` instances for singleton types, e.g.,++ ```hs+ deriving instance ShowSing a => Show (SList (z :: [a]))+ ```++ For the most part, this is a backwards-compatible change, although there+ exists at least one corner case where the new internals of `ShowSing` require+ extra work to play nicely with GHC's constraint solver. For more details,+ refer to the Haddocks for `ShowSing'` in `Data.Singletons.ShowSing`.++2.7+---+* Require GHC 8.10.+* Record selectors are now singled as top-level functions. For instance,+ `$(singletons [d| data T = MkT { unT :: Bool } |])` will now generate this:++ ```hs+ data ST :: T -> Type where+ SMkT :: Sing b -> Sing (MkT b)++ sUnT :: Sing (t :: T) -> Sing (UnT t :: Bool)+ sUnT (SMkT sb) = sb++ ...+ ```++ Instead of this:++ ```hs+ data ST :: T -> Type where+ SMkT :: { sUnT :: Sing b } -> Sing (MkT b)+ ```++ Note that the new type of `sUnT` is more general than the previous type+ (`Sing (MkT b) -> Sing b`).++ There are two primary reasons for this change:++ 1. Singling record selectors as top-level functions is consistent with how+ promoting records works (note that `MkT` is also a top-level function). As+ 2. Embedding record selectors directly into a singleton data constructor can+ result in surprising behavior. This can range from simple code using a+ record selector not typechecking to the inability to define multiple+ constructors that share the same record name.++ See [this GitHub issue](https://github.com/goldfirere/singletons/issues/364)+ for an extended discussion on the motivation behind this change.+* The Template Haskell machinery now supports fine-grained configuration in+ the way of an `Options` data type, which lives in the new+ `Data.Singletons.TH.Options` module. Besides `Options`, this module also+ contains:+ * `Options`' record selectors. Currently, these include options to toggle+ generating quoted declarations, toggle generating `SingKind` instances,+ and configure how `singletons` generates the names of promoted or singled+ types. In the future, there may be additional options.+ * A `defaultOptions` value.+ * An `mtl`-like `OptionsMonad` class for monads that support carrying+ `Option`s. This includes `Q`, which uses `defaultOptions` if it is the+ top of the monad transformer stack.+ * An `OptionM` monad transformer that turns any `DsMonad` into an+ `OptionsMonad`.+ * A `withOptions` function which allows passing `Options` to TH functions+ (e.g., `promote` or `singletons`). See the `README` for a full example+ of how to use `withOptions`.+ Most TH functions are now polymorphic over `OptionsMonad` instead of+ `DsMonad`.+* `singletons` now does a much better job of preserving the order of type+ variables in type signatures during promotion and singling. See the+ `Support for TypeApplications` section of the `README` for more details.++ When generating type-level declarations in particular (e.g., promoted type+ families or defunctionalization symbols), `singletons` will likely also+ generate standalone kind signatures to preserve type variable order. As a+ result, most `singletons` code that uses Template Haskell will require the+ use of the `StandaloneKindSignatures` extension (and, by extension, the+ `NoCUSKs` extension) to work.+* `singletons` now does a more much thorough job of rejecting higher-rank types+ during promotion or singling, as `singletons` cannot support them.+ (Previously, `singletons` would sometimes accept them, often changing rank-2+ types to rank-1 types incorrectly in the process.)+* Add the `Data.Singletons.Prelude.Proxy` module.+* Remove the promoted versions of `genericTake`, `genericDrop`,+ `genericSplitAt`, `genericIndex`, and `genericReplicate` from+ `Data.Singletons.Prelude.List`. These definitions were subtly wrong since+ (1) they claim to work over any `Integral` type `i`, but in practice would+ only work on `Nat`s, and (2) wouldn't even typecheck if they were singled.+* Export `ApplyTyConAux1`, `ApplyTyConAux2`, as well as the record pattern+ synonyms selector `applySing2`, `applySing3`, etc. from `Data.Singletons`.+ These were unintentionally left out in previous releases.+* Export promoted and singled versions of the `getDown` record selector in+ `Data.Singletons.Prelude.Ord`.+* Fix a slew of bugs related to fixity declarations:+ * Fixity declarations for data types are no longer singled, as fixity+ declarations do not serve any purpose for singled data type constructors,+ which always have exactly one argument.+ * `singletons` now promotes fixity declarations for class names.+ `genPromotions`/`genSingletons` now also handle fixity declarations for+ classes, class methods, data types, and record selectors correctly.+ * `singletons` will no longer erroneously try to single fixity declarations+ for type synonym or type family names.+ * A bug that caused fixity declarations for certain defunctionalization+ symbols not to be generated has been fixed.+ * `promoteOnly` and `singletonsOnly` will now produce fixity declarations+ for values with infix names.++2.6+---+* Require GHC 8.8.+* `Sing` has switched from a data family to a type family. This+ [GitHub issue comment](https://github.com/goldfirere/singletons/issues/318#issuecomment-467067257)+ provides a detailed explanation for the motivation behind this change.++ This has a number of consequences:+ * Names like `SBool`, `SMaybe`, etc. are no longer type synonyms for+ particular instantiations of `Sing` but are instead the names of the+ singleton data types themselves. In other words, previous versions of+ `singletons` would provide this:++ ```haskell+ data instance Sing :: Bool -> Type where+ SFalse :: Sing False+ STrue :: Sing True+ type SBool = (Sing :: Bool -> Type)+ ```++ Whereas with `Sing`-as-a-type-family, `singletons` now provides this:++ ```haskell+ data SBool :: Bool -> Type where+ SFalse :: SBool False+ STrue :: SBool True+ type instance Sing @Bool = SBool+ ```+ * The `Sing` instance for `TYPE rep` in `Data.Singletons.TypeRepTYPE` is now+ directly defined as `type instance Sing @(TYPE rep) = TypeRep`, without the+ use of an intermediate newtype as before.+ * Due to limitations in the ways that quantified constraints and type+ families can interact+ (see [this GHC issue](https://gitlab.haskell.org/ghc/ghc/issues/14860)),+ the internals of `ShowSing` has to be tweaked in order to continue to+ work with `Sing`-as-a-type-family. One notable consequence of this is+ that `Show` instances for singleton types can no longer be derived—they+ must be written by hand in order to work around+ [this GHC bug](https://gitlab.haskell.org/ghc/ghc/issues/16365).+ This is unlikely to affect you unless you define 'Show' instances for+ singleton types by hand. For more information, refer to the Haddocks for+ `ShowSing'` in `Data.Singletons.ShowSing`.+ * GHC does not permit type class instances to mention type families, which+ means that it is no longer possible to define instances that mention the+ `Sing` type constructor. For this reason, a `WrappedSing` data type (which+ is a newtype around `Sing`) was introduced so that one can hang instances+ off of it.++ This had one noticeable effect in `singletons`+ itself: there are no longer `TestEquality Sing` or `TestCoercion Sing`+ instances. Instead, `singletons` now generates a separate+ `TestEquality`/`TestCoercion` instance for every data type that singles a+ derived `Eq` instance. In addition, the `Data.Singletons.Decide` module+ now provides top-level `decideEquality`/`decideCoercion` functions which+ provide the behavior of `testEquality`/`testCoercion`, but monomorphized+ to `Sing`. Finally, `TestEquality`/`TestCoercion` instances are provided+ for `WrappedSing`.+* GHC's behavior surrounding kind inference for local definitions has changed+ in 8.8, and certain code that `singletons` generates for local definitions+ may no longer typecheck as a result. While we have taken measures to mitigate+ the issue on `singletons`' end, there still exists code that must be patched+ on the users' end in order to continue compiling. For instance, here is an+ example of code that stopped compiling with the switch to GHC 8.8:++ ```haskell+ replicateM_ :: (Applicative m) => Nat -> m a -> m ()+ replicateM_ cnt0 f =+ loop cnt0+ where+ loop cnt+ | cnt <= 0 = pure ()+ | otherwise = f *> loop (cnt - 1)+ ```++ This produces errors to the effect of:++ ```+ • Could not deduce (SNum k1) arising from a use of ‘sFromInteger’+ from the context: SApplicative m+ ...++ • Could not deduce (SOrd k1) arising from a use of ‘%<=’+ from the context: SApplicative m+ ...+ ```++ The issue is that GHC 8.8 now kind-generalizes `sLoop` (whereas it did not+ previously), explaining why the error message mentions a mysterious kind+ variable `k1` that only appeared after kind generalization. The solution is+ to give `loop` an explicit type signature like so:++ ```diff+ -replicateM_ :: (Applicative m) => Nat -> m a -> m ()+ +replicateM_ :: forall m a. (Applicative m) => Nat -> m a -> m ()+ replicateM_ cnt0 f =+ loop cnt0+ where+ + loop :: Nat -> m ()+ loop cnt+ | cnt <= 0 = pure ()+ | otherwise = f *> loop (cnt - 1)+ ```++ This general approach should be sufficient to fix any type inference+ regressions that were introduced between GHC 8.6 and 8.8. If this isn't the+ case, please file an issue.+* Due to [GHC Trac #16133](https://ghc.haskell.org/trac/ghc/ticket/16133) being+ fixed, `singletons`-generated code now requires explicitly enabling the+ `TypeApplications` extension. (The generated code was always using+ `TypeApplications` under the hood, but it's only now that GHC is detecting+ it.)+* `Data.Singletons` now defines a family of `SingI` instances for `TyCon1`+ through `TyCon8`:++ ```haskell+ instance (forall a. SingI a => SingI (f a), ...) => SingI (TyCon1 f)+ instance (forall a b. (SingI a, SingI b) => SingI (f a b), ...) => SingI (TyCon2 f)+ ...+ ```++ As a result, `singletons` no longer generates instances for `SingI` instances+ for applications of `TyCon{N}` to particular type constructors, as they have+ been superseded by the instances above.+* Changes to `Data.Singletons.Sigma`:+ * `SSigma`, the singleton type for `Sigma`, is now defined.+ * New functions `fstSigma`, `sndSigma`, `FstSigma`, `SndSigma`, `currySigma`,+ and `uncurrySigma` have been added. A `Show` instance for `Sigma` has also+ been added.+ * `projSigma1` has been redefined to use continuation-passing style to more+ closely resemble its cousin `projSigma2`. The new type signature of+ `projSigma1` is:++ ```hs+ projSigma1 :: (forall (fst :: s). Sing fst -> r) -> Sigma s t -> r+ ```++ The old type signature of `projSigma1` can be found in the `fstSigma`+ function.+ * `Σ` has been redefined such that it is now a partial application of+ `Sigma`, like so:++ ```haskell+ type Σ = Sigma+ ```++ One benefit of this change is that one no longer needs defunctionalization+ symbols in order to partially apply `Σ`. As a result, `ΣSym0`, `ΣSym1`,+ and `ΣSym2` have been removed.+* In line with corresponding changes in `base-4.13`, the `Fail`/`sFail` methods+ of `{P,S}Monad` have been removed in favor of new `{P,S}MonadFail` classes+ introduced in the `Data.Singletons.Prelude.Monad.Fail` module. These classes+ are also re-exported from `Data.Singletons.Prelude`.+* Fix a bug where expressions with explicit signatures involving function types+ would fail to single.+* The infix names `(.)` and `(!)` are no longer mapped to `(:.)` and `(:!)`,+ as GHC 8.8 learned to parse them at the type level.+* The `Enum` instance for `SomeSing` now uses more efficient implementations of+ `enumFromTo` and `enumFromThenTo` that no longer require a `SingKind`+ constraint. 2.5.1 -----
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012, Richard Eisenberg+Copyright (c) 2012-2020, Richard Eisenberg All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,767 +1,24 @@-singletons 2.5.1-================+`singletons`+============ [](http://hackage.haskell.org/package/singletons)-[](https://travis-ci.org/goldfirere/singletons) -This is the README file for the singletons library. This file contains all the-documentation for the definitions and functions in the library.--The singletons library was written by Richard Eisenberg, <rae@cs.brynmawr.edu>, and-with significant contributions by Jan Stolarek, <jan.stolarek@p.lodz.pl>. There-are two papers that describe the library. Original one, _Dependently typed-programming with singletons_, is available-[here](https://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf) and will-be referenced in this documentation as the "singletons paper". A follow-up-paper, _Promoting Functions to Type Families in Haskell_, is available-[here](https://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf)-and will be referenced in this documentation as the-"promotion paper".--Ryan Scott, <ryan.gl.scott@gmail.com>, is an active maintainer.--Purpose of the singletons library------------------------------------The library contains a definition of _singleton types_, which allow programmers-to use dependently typed techniques to enforce rich constraints among the types-in their programs. See the singletons paper for a more thorough introduction.--The package also allows _promotion_ of term-level functions to type-level-equivalents. Accordingly, it exports a Prelude of promoted and singletonized-functions, mirroring functions and datatypes found in Prelude, `Data.Bool`,-`Data.Maybe`, `Data.Either`, `Data.Tuple` and `Data.List`. See the promotion-paper for a more thorough introduction.--[This blog series](https://blog.jle.im/entry/introduction-to-singletons-1.html),-authored by Justin Le, offers a tutorial for this library that assumes no-knowledge of dependent types.--Compatibility----------------The singletons library requires GHC 8.6.1 or greater. Any code that uses the-singleton generation primitives needs to enable a long list of GHC-extensions. This list includes, but is not necessarily limited to, the-following:--* `DataKinds`-* `DefaultSignatures`-* `EmptyCase`-* `ExistentialQuantification`-* `FlexibleContexts`-* `FlexibleInstances`-* `GADTs`-* `InstanceSigs`-* `KindSignatures`-* `NoStarIsType`-* `PolyKinds`-* `RankNTypes`-* `ScopedTypeVariables`-* `StandaloneDeriving`-* `TemplateHaskell`-* `TypeFamilies`-* `TypeOperators`-* `UndecidableInstances`--In particular, `NoStarIsType` is needed to use the `*` type family from the-`PNum` class because with `StarIsType` enabled, GHC thinks `*` is a synonym-for `Type`.--You may also want--* `-Wno-redundant-constraints`--as the code that `singletons` generates uses redundant constraints, and there-seems to be no way, without a large library redesign, to avoid this.--Modules for singleton types------------------------------`Data.Singletons` exports all the basic singletons definitions. Import this-module if you are not using Template Haskell and wish only to define your-own singletons.--`Data.Singletons.TH` exports all the definitions needed to use the Template-Haskell code to generate new singletons.--`Data.Singletons.Prelude` re-exports `Data.Singletons` along with singleton-definitions for various Prelude types. This module provides a singletonized-equivalent of the real `Prelude`. Note that not all functions from original-`Prelude` could be turned into singletons.--`Data.Singletons.Prelude.*` modules provide singletonized equivalents of-definitions found in the following `base` library modules: `Data.Bool`,-`Data.Maybe`, `Data.Either`, `Data.List`, `Data.Tuple`, `Data.Void` and-`GHC.Base`. We also provide singletonized `Eq`, `Ord`, `Show`, `Enum`, and-`Bounded` typeclasses.--`Data.Singletons.Decide` exports type classes for propositional equality.--`Data.Singletons.TypeLits` exports definitions for working with `GHC.TypeLits`.--Modules for function promotion---------------------------------Modules in `Data.Promotion` namespace provide functionality required for-function promotion. They mostly re-export a subset of definitions from-respective `Data.Singletons` modules.--`Data.Promotion.TH` exports all the definitions needed to use the Template-Haskell code to generate promoted definitions.--`Data.Promotion.Prelude` and `Data.Promotion.Prelude.*` modules re-export all-promoted definitions from respective `Data.Singletons.Prelude`-modules. `Data.Promotion.Prelude.List` adds a significant amount of functions-that couldn't be singletonized but can be promoted. Some functions still don't-promote - these are documented in the source code of the module. There is also-`Data.Promotion.Prelude.Bounded` module that provides promoted `PBounded`-typeclass.--Functions to generate singletons-----------------------------------The top-level functions used to generate singletons are documented in the-`Data.Singletons.TH` module. The most common case is just calling `singletons`,-which I'll describe here:--```haskell-singletons :: Q [Dec] -> Q [Dec]-```--Generates singletons from the definitions given. Because singleton generation-requires promotion, this also promotes all of the definitions given to the-type level.--Usage example:--```haskell-$(singletons [d|- data Nat = Zero | Succ Nat- pred :: Nat -> Nat- pred Zero = Zero- pred (Succ n) = n- |])-```--Definitions used to support singletons-----------------------------------------Please refer to the singletons paper for a more in-depth explanation of these-definitions. Many of the definitions were developed in tandem with Iavor Diatchki.--```haskell-data family Sing (a :: k)-```--The data family of singleton types. A new instance of this data family is-generated for every new singleton type.--```haskell-class SingI (a :: k) where- sing :: Sing a-```--A class used to pass singleton values implicitly. The `sing` method produces-an explicit singleton value.--```haskell-data SomeSing k where- SomeSing :: Sing (a :: k) -> SomeSing k-```--The `SomeSing` type wraps up an _existentially-quantified_ singleton. Note that-the type parameter `a` does not appear in the `SomeSing` type. Thus, this type-can be used when you have a singleton, but you don't know at compile time what-it will be. `SomeSing Thing` is isomorphic to `Thing`.--```haskell-class SingKind k where- type Demote k :: *- fromSing :: Sing (a :: k) -> Demote k- toSing :: Demote k -> SomeSing k-```--This class is used to convert a singleton value back to a value in the-original, unrefined ADT. The `fromSing` method converts, say, a-singleton `Nat` back to an ordinary `Nat`. The `toSing` method produces-an existentially-quantified singleton, wrapped up in a `SomeSing`.-The `Demote` associated-kind-indexed type family maps the kind `Nat` back to the type `Nat`.--```haskell-data SingInstance (a :: k) where- SingInstance :: SingI a => SingInstance a-singInstance :: Sing a -> SingInstance a-```--Sometimes you have an explicit singleton (a `Sing`) where you need an implicit-one (a dictionary for `SingI`). The `SingInstance` type simply wraps a `SingI`-dictionary, and the `singInstance` function produces this dictionary from an-explicit singleton. The `singInstance` function runs in constant time, using-a little magic.---Equality classes-------------------There are two different notions of equality applicable to singletons: Boolean-equality and propositional equality.--* Boolean equality is implemented in the type family `(:==)` (which is actually-a synonym for the type family `(==)` from `Data.Type.Equality`) and the class-`SEq`. See the `Data.Singletons.Prelude.Eq` module for more information.--* Propositional equality is implemented through the constraint `(~)`, the type-`(:~:)`, and the class `SDecide`. See modules `Data.Type.Equality` and-`Data.Singletons.Decide` for more information.--Which one do you need? That depends on your application. Boolean equality has-the advantage that your program can take action when two types do _not_ equal,-while propositional equality has the advantage that GHC can use the equality-of types during type inference.--Instances of both `SEq` and `SDecide` are generated when `singletons` is called-on a datatype that has `deriving Eq`. You can also generate these instances-directly through functions exported from `Data.Singletons.TH`.---`Show` classes-----------------Promoted and singled versions of the `Show` class (`PShow` and `SShow`,-respectively) are provided in the `Data.Singletons.Prelude.Show` module. In-addition, there is a `ShowSing` constraint synonym provided in the-`Data.Singletons.ShowSing` module:--```haskell-type ShowSing k = (forall z. Show (Sing (z :: k))-```--This facilitates the ability to write `Show` instances for `Sing` instances.--What distinguishes all of these `Show`s? Let's use the `False` constructor as-an example. If you used the `PShow Bool` instance, then the output of calling-`Show_` on `False` is `"False"`, much like the value-level `Show Bool` instance-(similarly for the `SShow Bool` instance). However, the `Show (Sing (z :: Bool))`-instance (i.e., `ShowSing Bool`) is intended for printing the value of the-_singleton_ constructor `SFalse`, so calling `show SFalse` yields `"SFalse"`.--Instance of `PShow`, `SShow`, and `Show` (for the singleton type) are generated-when `singletons` is called on a datatype that has `deriving Show`. You can also-generate these instances directly through functions exported from-`Data.Singletons.TH`.--A promoted and singled `Show` instance is provided for `Symbol`, but it is only-a crude approximation of the value-level `Show` instance for `String`. On the-value level, showing `String`s escapes special characters (such as double-quotes), but implementing this requires pattern-matching on character literals,-something which is currently impossible at the type level. As a consequence, the-type-level `Show` instance for `Symbol`s does not do any character escaping.--Errors---------The `singletons` library provides two different ways to handle errors:--* The `Error` type family, from `Data.Singletons.TypeLits`:-- ```haskell- type family Error (str :: a) :: k where {}- ```-- This is simply an empty, closed type family, which means that it will fail- to reduce regardless of its input. The typical use case is giving it a- `Symbol` as an argument, so that something akin to- `Error "This is an error message"` appears in error messages.-* The `TypeError` type family, from `Data.Singletons.TypeError`. This is a- drop-in replacement for `TypeError` from `GHC.TypeLits` which can be used- at both the type level and the value level (via the `typeError` function).-- Unlike `Error`, `TypeError` will result in an actual compile-time error- message, which may be more desirable depending on the use case.--Pre-defined singletons-------------------------The singletons library defines a number of singleton types and functions-by default:--* `Bool`-* `Maybe`-* `Either`-* `Ordering`-* `()`-* tuples up to length 7-* lists--These are all available through `Data.Singletons.Prelude`. Functions that-operate on these singletons are available from modules such as `Data.Singletons.Bool`-and `Data.Singletons.Maybe`.--Promoting functions----------------------Function promotion allows to generate type-level equivalents of term-level-definitions. Almost all Haskell source constructs are supported -- see last-section of this README for a full list.--Promoted definitions are usually generated by calling `promote` function:--```haskell-$(promote [d|- data Nat = Zero | Succ Nat- pred :: Nat -> Nat- pred Zero = Zero- pred (Succ n) = n- |])-```--Every promoted function and data constructor definition comes with a set of-so-called "symbols". These are required to represent partial application at the-type level. Each function gets N+1 symbols, where N is the arity. Symbols-represent application of between 0 to N arguments. When calling any of the-promoted definitions it is important refer to it using their symbol-name. Moreover, there is new function application at the type level represented-by `Apply` type family. Symbol representing arity X can have X arguments passed-in using normal function application. All other parameters must be passed by-calling `Apply`.--Users also have access to `Data.Promotion.Prelude` and its submodules (`Base`,-`Bool`, `Either`, `List`, `Maybe` and `Tuple`). These provide promoted versions-of function found in GHC's base library.--Note that GHC resolves variable names in Template Haskell quotes. You cannot-then use an undefined identifier in a quote, making idioms like this not-work:-```haskell-type family Foo a where ...-$(promote [d| ... foo x ... |])-```-In this example, `foo` would be out of scope.--Refer to the promotion paper for more details on function promotion.--Classes and instances------------------------This is best understood by example. Let's look at a stripped down `Ord`:--```haskell-class Eq a => Ord a where- compare :: a -> a -> Ordering- (<) :: a -> a -> Bool- x < y = case x `compare` y of- LT -> True- EQ -> False- GT -> False-```--This class gets promoted to a "kind class" thus:--```haskell-class PEq a => POrd a where- type Compare (x :: a) (y :: a) :: Ordering- type (:<) (x :: a) (y :: a) :: Bool- type x :< y = ... -- promoting `case` is yucky.-```--Note that default method definitions become default associated type family-instances. This works out quite nicely.--We also get this singleton class:--```haskell-class SEq a => SOrd a where- sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y)- (%:<) :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (x :< y)-- default (%:<) :: forall (x :: a) (y :: a).- ((x :< y) ~ {- RHS from (:<) above -})- => Sing x -> Sing y -> Sing (x :< y)- x %:< y = ... -- this is a bit yucky too-```--Note that a singletonized class needs to use `default` signatures, because-type-checking the default body requires that the default associated type-family instance was used in the promoted class. The extra equality constraint-on the default signature asserts this fact to the type checker.--Instances work roughly similarly.--```haskell-instance Ord Bool where- compare False False = EQ- compare False True = LT- compare True False = GT- compare True True = EQ--instance POrd Bool where- type Compare 'False 'False = 'EQ- type Compare 'False 'True = 'LT- type Compare 'True 'False = 'GT- type Compare 'True 'True = 'EQ--instance SOrd Bool where- sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y)- sCompare SFalse SFalse = SEQ- sCompare SFalse STrue = SLT- sCompare STrue SFalse = SGT- sCompare STrue STrue = SEQ-```--The only interesting bit here is the instance signature. It's not necessary-in such a simple scenario, but more complicated functions need to refer to-scoped type variables, which the instance signature can bring into scope.-The defaults all just work.--On names-----------The singletons library has to produce new names for the new constructs it-generates. Here are some examples showing how this is done:--1. original datatype: `Nat`-- promoted kind: `Nat`-- singleton type: `SNat` (which is really a synonym for `Sing`)---2. original datatype: `/\`-- promoted kind: `/\`-- singleton type: `%/\`---3. original constructor: `Succ`-- promoted type: `'Succ` (you can use `Succ` when unambiguous)-- singleton constructor: `SSucc`-- symbols: `SuccSym0`, `SuccSym1`---4. original constructor: `:+:`-- promoted type: `':+:`-- singleton constructor: `:%+:`-- symbols: `:+:@#@$`, `:+:@#@$$`, `:+:@#@$$$`---5. original value: `pred`-- promoted type: `Pred`-- singleton value: `sPred`-- symbols: `PredSym0`, `PredSym1`---6. original value: `+`-- promoted type: `+`-- singleton value: `%+`-- symbols: `+@#@$`, `+@#@$$`, `+@#@$$$`---7. original class: `Num`-- promoted class: `PNum`-- singleton class: `SNum`---8. original class: `~>`-- promoted class: `#~>`-- singleton class: `%~>`---Special names----------------There are some special cases, listed below (with asterisks\* denoting special-treatment):--1. original datatype: `[]`-- promoted kind: `[]`-- singleton type\*: `SList`---2. original constructor: `[]`-- promoted type: `'[]`-- singleton constructor\*: `SNil`-- symbols\*: `NilSym0`---3. original constructor: `:`-- promoted type: `':`-- singleton constructor\*: `SCons`-- symbols: `:@#@$`, `:@#@$$`, `:@#@$$$`---4. original datatype: `(,)`-- promoted kind: `(,)`-- singleton type\*: `STuple2`---5. original constructor: `(,)`-- promoted type: `'(,)`-- singleton constructor\*: `STuple2`-- symbols\*: `Tuple2Sym0`, `Tuple2Sym1`, `Tuple2Sym2`-- All tuples (including the 0-tuple, unit) are treated similarly.---6. original value: `(.)`-- promoted type\*: `(:.)`-- singleton value: `(%.)`-- symbols: `(.@#@$)`, `(.@#@$$)`, `(.@#@$$$)`-- The promoted type is special because GHC can't parse a type named `(.)`.--7. original value: `(!)`-- promoted type\*: `(:!)`-- singleton value: `(%!)`-- symbols: `(!@#@$)`, `(!@#@$$)`, `(!@#@$$$)`-- The promoted type is special because GHC can't parse a type named `(!)`.--8. original value: `___foo`-- promoted type\*: `US___foo` ("`US`" stands for "underscore")-- singleton value\*: `___sfoo`-- symbols\*: `US___fooSym0`-- All functions that begin with leading underscores are treated similarly.--Supported Haskell constructs-------------------------------The following constructs are fully supported:--* variables-* tuples-* constructors-* if statements-* infix expressions and types-* `_` patterns-* aliased patterns-* lists (including list comprehensions)-* `do`-notation-* sections-* undefined-* error-* deriving `Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`, `Foldable`, and- `Traversable`, as well as the `stock` and `anyclass` deriving strategies-* class constraints (though these sometimes fail with `let`, `lambda`, and `case`)-* literals (for `Nat` and `Symbol`), including overloaded number literals-* unboxed tuples (which are treated as normal tuples)-* records-* pattern guards-* case-* let-* lambda expressions-* `!` and `~` patterns (silently but successfully ignored during promotion)-* class and instance declarations-* scoped type variables-* signatures (e.g., `(x :: Maybe a)`) in expressions and patterns-* `InstanceSigs`-* higher-kinded type variables (see below)-* finite arithmetic sequences (see below)-* functional dependencies (with limitations -- see below)-* type families (with limitations -- see below)--Higher-kinded type variables in `class`/`data` declarations must be annotated-explicitly. This is due to GHC's handling of *complete-user-specified kind signatures*, or [CUSKs](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#complete-user-supplied-kind-signatures-and-polymorphic-recursion).-Briefly, `singletons` has a hard-time conforming to the precise rules that GHC imposes around CUSKs and so-needs a little help around kind inference here. See-[this pull request](https://github.com/goldfirere/singletons/pull/171) for more-background.--`singletons` is slightly more conservative with respect to `deriving` than GHC is.-The stock classes listed above (`Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`,-`Foldable`, and `Traversable`) are the only ones that `singletons` will derive-without an explicit deriving strategy. To do anything more exotic, one must-explicitly indicate one's intentions by using the `DerivingStrategies` extension.--`singletons` fully supports the `anyclass` strategy as well as the `stock` strategy-(at least, for the classes listed above). `singletons` does not support the-`newtype` strategy, as there is not an equivalent of `coerce` at the type level.--`singletons` has partial support for arithmetic sequences (which desugar to-methods from the `Enum` class under the hood). _Finite_ sequences (e.g.,-[0..42]) are fully supported. However, _infinite_ sequences (e.g., [0..]),-which desugar to calls to `enumFromTo` or `enumFromThenTo`, are not supported,-as these would require using infinite lists at the type level.--The following constructs are supported for promotion but not singleton generation:--* datatypes with constructors which have contexts. For example, the following- datatype does not singletonize:-- ```haskell- data T a where- MkT :: Show a => a -> T a- ```-- Constructors like these do not interact well with the current design of the- `SingKind` class. But see- [this bug report](https://github.com/goldfirere/singletons/issues/150), which- proposes a redesign for `SingKind` (in a future version of GHC with certain- bugfixes) which could permit constructors with equality constraints.--* overlapping patterns. Note that overlapping patterns are- sometimes not obvious. For example, the `filter` function does not- singletonize due- to overlapping patterns:-- ```haskell- filter :: (a -> Bool) -> [a] -> [a]- filter _pred [] = []- filter pred (x:xs)- | pred x = x : filter pred xs- | otherwise = filter pred xs- ```- Overlap is caused by `otherwise` catch-all guard, which is always true and thus-overlaps with `pred x` guard.-- Another non-obvious source of overlapping patterns comes from partial pattern- matches in `do`-notation. For example:-- ```haskell- f :: [()]- f = do- Just () <- [Nothing]- return ()- ```-- This has overlap because the partial pattern match desugars to the following:-- ```haskell- f :: [()]- f = case [Nothing] of- Just () -> return ()- _ -> fail "Partial pattern match in do notation"- ```-- Here, it is more evident that the catch-all pattern `_` overlaps with the- one above it.--The following constructs are not supported:--* datatypes that store arrows, `Nat`, or `Symbol`-* literals (limited support)--Why are these out of reach?--As described in the promotion paper, promotion of datatypes that store arrows is-currently impossible. So if you have a declaration such as--```haskell-data Foo = Bar (Bool -> Maybe Bool)-```--you will quickly run into errors.--Literals are problematic because we rely on GHC's built-in support, which-currently is limited. Functions that operate on strings will not work because-type level strings are no longer considered lists of characters. Function-working on integer literals can be promoted by rewriting them to use-`Nat`. Since `Nat` does not exist at the term level it will only be possible to-use the promoted definition, but not the original, term-level one.--This is the same line of reasoning that forbids the use of `Nat` or `Symbol`-in datatype definitions. But, see [this bug-report](https://github.com/goldfirere/singletons/issues/76) for a workaround.--Support for `*`------------------The built-in Haskell promotion mechanism does not yet have a full story around-the kind `*` (the kind of types that have values). Ideally, promoting some form-of `TypeRep` would yield `*`, but the implementation of TypeRep would have to be-updated for this to really work out. In the meantime, users who wish to-experiment with this feature have two options:--1) The module `Data.Singletons.TypeRepTYPE` has all the definitions possible for-making `*` the promoted version of `TypeRep`, as `TypeRep` is currently implemented.-The singleton associated with `TypeRep` has one constructor:-- ```haskell- newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where- STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a- ```-- (Recall that `type * = TYPE LiftedRep`.) Thus, a `TypeRep` is stored in the-singleton constructor. However, any datatypes that store `TypeRep`s will not-generally work as expected; the built-in promotion mechanism will not promote-`TypeRep` to `*`.--2) The module `Data.Singletons.CustomStar` allows the programmer to define a subset-of types with which to work. See the Haddock documentation for the function-`singletonStar` for more info.--Known bugs-------------* Record updates don't singletonize-* Inference dependent on functional dependencies is unpredictably bad. The- problem is that a use of an associated type family tied to a class with- fundeps doesn't provoke the fundep to kick in. This is GHC's problem, in- the end.-* Singled code that contains uses type families is likely to fail due to GHC- Trac #12564. Note that singling type family declarations themselves is fine- (and often desired, since that produces defunctionalization symbols for them).-* Singling instances of poly-kinded type classes is likely to fail due to- [#358](https://github.com/goldfirere/singletons/issues/358).- However, one can often work around the issue by using `InstanceSigs`. For- instance, the following code will not single:-- ```haskell- class C (f :: k -> Type) where- method :: f a+`singletons` contains the basic types and definitions needed to support+dependently typed programming techniques in Haskell. This library was+originally presented in+[_Dependently Typed Programming with Singletons_](https://richarde.dev/papers/2012/singletons/paper.pdf),+published at the Haskell Symposium, 2012. - instance C [] where- method = []- ```+`singletons` is intended to be a small, foundational library on which other+projects can build. As such, `singletons` has a minimal dependency+footprint and supports GHCs dating back to GHC 8.0. For more information,+consult the `singletons`+[`README`](https://github.com/goldfirere/singletons/blob/master/README.md). - Adding a type signature for `method` in the `C []` is sufficient- to work around the issue, though:+You may also be interested in the following related libraries: - ```haskell- instance C [] where- method :: [a]- method = []- ```+* The `singletons-th` library defines Template Haskell functionality that+ allows _promotion_ of term-level functions to type-level equivalents and+ _singling_ functions to dependently typed equivalents.+* The `singletons-base` library uses `singletons-th` to define promoted and+ singled functions from the `base` library, including the `Prelude`.
Setup.hs view
@@ -1,138 +1,2 @@-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--import Control.Monad--import Data.List-import Data.String--import Distribution.PackageDescription import Distribution.Simple-import Distribution.Simple.BuildPaths-import Distribution.Simple.LocalBuildInfo-import Distribution.Simple.PackageIndex-import Distribution.Simple.Program-import Distribution.Simple.Setup-import Distribution.Simple.Utils-import Distribution.Text--import System.Directory-import System.FilePath--main :: IO ()-main = defaultMainWithHooks simpleUserHooks- { buildHook = \pkg lbi hooks flags -> do- generateBuildModule flags pkg lbi- buildHook simpleUserHooks pkg lbi hooks flags- , confHook = \(gpd, hbi) flags ->- confHook simpleUserHooks (amendGPD gpd, hbi) flags- , haddockHook = \pkg lbi hooks flags -> do- generateBuildModule (haddockToBuildFlags flags) pkg lbi- haddockHook simpleUserHooks pkg lbi hooks flags- }---- | Convert only flags used by 'generateBuildModule'.-haddockToBuildFlags :: HaddockFlags -> BuildFlags-haddockToBuildFlags f = emptyBuildFlags- { buildVerbosity = haddockVerbosity f- , buildDistPref = haddockDistPref f- }--generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule flags pkg lbi = do- rootDir <- getCurrentDirectory- let verbosity = fromFlag (buildVerbosity flags)- distPref = fromFlag (buildDistPref flags)- distPref' | isRelative distPref = rootDir </> distPref- | otherwise = distPref- -- Package DBs- dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref' </> "package.conf.inplace" ]- dbFlags = "-hide-all-packages" : packageDbArgsDb dbStack-- ghc = case lookupProgram ghcProgram (withPrograms lbi) of- Just fp -> locationPath $ programLocation fp- Nothing -> error "Can't find GHC path"- withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do- let testAutogenDir = autogenComponentModulesDir lbi suitecfg- createDirectoryIfMissingVerbose verbosity True testAutogenDir- let buildSingletonsFile = testAutogenDir </> buildSingletonsModule <.> "hs"- withLibLBI pkg lbi $ \_ libCLBI -> do- let libDeps = map fst $ componentPackageDeps libCLBI- pidx = case dependencyClosure (installedPkgs lbi) libDeps of- Left p -> p- Right _ -> error "Broken dependency closure"- libTransDeps = map installedUnitId $ allPackages pidx- singletonsUnitId = componentUnitId libCLBI- deps = formatDeps (singletonsUnitId:libTransDeps)- allFlags = dbFlags ++ deps- writeFile buildSingletonsFile $ unlines- [ "module Build_singletons where"- , ""- , "ghcPath :: FilePath"- , "ghcPath = " ++ show ghc- , ""- , "ghcFlags :: [String]"- , "ghcFlags = " ++ show allFlags- , ""- , "rootDir :: FilePath"- , "rootDir = " ++ show rootDir- ]- where- formatDeps = map formatOne- formatOne installedPkgId = "-package-id=" ++ display installedPkgId-- -- GHC >= 7.6 uses the '-package-db' flag. See- -- https://ghc.haskell.org/trac/ghc/ticket/5977.- packageDbArgsDb :: [PackageDB] -> [String]- -- special cases to make arguments prettier in common scenarios- packageDbArgsDb dbstack = case dbstack of- (GlobalPackageDB:UserPackageDB:dbs)- | all isSpecific dbs -> concatMap single dbs- (GlobalPackageDB:dbs)- | all isSpecific dbs -> "-no-user-package-db"- : concatMap single dbs- dbs -> "-clear-package-db"- : concatMap single dbs- where- single (SpecificPackageDB db) = [ "-package-db=" ++ db ]- single GlobalPackageDB = [ "-global-package-db" ]- single UserPackageDB = [ "-user-package-db" ]- isSpecific (SpecificPackageDB _) = True- isSpecific _ = False--buildSingletonsModule :: FilePath-buildSingletonsModule = "Build_singletons"--testSuiteName :: String-testSuiteName = "singletons-test-suite"--amendGPD :: GenericPackageDescription -> GenericPackageDescription-amendGPD gpd = gpd- { condTestSuites = map f (condTestSuites gpd)- }- where- f (name, condTree)- | name == fromString testSuiteName = (name, condTree')- | otherwise = (name, condTree)- where- -- I miss 'lens'- testSuite = condTreeData condTree- bi = testBuildInfo testSuite- om = otherModules bi- am = autogenModules bi-- -- Cons the module to both other-modules and autogen-modules.- -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have- -- "all autogen-modules are other-modules if they aren't exposed-modules"- -- rule. Hopefully cabal-spec-3.0 will have.- --- -- Note: we `nub`, because it's unclear if that's ok to have duplicate- -- modules in the lists.- om' = nub $ mn : om- am' = nub $ mn : am-- mn = fromString buildSingletonsModule-- bi' = bi { otherModules = om', autogenModules = am' }- testSuite' = testSuite { testBuildInfo = bi' }- condTree' = condTree { condTreeData = testSuite' }+main = defaultMain
singletons.cabal view
@@ -1,159 +1,82 @@ name: singletons-version: 2.5.1- -- Remember to bump version in the Makefile as well-cabal-version: >= 1.10-synopsis: A framework for generating singleton types+version: 3.0.4+cabal-version: 1.24+synopsis: Basic singleton types and definitions homepage: http://www.github.com/goldfirere/singletons category: Dependent Types author: Richard Eisenberg <rae@cs.brynmawr.edu>, Jan Stolarek <jan.stolarek@p.lodz.pl> maintainer: Ryan Scott <ryan.gl.scott@gmail.com> bug-reports: https://github.com/goldfirere/singletons/issues stability: experimental-tested-with: GHC == 8.6.2-extra-source-files: README.md, CHANGES.md,- tests/compile-and-dump/buildGoldenFiles.awk,- tests/compile-and-dump/GradingClient/*.hs,- tests/compile-and-dump/InsertionSort/*.hs,- tests/compile-and-dump/Promote/*.hs,- tests/compile-and-dump/Singletons/*.hs- tests/compile-and-dump/GradingClient/*.ghc86.template,- tests/compile-and-dump/InsertionSort/*.ghc86.template,- tests/compile-and-dump/Promote/*.ghc86.template,- tests/compile-and-dump/Singletons/*.ghc86.template+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.7+ , GHC == 9.4.8+ , GHC == 9.6.6+ , GHC == 9.8.2+ , GHC == 9.10.1+ , GHC == 9.12.1+extra-source-files: README.md, CHANGES.md license: BSD3 license-file: LICENSE-build-type: Custom+build-type: Simple description:- This library generates singleton types, promoted functions, and singleton- functions using Template Haskell. It is useful for programmers who wish- to use dependently typed programming techniques. The library was originally- presented in /Dependently Typed Programming with Singletons/, published- at the Haskell Symposium, 2012.- (<https://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf>)-- Version 1.0 and onwards works a lot harder to promote functions. See the- paper published at Haskell Symposium, 2014:- <https://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf>.+ @singletons@ contains the basic types and definitions needed to support+ dependently typed programming techniques in Haskell. This library was+ originally presented in /Dependently Typed Programming with Singletons/,+ published at the Haskell Symposium, 2012.+ (<https://richarde.dev/papers/2012/singletons/paper.pdf>)+ .+ @singletons@ is intended to be a small, foundational library on which other+ projects can build. As such, @singletons@ has a minimal dependency+ footprint and supports GHCs dating back to GHC 8.0. For more information,+ consult the @singletons@+ @<https://github.com/goldfirere/singletons/blob/master/README.md README>@.+ .+ You may also be interested in the following related libraries:+ .+ * The @singletons-th@ library defines Template Haskell functionality that+ allows /promotion/ of term-level functions to type-level equivalents and+ /singling/ functions to dependently typed equivalents.+ .+ * The @singletons-base@ library uses @singletons-th@ to define promoted and+ singled functions from the @base@ library, including the "Prelude". source-repository this type: git location: https://github.com/goldfirere/singletons.git- tag: v2.5.1+ subdir: singletons+ tag: v3.0.2 source-repository head type: git location: https://github.com/goldfirere/singletons.git+ subdir: singletons branch: master -custom-setup- setup-depends:- base >= 4.12 && < 4.13,- Cabal >= 2.3 && < 2.5,- directory >= 1,- filepath >= 1.3- library hs-source-dirs: src- build-depends: base >= 4.12 && < 4.13,- mtl >= 2.2.1,- ghc-boot-th,- template-haskell,- containers >= 0.5,- th-desugar >= 1.9 && < 1.10,- pretty,- syb >= 0.4,- text >= 1.2,- transformers >= 0.5.2+ build-depends: base >= 4.9 && < 4.22 default-language: Haskell2010- other-extensions: TemplateHaskell- -- TemplateHaskell must be listed in cabal file to work with- -- ghc7.8+- exposed-modules: Data.Singletons- Data.Singletons.CustomStar- Data.Singletons.TypeRepTYPE- Data.Singletons.TH- Data.Singletons.Prelude- Data.Singletons.Prelude.Applicative- Data.Singletons.Prelude.Base- Data.Singletons.Prelude.Bool- Data.Singletons.Prelude.Const- Data.Singletons.Prelude.Either- Data.Singletons.Prelude.Enum- Data.Singletons.Prelude.Eq- Data.Singletons.Prelude.Foldable- Data.Singletons.Prelude.Function- Data.Singletons.Prelude.Functor- Data.Singletons.Prelude.IsString- Data.Singletons.Prelude.Identity- Data.Singletons.Prelude.Ord- Data.Singletons.Prelude.List- Data.Singletons.Prelude.List.NonEmpty- Data.Singletons.Prelude.Maybe- Data.Singletons.Prelude.Monad- Data.Singletons.Prelude.Monad.Zip- Data.Singletons.Prelude.Monoid- Data.Singletons.Prelude.Num- Data.Singletons.Prelude.Semigroup- Data.Singletons.Prelude.Show- Data.Singletons.Prelude.Traversable- Data.Singletons.Prelude.Tuple- Data.Singletons.Prelude.Void- Data.Singletons.TypeError- Data.Singletons.TypeLits Data.Singletons.Decide Data.Singletons.ShowSing Data.Singletons.Sigma- Data.Singletons.SuppressUnusedWarnings-- other-modules: Data.Singletons.Deriving.Infer- Data.Singletons.Deriving.Bounded- Data.Singletons.Deriving.Enum- Data.Singletons.Deriving.Foldable- Data.Singletons.Deriving.Functor- Data.Singletons.Deriving.Ord- Data.Singletons.Deriving.Show- Data.Singletons.Deriving.Traversable- Data.Singletons.Deriving.Util- Data.Singletons.Internal- Data.Singletons.Prelude.List.Internal- Data.Singletons.Prelude.List.Internal.Disambiguation- Data.Singletons.Prelude.Monad.Internal- Data.Singletons.Prelude.Semigroup.Internal- Data.Singletons.Promote- Data.Singletons.Promote.Monad- Data.Singletons.Promote.Eq- Data.Singletons.Promote.Type- Data.Singletons.Promote.Defun- Data.Singletons.Util- Data.Singletons.Partition- Data.Singletons.Prelude.Instances- Data.Singletons.Names- Data.Singletons.Single.Monad- Data.Singletons.Single.Type- Data.Singletons.Single.Eq- Data.Singletons.Single.Data- Data.Singletons.Single.Defun- Data.Singletons.Single.Fixity- Data.Singletons.Single- Data.Singletons.TypeLits.Internal- Data.Singletons.Syntax-- ghc-options: -Wall -Wno-redundant-constraints+ ghc-options: -Wall test-suite singletons-test-suite type: exitcode-stdio-1.0 hs-source-dirs: tests- ghc-options: -Wall+ ghc-options: -Wall -threaded default-language: Haskell2010 main-is: SingletonsTestSuite.hs other-modules: ByHand ByHand2- SingletonsTestSuiteUtils - build-depends: base >= 4.12 && < 4.13,- filepath >= 1.3,- process >= 1.1,- singletons,- tasty >= 0.6,- tasty-golden >= 2.2+ build-depends: base >= 4.9 && < 4.22,+ singletons
src/Data/Singletons.hs view
@@ -1,167 +1,1339 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ This module exports the basic definitions to use singletons. For routine--- use, consider importing 'Data.Singletons.Prelude', which exports constructors--- for singletons based on types in the @Prelude@.------ You may also want to read--- the original papers presenting this library, available at--- <http://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf>--- and <http://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf>.----------------------------------------------------------------------------------module Data.Singletons (- -- * Main singleton definitions-- Sing(SLambda, applySing), (@@),-- SingI(..), SingKind(..),-- -- * Working with singletons- KindOf, SameKind,- SingInstance(..), SomeSing(..),- singInstance, pattern Sing, withSingI,- withSomeSing, pattern FromSing,- singByProxy, demote,-- singByProxy#,- withSing, singThat,-- -- ** Defunctionalization- TyFun, type (~>),- TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8,- TyCon, Apply, type (@@),-- -- ** Defunctionalized singletons- -- | When calling a higher-order singleton function, you need to use a- -- @singFun...@ function to wrap it. See 'singFun1'.- singFun1, singFun2, singFun3, singFun4, singFun5, singFun6, singFun7,- singFun8,- unSingFun1, unSingFun2, unSingFun3, unSingFun4, unSingFun5,- unSingFun6, unSingFun7, unSingFun8,- -- $SLambdaPatternSynonyms- pattern SLambda2, pattern SLambda3, pattern SLambda4, pattern SLambda5,- pattern SLambda6, pattern SLambda7, pattern SLambda8,-- -- | These type synonyms are exported only to improve error messages; users- -- should not have to mention them.- SingFunction1, SingFunction2, SingFunction3, SingFunction4, SingFunction5,- SingFunction6, SingFunction7, SingFunction8,-- -- * Auxiliary functions- Proxy(..),-- -- * Defunctionalization symbols- DemoteSym0, DemoteSym1,- SameKindSym0, SameKindSym1, SameKindSym2,- KindOfSym0, KindOfSym1,- type (~>@#@$), type (~>@#@$$), type (~>@#@$$$),- ApplySym0, ApplySym1, ApplySym2,- type (@@@#@$), type (@@@#@$$), type (@@@#@$$$)- ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.IsString-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Semigroup-import Data.Singletons.Promote-import Data.Singletons.ShowSing-import Data.String-import qualified Data.Text as T (pack)----------------------------------------------------------------------------- SomeSing instances -----------------------------------------------------------------------------------------------------------------------instance SEq k => Eq (SomeSing k) where- SomeSing a == SomeSing b = fromSing (a %== b)- SomeSing a /= SomeSing b = fromSing (a %/= b)--instance SOrd k => Ord (SomeSing k) where- SomeSing a `compare` SomeSing b = fromSing (a `sCompare` b)- SomeSing a < SomeSing b = fromSing (a %< b)- SomeSing a <= SomeSing b = fromSing (a %<= b)- SomeSing a > SomeSing b = fromSing (a %> b)- SomeSing a >= SomeSing b = fromSing (a %>= b)--instance SBounded k => Bounded (SomeSing k) where- minBound = SomeSing sMinBound- maxBound = SomeSing sMaxBound--instance (SEnum k, SingKind k) => Enum (SomeSing k) where- succ (SomeSing a) = SomeSing (sSucc a)- pred (SomeSing a) = SomeSing (sPred a)- toEnum n = withSomeSing (fromIntegral n) (SomeSing . sToEnum)- fromEnum (SomeSing a) = fromIntegral (fromSing (sFromEnum a))- enumFromTo (SomeSing from) (SomeSing to) =- map toSing (fromSing (sEnumFromTo from to))- enumFromThenTo (SomeSing from) (SomeSing then_) (SomeSing to) =- map toSing (fromSing (sEnumFromThenTo from then_ to))--instance SNum k => Num (SomeSing k) where- SomeSing a + SomeSing b = SomeSing (a %+ b)- SomeSing a - SomeSing b = SomeSing (a %- b)- SomeSing a * SomeSing b = SomeSing (a %* b)- negate (SomeSing a) = SomeSing (sNegate a)- abs (SomeSing a) = SomeSing (sAbs a)- signum (SomeSing a) = SomeSing (sSignum a)- fromInteger n = withSomeSing (fromIntegral n) (SomeSing . sFromInteger)--deriving instance ShowSing k => Show (SomeSing k)--instance SSemigroup k => Semigroup (SomeSing k) where- SomeSing a <> SomeSing b = SomeSing (a %<> b)--instance SMonoid k => Monoid (SomeSing k) where- mempty = SomeSing sMempty--instance SIsString k => IsString (SomeSing k) where- fromString s = withSomeSing (T.pack s) (SomeSing . sFromString)----------------------------------------------------------------------------- Defunctionalization symbols --------------------------------------------------------------------------------------------------------------$(genDefunSymbols [''Demote, ''SameKind, ''KindOf, ''(~>), ''Apply, ''(@@)])--- SingFunction1 et al. are not defunctionalizable at the moment due to #198--{- $SLambdaPatternSynonyms--@SLambda{2...8}@ are explicitly bidirectional pattern synonyms for-defunctionalized singletons (@'Sing' (f :: k '~>' k' '~>' k'')@).--As __constructors__: Same as @singFun{2..8}@. For example, one can turn a-binary function on singletons @sTake :: 'SingFunction2' TakeSym0@ into a-defunctionalized singleton @'Sing' (TakeSym :: Nat '~>' [a] '~>' [a])@:--@->>> import Data.Singletons.Prelude.List+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#else+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif++#if __GLASGOW_HASKELL__ >= 910+{-# LANGUAGE TypeAbstractions #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons+-- Copyright : (C) 2013 Richard Eisenberg+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- This module exports the basic definitions to use singletons. See also+-- @Prelude.Singletons@ from the @singletons-base@+-- library, which re-exports this module alongside many singled definitions+-- based on the "Prelude".+--+-- You may also want to read+-- the original papers presenting this library, available at+-- <https://richarde.dev/papers/2012/singletons/paper.pdf>+-- and <https://richarde.dev/papers/2014/promotion/promotion.pdf>.+--+----------------------------------------------------------------------------++module Data.Singletons (+ -- * Main singleton definitions++ Sing, SLambda(..), (@@),++ SingI(..),+ SingI1(..), sing1,+ SingI2(..), sing2,+ SingKind(..),++ -- * Working with singletons+ KindOf, SameKind,+ SingInstance(..), SomeSing(..),+ singInstance, pattern Sing, withSingI,+ withSomeSing, pattern FromSing,+ usingSingI1, usingSingI2,+ singByProxy, singByProxy1, singByProxy2,+ demote, demote1, demote2,++ singByProxy#, singByProxy1#, singByProxy2#,+ withSing, withSing1, withSing2,+ singThat, singThat1, singThat2,++ -- ** @WrappedSing@+ WrappedSing(..), SWrappedSing(..), UnwrapSing,+ -- $SingletonsOfSingletons++ -- ** Defunctionalization+ TyFun, type (~>),+ TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8,+ Apply, type (@@),+#if __GLASGOW_HASKELL__ >= 806+ TyCon, ApplyTyCon, ApplyTyConAux1, ApplyTyConAux2,+#endif++ -- ** Defunctionalized singletons+ -- | When calling a higher-order singleton function, you need to use a+ -- @singFun...@ function to wrap it. See 'singFun1'.+ singFun1, singFun2, singFun3, singFun4, singFun5, singFun6, singFun7,+ singFun8,+ unSingFun1, unSingFun2, unSingFun3, unSingFun4, unSingFun5,+ unSingFun6, unSingFun7, unSingFun8,+ -- $SLambdaPatternSynonyms+ pattern SLambda2, applySing2,+ pattern SLambda3, applySing3,+ pattern SLambda4, applySing4,+ pattern SLambda5, applySing5,+ pattern SLambda6, applySing6,+ pattern SLambda7, applySing7,+ pattern SLambda8, applySing8,++ -- | These type synonyms are exported only to improve error messages; users+ -- should not have to mention them.+ SingFunction1, SingFunction2, SingFunction3, SingFunction4, SingFunction5,+ SingFunction6, SingFunction7, SingFunction8,++ -- * Auxiliary functions+ Proxy(..),++ -- * Defunctionalization symbols+ DemoteSym0, DemoteSym1,+ SameKindSym0, SameKindSym1, SameKindSym2,+ KindOfSym0, KindOfSym1,+ type (~>@#@$), type (~>@#@$$), type (~>@#@$$$),+ ApplySym0, ApplySym1, ApplySym2,+ type (@@@#@$), type (@@@#@$$), type (@@@#@$$$)+ ) where++import Data.Kind (Constraint, Type)+import Data.Proxy (Proxy(..))+import GHC.Exts (Proxy#)+import Unsafe.Coerce (unsafeCoerce)++#if MIN_VERSION_base(4,17,0)+import GHC.Exts (withDict)+#endif++-- | Convenient synonym to refer to the kind of a type variable:+-- @type KindOf (a :: k) = k@+#if __GLASGOW_HASKELL__ >= 810+type KindOf :: k -> Type+#endif+type KindOf (a :: k) = k++-- | Force GHC to unify the kinds of @a@ and @b@. Note that @SameKind a b@ is+-- different from @KindOf a ~ KindOf b@ in that the former makes the kinds+-- unify immediately, whereas the latter is a proposition that GHC considers+-- as possibly false.+#if __GLASGOW_HASKELL__ >= 810+type SameKind :: k -> k -> Constraint+#endif+type SameKind (a :: k) (b :: k) = (() :: Constraint)++----------------------------------------------------------------------+---- Sing & friends --------------------------------------------------+----------------------------------------------------------------------++-- | The singleton kind-indexed type family.+#if __GLASGOW_HASKELL__ >= 810+type Sing :: k -> Type+#endif+#if __GLASGOW_HASKELL__ >= 910+type family Sing @k :: k -> Type+#else+type family Sing :: k -> Type+#endif++{-+Note [The kind of Sing]+~~~~~~~~~~~~~~~~~~~~~~~+It is important to define Sing like this:++ type Sing :: k -> Type+ type family Sing++Or, equivalently,++ type family Sing :: k -> Type++There are other conceivable ways to define Sing, but they all suffer from+various drawbacks:++* type family Sing :: forall k. k -> Type++ Surprisingly, this is /not/ equivalent to `type family Sing :: k -> Type`.+ The difference lies in their arity, i.e., the number of arguments that must+ be supplied in order to apply Sing. The former declaration has arity 0, while+ the latter has arity 1 (this is more obvious if you write the declaration as+ GHCi would display it with -fprint-explicit-kinds enabled:+ `type family Sing @k :: k -> Type`).++ The former declaration having arity 0 is actually what makes it useless. If+ we were to adopt an arity-0 definition of `Sing`, then in order to write+ `type instance Sing = SFoo`, GHC would require that `SFoo` must have the kind+ `forall k. k -> Type`, and moreover, the kind /must/ be polymorphic in `k`.+ This is undesirable, because in practice, every single `Sing` instance in the+ wild must monomorphize `k` (e.g., `SBool` monomorphizes it to `Bool`), so an+ arity-0 `Sing` simply won't work. In contrast, the current arity-1 definition+ of `Sing` /does/ let you monomorphize `k` in type family instances.++* type family Sing (a :: k) = (r :: Type) | r -> a++ Again, this is not equivalent to `type family Sing :: k -> Type`. This+ version of `Sing` has arity 2, since one must supply both `k` and `a` in+ order to apply it. While an arity-2 `Sing` is not suffer from the same+ polymorphism issues as the arity-0 `Sing` in the previous bullet point, it+ does suffer from another issue in that it cannot be partially applied. This+ is because its `a` argument /must/ be supplied, whereas with the arity-1+ `Sing`, it is perfectly admissible to write `Sing` without an explicit `a`+ argument. (Its invisible `k` argument is filled in automatically behind the+ scenes.)++* type family Sing = (r :: k -> Type) | r -> k++ This is the same as `type family Sing :: k -> Type`, but with an injectivity+ annotation. Technically, this definition isn't /wrong/, but the injectivity+ annotation is actually unnecessary. Because the return kind of `Sing` is+ declared to be `k -> Type`, the `Sing` type constructor is automatically+ injective, so `Sing a1 ~ Sing a2` implies `a1 ~~ a2`.++ Another way of phrasing this, using the terminology of Dependent Haskell, is+ that the arrow in `Sing`'s return kind is /matchable/, which implies that+ `Sing` is an injective type constructor as a consequence.+-}++-- | A 'SingI' constraint is essentially an implicitly-passed singleton.+--+-- In contrast to the 'SingKind' class, which is parameterized over data types+-- promoted to the kind level, the 'SingI' class is parameterized over values+-- promoted to the type level. To explain this distinction another way, consider+-- this code:+--+-- @+-- f = fromSing (sing @(T :: K))+-- @+--+-- Here, @f@ uses methods from both 'SingI' and 'SingKind'. However, the shape+-- of each constraint is rather different: using 'sing' requires a @SingI T@+-- constraint, whereas using 'fromSing' requires a @SingKind K@ constraint.+--+-- If you need to satisfy this constraint with an explicit singleton, please+-- see 'withSingI' or the v'Sing' pattern synonym.+#if __GLASGOW_HASKELL__ >= 900+type SingI :: forall {k}. k -> Constraint+#endif+class SingI a where+ -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@+ -- extension to use this method the way you want.+ sing :: Sing a++-- | A version of the 'SingI' class lifted to unary type constructors.+#if __GLASGOW_HASKELL__ >= 900+type SingI1 :: forall {k1} {k2}. (k1 -> k2) -> Constraint+#endif+class+#if __GLASGOW_HASKELL__ >= 806+ (forall x. SingI x => SingI (f x)) =>+#endif+ SingI1 f where+ -- | Lift an explicit singleton through a unary type constructor.+ -- You will likely need the @ScopedTypeVariables@ extension to use this+ -- method the way you want.+ liftSing :: Sing x -> Sing (f x)++-- | Produce a singleton explicitly using implicit 'SingI1' and 'SingI'+-- constraints. You will likely need the @ScopedTypeVariables@ extension to use+-- this method the way you want.+sing1 :: (SingI1 f, SingI x) => Sing (f x)+sing1 = liftSing sing++-- | A version of the 'SingI' class lifted to binary type constructors.+#if __GLASGOW_HASKELL__ >= 900+type SingI2 :: forall {k1} {k2} {k3}. (k1 -> k2 -> k3) -> Constraint+#endif+class+#if __GLASGOW_HASKELL__ >= 806+ (forall x y. (SingI x, SingI y) => SingI (f x y)) =>+#endif+ SingI2 f where+ -- | Lift explicit singletons through a binary type constructor.+ -- You will likely need the @ScopedTypeVariables@ extension to use this+ -- method the way you want.+ liftSing2 :: Sing x -> Sing y -> Sing (f x y)++-- | Produce a singleton explicitly using implicit 'SingI2' and 'SingI'+-- constraints. You will likely need the @ScopedTypeVariables@ extension to use+-- this method the way you want.+sing2 :: (SingI2 f, SingI x, SingI y) => Sing (f x y)+sing2 = liftSing2 sing sing++-- | An explicitly bidirectional pattern synonym for implicit singletons.+--+-- As an __expression__: Constructs a singleton @Sing a@ given a+-- implicit singleton constraint @SingI a@.+--+-- As a __pattern__: Matches on an explicit @Sing a@ witness bringing+-- an implicit @SingI a@ constraint into scope.+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Sing #-}+#endif+pattern Sing :: forall k (a :: k). () => SingI a => Sing a+pattern Sing <- (singInstance -> SingInstance)+ where Sing = sing++-- | The 'SingKind' class is a /kind/ class. It classifies all kinds+-- for which singletons are defined. The class supports converting between a singleton+-- type and the base (unrefined) type which it is built from.+--+-- For a 'SingKind' instance to be well behaved, it should obey the following laws:+--+-- @+-- 'toSing' . 'fromSing' ≡ 'SomeSing'+-- (\\x -> 'withSomeSing' x 'fromSing') ≡ 'id'+-- @+--+-- The final law can also be expressed in terms of the 'FromSing' pattern+-- synonym:+--+-- @+-- (\\('FromSing' sing) -> 'FromSing' sing) ≡ 'id'+-- @+#if __GLASGOW_HASKELL__ >= 810+type SingKind :: Type -> Constraint+#endif+class SingKind k where+ -- | Get a base type from the promoted kind. For example,+ -- @Demote Bool@ will be the type @Bool@. Rarely, the type and kind do not+ -- match. For example, @Demote Nat@ is @Natural@.+ type Demote k = (r :: Type) | r -> k++ -- | Convert a singleton to its unrefined version.+ fromSing :: Sing (a :: k) -> Demote k++ -- | Convert an unrefined type to an existentially-quantified singleton type.+ toSing :: Demote k -> SomeSing k++-- | An /existentially-quantified/ singleton. This type is useful when you want a+-- singleton type, but there is no way of knowing, at compile-time, what the type+-- index will be. To make use of this type, you will generally have to use a+-- pattern-match:+--+-- > foo :: Bool -> ...+-- > foo b = case toSing b of+-- > SomeSing sb -> {- fancy dependently-typed code with sb -}+--+-- An example like the one above may be easier to write using 'withSomeSing'.+#if __GLASGOW_HASKELL__ >= 810+type SomeSing :: Type -> Type+#endif+data SomeSing k where+ SomeSing :: Sing (a :: k) -> SomeSing k++-- | An explicitly bidirectional pattern synonym for going between a+-- singleton and the corresponding demoted term.+--+-- As an __expression__: this takes a singleton to its demoted (base)+-- type.+--+-- >>> :t FromSing \@Bool+-- FromSing \@Bool :: Sing a -> Bool+-- >>> FromSing SFalse+-- False+--+-- As a __pattern__: It extracts a singleton from its demoted (base)+-- type.+--+-- @+-- singAnd :: 'Bool' -> 'Bool' -> 'SomeSing' 'Bool'+-- singAnd ('FromSing' singBool1) ('FromSing' singBool2) =+-- 'SomeSing' (singBool1 %&& singBool2)+-- @+--+-- instead of writing it with 'withSomeSing':+--+-- @+-- singAnd bool1 bool2 =+-- 'withSomeSing' bool1 $ \singBool1 ->+-- 'withSomeSing' bool2 $ \singBool2 ->+-- 'SomeSing' (singBool1 %&& singBool2)+-- @+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE FromSing #-}+#endif+pattern FromSing :: SingKind k => forall (a :: k). Sing a -> Demote k+pattern FromSing sng <- ((\demotedVal -> withSomeSing demotedVal SomeSing) -> SomeSing sng)+ where FromSing sng = fromSing sng++----------------------------------------------------------------------+---- WrappedSing -----------------------------------------------------+----------------------------------------------------------------------++-- | A newtype around 'Sing'.+--+-- Since 'Sing' is a type family, it cannot be used directly in type class+-- instances. As one example, one cannot write a catch-all+-- @instance 'SDecide' k => 'TestEquality' ('Sing' k)@. On the other hand,+-- 'WrappedSing' is a perfectly ordinary data type, which means that it is+-- quite possible to define an+-- @instance 'SDecide' k => 'TestEquality' ('WrappedSing' k)@.+#if __GLASGOW_HASKELL__ >= 810+type WrappedSing :: k -> Type+#endif+newtype WrappedSing :: forall k. k -> Type where+ WrapSing :: forall k (a :: k). { unwrapSing :: Sing a } -> WrappedSing a++-- | The singleton for 'WrappedSing's. Informally, this is the singleton type+-- for other singletons.+#if __GLASGOW_HASKELL__ >= 810+type SWrappedSing :: forall k (a :: k). WrappedSing a -> Type+#endif+newtype SWrappedSing :: forall k (a :: k). WrappedSing a -> Type where+ SWrapSing :: forall k (a :: k) (ws :: WrappedSing a).+ { sUnwrapSing :: Sing a } -> SWrappedSing ws+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(WrappedSing a) =+#else+type instance Sing =+#endif+ SWrappedSing++#if __GLASGOW_HASKELL__ >= 810+type UnwrapSing :: forall k (a :: k). WrappedSing a -> Sing a+#endif+type family UnwrapSing (ws :: WrappedSing (a :: k)) :: Sing a where+ UnwrapSing ('WrapSing s) = s++instance SingKind (WrappedSing a) where+ type Demote (WrappedSing a) = WrappedSing a+ fromSing (SWrapSing s) = WrapSing s+ toSing (WrapSing s) = SomeSing $ SWrapSing s++instance forall a (s :: Sing a). SingI a => SingI ('WrapSing s) where+ sing = SWrapSing sing++----------------------------------------------------------------------+---- SingInstance ----------------------------------------------------+----------------------------------------------------------------------++-- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling.+#if __GLASGOW_HASKELL__ >= 810+type SingInstance :: k -> Type+#endif+data SingInstance (a :: k) where+ SingInstance :: SingI a => SingInstance a++-- | Get an implicit singleton (a 'SingI' instance) from an explicit one.+singInstance :: forall k (a :: k). Sing a -> SingInstance a+singInstance s = with_sing_i SingInstance+ where+ with_sing_i :: (SingI a => SingInstance a) -> SingInstance a+#if MIN_VERSION_base(4,17,0)+ with_sing_i = withDict @(SingI a) @(Sing a) s+#else+ with_sing_i si = unsafeCoerce (Don'tInstantiate si) s++-- dirty implementation of explicit-to-implicit conversion+#if __GLASGOW_HASKELL__ >= 810+type DI :: k -> Type+#endif+newtype DI a = Don'tInstantiate (SingI a => SingInstance a)+#endif++----------------------------------------------------------------------+---- Defunctionalization ---------------------------------------------+----------------------------------------------------------------------++-- | Representation of the kind of a type-level function. The difference+-- between term-level arrows and this type-level arrow is that at the term+-- level applications can be unsaturated, whereas at the type level all+-- applications have to be fully saturated.+#if __GLASGOW_HASKELL__ >= 810+type TyFun :: Type -> Type -> Type+#endif+data TyFun :: Type -> Type -> Type++-- | Something of kind @a '~>' b@ is a defunctionalized type function that is+-- not necessarily generative or injective. Defunctionalized type functions+-- (also called \"defunctionalization symbols\") can be partially applied, even+-- if the original type function cannot be. For more information on how this+-- works, see the "Promotion and partial application" section of the+-- @<https://github.com/goldfirere/singletons/blob/master/README.md README>@.+--+-- The singleton for things of kind @a '~>' b@ is 'SLambda'. 'SLambda' values+-- can be constructed in one of two ways:+--+-- 1. With the @singFun*@ family of combinators (e.g., 'singFun1'). For+-- example, if you have:+--+-- @+-- type Id :: a -> a+-- sId :: Sing a -> Sing (Id a)+-- @+--+-- Then you can construct a value of type @'Sing' \@(a '~>' a)@ (that is,+-- @'SLambda' \@a \@a@ like so:+--+-- @+-- sIdFun :: 'Sing' \@(a '~>' a) IdSym0+-- sIdFun = singFun1 @IdSym0 sId+-- @+--+-- Where @IdSym0 :: a '~>' a@ is the defunctionlized version of @Id@.+--+-- 2. Using the 'SingI' class. For example, @'sing' \@IdSym0@ is another way of+-- defining @sIdFun@ above. The @singletons-th@ library automatically+-- generates 'SingI' instances for defunctionalization symbols such as+-- @IdSym0@.+--+-- Normal type-level arrows @(->)@ can be converted into defunctionalization+-- arrows @('~>')@ by the use of the 'TyCon' family of types. (Refer to the+-- Haddocks for 'TyCon1' to see an example of this in practice.) For this+-- reason, we do not make an effort to define defunctionalization symbols for+-- most type constructors of kind @a -> b@, as they can be used in+-- defunctionalized settings by simply applying @TyCon{N}@ with an appropriate+-- @N@.+--+-- This includes the @(->)@ type constructor itself, which is of kind+-- @'Type' -> 'Type' -> 'Type'@. One can turn it into something of kind+-- @'Type' '~>' 'Type' '~>' 'Type'@ by writing @'TyCon2' (->)@, or something of+-- kind @'Type' -> 'Type' '~>' 'Type'@ by writing @'TyCon1' ((->) t)@+-- (where @t :: 'Type'@).+#if __GLASGOW_HASKELL__ >= 810+type (~>) :: Type -> Type -> Type+#endif+type a ~> b = TyFun a b -> Type+infixr 0 ~>++-- | Type level function application+#if __GLASGOW_HASKELL__ >= 810+type Apply :: (k1 ~> k2) -> k1 -> k2+#endif+type family Apply (f :: k1 ~> k2) (x :: k1) :: k2++-- | An infix synonym for `Apply`+#if __GLASGOW_HASKELL__ >= 810+type (@@) :: (k1 ~> k2) -> k1 -> k2+#endif+type a @@ b = Apply a b+infixl 9 @@++#if __GLASGOW_HASKELL__ >= 806+-- | Workhorse for the 'TyCon1', etc., types. This can be used directly+-- in place of any of the @TyConN@ types, but it will work only with+-- /monomorphic/ types. When GHC#14645 is fixed, this should fully supersede+-- the @TyConN@ types.+--+-- Note that this is only defined on GHC 8.6 or later. Prior to GHC 8.6,+-- 'TyCon1' /et al./ were defined as separate data types.+#if __GLASGOW_HASKELL__ >= 810+type TyCon :: (k1 -> k2) -> unmatchable_fun+#endif+data family TyCon :: (k1 -> k2) -> unmatchable_fun+-- That unmatchable_fun should really be a function of k1 and k2,+-- but GHC 8.4 doesn't support type family calls in the result kind+-- of a data family. It should. See GHC#14645.++-- The result kind of this is also a bit wrong; it should line+-- up with unmatchable_fun above. However, we can't do that+-- because GHC is too stupid to remember that f's kind can't+-- have more than one argument when kind-checking the RHS of+-- the second equation. Note that this infelicity is independent+-- of the problem in the kind of TyCon. There is no GHC ticket+-- here because dealing with inequality like this is hard, and+-- I (Richard) wasn't sure what concrete value the ticket would+-- have, given that we don't know how to begin fixing it.++-- | An \"internal\" definition used primary in the 'Apply' instance for+-- 'TyCon'.+--+-- Note that this only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun)+#endif+#if __GLASGOW_HASKELL__ >= 910+type family ApplyTyCon @k1 @k2 @unmatchable_fun :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where+#else+type family ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where+#endif+#if __GLASGOW_HASKELL__ >= 808+ ApplyTyCon @k1 @(k2 -> k3) @unmatchable_fun = ApplyTyConAux2+ ApplyTyCon @k1 @k2 @k2 = ApplyTyConAux1+#else+ ApplyTyCon = (ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun))+ ApplyTyCon = (ApplyTyConAux1 :: (k1 -> k2) -> (k1 ~> k2))+#endif+-- Upon first glance, the definition of ApplyTyCon (as well as the+-- corresponding Apply instance for TyCon) seems a little indirect. One might+-- wonder why these aren't defined like so:+--+-- type family ApplyTyCon (f :: k1 -> k2) (x :: k1) :: k3 where+-- ApplyTyCon (f :: k1 -> k2 -> k3) x = TyCon (f x)+-- ApplyTyCon f x = f x+--+-- type instance Apply (TyCon f) x = ApplyTyCon f x+--+-- This also works, but it requires that ApplyTyCon always be applied to a+-- minimum of two arguments. In particular, this rules out a trick that we use+-- elsewhere in the library to write SingI instances for different TyCons,+-- which relies on partial applications of ApplyTyCon:+--+-- instance forall k1 k2 (f :: k1 -> k2).+-- ( forall a. SingI a => SingI (f a)+-- , (ApplyTyCon :: (k1 -> k2) -> (k1 ~> k2)) ~ ApplyTyConAux1+-- ) => SingI (TyCon1 f) where+#if __GLASGOW_HASKELL__ >= 808+type instance Apply @k1 @k3 (TyCon @k1 @k2 @(k1 ~> k3) f) x =+#else+type instance Apply (TyCon f) x =+#endif+ ApplyTyCon f @@ x++-- | An \"internal\" defunctionalization symbol used primarily in the+-- definition of 'ApplyTyCon', as well as the 'SingI' instances for 'TyCon1',+-- 'TyCon2', etc.+--+-- Note that this is only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyConAux1 :: (k1 -> k2) -> (k1 ~> k2)+#endif+data ApplyTyConAux1 :: (k1 -> k2) -> (k1 ~> k2)++-- | An \"internal\" defunctionalization symbol used primarily in the+-- definition of 'ApplyTyCon'.+--+-- Note that this is only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun)+#endif+data ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun)++type instance Apply (ApplyTyConAux1 f) x = f x+type instance Apply (ApplyTyConAux2 f) x = TyCon (f x)++#if __GLASGOW_HASKELL__ >= 810+type TyCon1 :: (k1 -> k2) -> (k1 ~> k2)+type TyCon2 :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3)+type TyCon3 :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4)+type TyCon4 :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5)+type TyCon5 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6)+type TyCon6 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7)+type TyCon7 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8)+type TyCon8 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9)+#endif++-- | Wrapper for converting the normal type-level arrow into a '~>'.+-- For example, given:+--+-- > data Nat = Zero | Succ Nat+-- > type family Map (a :: a ~> b) (a :: [a]) :: [b]+-- > Map f '[] = '[]+-- > Map f (x ': xs) = Apply f x ': Map f xs+--+-- We can write:+--+-- > Map (TyCon1 Succ) [Zero, Succ Zero]+#if __GLASGOW_HASKELL__ >= 910+type TyCon1 @k1 @k2 = (TyCon :: (k1 -> k2) -> (k1 ~> k2))++-- | Similar to 'TyCon1', but for two-parameter type constructors.+type TyCon2 @k1 @k2 @k3 =+ (TyCon :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3))+type TyCon3 @k1 @k2 @k3 @k4 =+ (TyCon :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4))+type TyCon4 @k1 @k2 @k3 @k4 @k5 =+ (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5))+type TyCon5 @k1 @k2 @k3 @k4 @k5 @k6 =+ (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6))+type TyCon6 @k1 @k2 @k3 @k4 @k5 @k6 @k7 =+ (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7))+type TyCon7 @k1 @k2 @k3 @k4 @k5 @k6 @k7 @k8 =+ (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8))+type TyCon8 @k1 @k2 @k3 @k4 @k5 @k6 @k7 @k8 @k9 =+ (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9))+#else+type TyCon1 = (TyCon :: (k1 -> k2) -> (k1 ~> k2))++-- | Similar to 'TyCon1', but for two-parameter type constructors.+type TyCon2 = (TyCon :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3))+type TyCon3 = (TyCon :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4))+type TyCon4 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5))+type TyCon5 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6))+type TyCon6 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7))+type TyCon7 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8))+type TyCon8 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9))+#endif+#else+-- | Wrapper for converting the normal type-level arrow into a '~>'.+-- For example, given:+--+-- > data Nat = Zero | Succ Nat+-- > type family Map (a :: a ~> b) (a :: [a]) :: [b]+-- > Map f '[] = '[]+-- > Map f (x ': xs) = Apply f x ': Map f xs+--+-- We can write:+--+-- > Map (TyCon1 Succ) [Zero, Succ Zero]+data TyCon1 :: (k1 -> k2) -> (k1 ~> k2)++-- | Similar to 'TyCon1', but for two-parameter type constructors.+data TyCon2 :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3)+data TyCon3 :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4)+data TyCon4 :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5)+data TyCon5 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6)+data TyCon6 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7)+data TyCon7 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8)+data TyCon8 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+ -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9)++type instance Apply (TyCon1 f) x = f x+type instance Apply (TyCon2 f) x = TyCon1 (f x)+type instance Apply (TyCon3 f) x = TyCon2 (f x)+type instance Apply (TyCon4 f) x = TyCon3 (f x)+type instance Apply (TyCon5 f) x = TyCon4 (f x)+type instance Apply (TyCon6 f) x = TyCon5 (f x)+type instance Apply (TyCon7 f) x = TyCon6 (f x)+type instance Apply (TyCon8 f) x = TyCon7 (f x)+#endif++----------------------------------------------------------------------+---- Defunctionalized Sing instance and utilities --------------------+----------------------------------------------------------------------++-- | The singleton type for functions. Functions have somewhat special+-- treatment in @singletons@ (see the Haddocks for @('~>')@ for more information+-- about this), and as a result, the 'Sing' instance for 'SLambda' is one of the+-- only such instances defined in the @singletons@ library rather than, say,+-- @singletons-base@.+#if __GLASGOW_HASKELL__ >= 810+type SLambda :: (k1 ~> k2) -> Type+#endif+newtype SLambda (f :: k1 ~> k2) =+ SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) }+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(k1 ~> k2) =+#else+type instance Sing =+#endif+ SLambda++-- | An infix synonym for `applySing`+(@@) :: forall k1 k2 (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t)+(@@) f = applySing f++-- | Note that this instance's 'toSing' implementation crucially relies on the fact+-- that the 'SingKind' instances for 'k1' and 'k2' both satisfy the 'SingKind' laws.+-- If they don't, 'toSing' might produce strange results!+instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where+ type Demote (k1 ~> k2) = Demote k1 -> Demote k2+ fromSing sFun x = withSomeSing x (fromSing . applySing sFun)+ toSing f = SomeSing slam+ where+ -- Here, we are essentially "manufacturing" a type-level version of the+ -- function f. As long as k1 and k2 obey the SingKind laws, this is a+ -- perfectly fine thing to do, since the computational content of Sing f+ -- will be isomorphic to that of the function f.+ slam :: forall (f :: k1 ~> k2). Sing f+ slam = singFun1 @f lam+ where+ -- Here's the tricky part. We need to demote the argument Sing, apply the+ -- term-level function f to it, and promote it back to a Sing. However,+ -- we don't have a way to convince the typechecker that for all argument+ -- types t, f @@ t should be the same thing as res, which motivates the+ -- use of unsafeCoerce.+ lam :: forall (t :: k1). Sing t -> Sing (f @@ t)+ lam x = withSomeSing (f (fromSing x)) (\(r :: Sing res) -> unsafeCoerce r)++#if __GLASGOW_HASKELL__ >= 810+type SingFunction1 :: (a1 ~> b) -> Type+type SingFunction2 :: (a1 ~> a2 ~> b) -> Type+type SingFunction3 :: (a1 ~> a2 ~> a3 ~> b) -> Type+type SingFunction4 :: (a1 ~> a2 ~> a3 ~> a4 ~> b) -> Type+type SingFunction5 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> b) -> Type+type SingFunction6 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> b) -> Type+type SingFunction7 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> b) -> Type+type SingFunction8 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> a8 ~> b) -> Type+#endif++type SingFunction1 (f :: a1 ~> b) =+ forall t. Sing t -> Sing (f @@ t)++-- | Use this function when passing a function on singletons as+-- a higher-order function. You will need visible type application+-- to get this to work. For example:+--+-- > falses = sMap (singFun1 @NotSym0 sNot)+-- > (STrue `SCons` STrue `SCons` SNil)+--+-- There are a family of @singFun...@ functions, keyed by the number+-- of parameters of the function.+singFun1 :: forall f. SingFunction1 f -> Sing f+singFun1 f = SLambda f++type SingFunction2 (f :: a1 ~> a2 ~> b) =+ forall t1 t2. Sing t1 -> Sing t2 -> Sing (f @@ t1 @@ t2)+singFun2 :: forall f. SingFunction2 f -> Sing f+singFun2 f = SLambda (\x -> singFun1 (f x))++type SingFunction3 (f :: a1 ~> a2 ~> a3 ~> b) =+ forall t1 t2 t3.+ Sing t1 -> Sing t2 -> Sing t3+ -> Sing (f @@ t1 @@ t2 @@ t3)+singFun3 :: forall f. SingFunction3 f -> Sing f+singFun3 f = SLambda (\x -> singFun2 (f x))++type SingFunction4 (f :: a1 ~> a2 ~> a3 ~> a4 ~> b) =+ forall t1 t2 t3 t4.+ Sing t1 -> Sing t2 -> Sing t3 -> Sing t4+ -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4)+singFun4 :: forall f. SingFunction4 f -> Sing f+singFun4 f = SLambda (\x -> singFun3 (f x))++type SingFunction5 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> b) =+ forall t1 t2 t3 t4 t5.+ Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5+ -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5)+singFun5 :: forall f. SingFunction5 f -> Sing f+singFun5 f = SLambda (\x -> singFun4 (f x))++type SingFunction6 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> b) =+ forall t1 t2 t3 t4 t5 t6.+ Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6+ -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6)+singFun6 :: forall f. SingFunction6 f -> Sing f+singFun6 f = SLambda (\x -> singFun5 (f x))++type SingFunction7 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> b) =+ forall t1 t2 t3 t4 t5 t6 t7.+ Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6 -> Sing t7+ -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6 @@ t7)+singFun7 :: forall f. SingFunction7 f -> Sing f+singFun7 f = SLambda (\x -> singFun6 (f x))++type SingFunction8 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> a8 ~> b) =+ forall t1 t2 t3 t4 t5 t6 t7 t8.+ Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6 -> Sing t7 -> Sing t8+ -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6 @@ t7 @@ t8)+singFun8 :: forall f. SingFunction8 f -> Sing f+singFun8 f = SLambda (\x -> singFun7 (f x))++-- | This is the inverse of 'singFun1', and likewise for the other+-- @unSingFun...@ functions.+unSingFun1 :: forall f. Sing f -> SingFunction1 f+unSingFun1 sf = applySing sf++unSingFun2 :: forall f. Sing f -> SingFunction2 f+unSingFun2 sf x = unSingFun1 (sf @@ x)++unSingFun3 :: forall f. Sing f -> SingFunction3 f+unSingFun3 sf x = unSingFun2 (sf @@ x)++unSingFun4 :: forall f. Sing f -> SingFunction4 f+unSingFun4 sf x = unSingFun3 (sf @@ x)++unSingFun5 :: forall f. Sing f -> SingFunction5 f+unSingFun5 sf x = unSingFun4 (sf @@ x)++unSingFun6 :: forall f. Sing f -> SingFunction6 f+unSingFun6 sf x = unSingFun5 (sf @@ x)++unSingFun7 :: forall f. Sing f -> SingFunction7 f+unSingFun7 sf x = unSingFun6 (sf @@ x)++unSingFun8 :: forall f. Sing f -> SingFunction8 f+unSingFun8 sf x = unSingFun7 (sf @@ x)++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE SLambda2 #-}+{-# COMPLETE SLambda3 #-}+{-# COMPLETE SLambda4 #-}+{-# COMPLETE SLambda5 #-}+{-# COMPLETE SLambda6 #-}+{-# COMPLETE SLambda7 #-}+{-# COMPLETE SLambda8 #-}+#endif++pattern SLambda2 :: forall f. SingFunction2 f -> Sing f+pattern SLambda2 {applySing2} <- (unSingFun2 -> applySing2)+ where SLambda2 lam2 = singFun2 lam2++pattern SLambda3 :: forall f. SingFunction3 f -> Sing f+pattern SLambda3 {applySing3} <- (unSingFun3 -> applySing3)+ where SLambda3 lam3 = singFun3 lam3++pattern SLambda4 :: forall f. SingFunction4 f -> Sing f+pattern SLambda4 {applySing4} <- (unSingFun4 -> applySing4)+ where SLambda4 lam4 = singFun4 lam4++pattern SLambda5 :: forall f. SingFunction5 f -> Sing f+pattern SLambda5 {applySing5} <- (unSingFun5 -> applySing5)+ where SLambda5 lam5 = singFun5 lam5++pattern SLambda6 :: forall f. SingFunction6 f -> Sing f+pattern SLambda6 {applySing6} <- (unSingFun6 -> applySing6)+ where SLambda6 lam6 = singFun6 lam6++pattern SLambda7 :: forall f. SingFunction7 f -> Sing f+pattern SLambda7 {applySing7} <- (unSingFun7 -> applySing7)+ where SLambda7 lam7 = singFun7 lam7++pattern SLambda8 :: forall f. SingFunction8 f -> Sing f+pattern SLambda8 {applySing8} <- (unSingFun8 -> applySing8)+ where SLambda8 lam8 = singFun8 lam8++----------------------------------------------------------------------+---- Convenience -----------------------------------------------------+----------------------------------------------------------------------++-- | Convenience function for creating a context with an implicit singleton+-- available.+withSingI :: Sing n -> (SingI n => r) -> r+withSingI sn r =+ case singInstance sn of+ SingInstance -> r++-- | Convert a normal datatype (like 'Bool') to a singleton for that datatype,+-- passing it into a continuation.+withSomeSing :: forall k r+ . SingKind k+ => Demote k -- ^ The original datatype+ -> (forall (a :: k). Sing a -> r) -- ^ Function expecting a singleton+ -> r+withSomeSing x f =+ case toSing x of+ SomeSing x' -> f x'++-- | Convert a group of 'SingI1' and 'SingI' constraints (representing a+-- function to apply and its argument, respectively) into a single 'SingI'+-- constraint representing the application. You will likely need the+-- @ScopedTypeVariables@ extension to use this method the way you want.+usingSingI1 :: forall f x r. (SingI1 f, SingI x) => (SingI (f x) => r) -> r+usingSingI1 k = withSingI (sing1 @f @x) k++-- | Convert a group of 'SingI2' and 'SingI' constraints (representing a+-- function to apply and its arguments, respectively) into a single 'SingI'+-- constraint representing the application. You will likely need the+-- @ScopedTypeVariables@ extension to use this method the way you want.+usingSingI2 :: forall f x y r. (SingI2 f, SingI x, SingI y) => (SingI (f x y) => r) -> r+usingSingI2 k = withSingI (sing2 @f @x @y) k++-- | A convenience function useful when we need to name a singleton value+-- multiple times. Without this function, each use of 'sing' could potentially+-- refer to a different singleton, and one has to use type signatures (often+-- with @ScopedTypeVariables@) to ensure that they are the same.+withSing :: SingI a => (Sing a -> b) -> b+withSing f = f sing++-- | A convenience function useful when we need to name a singleton value for a+-- unary type constructor multiple times. Without this function, each use of+-- 'sing1' could potentially refer to a different singleton, and one has to use+-- type signatures (often with @ScopedTypeVariables@) to ensure that they are+-- the same.+withSing1 :: (SingI1 f, SingI x) => (Sing (f x) -> b) -> b+withSing1 f = f sing1++-- | A convenience function useful when we need to name a singleton value for a+-- binary type constructor multiple times. Without this function, each use of+-- 'sing1' could potentially refer to a different singleton, and one has to use+-- type signatures (often with @ScopedTypeVariables@) to ensure that they are+-- the same.+withSing2 :: (SingI2 f, SingI x, SingI y) => (Sing (f x y) -> b) -> b+withSing2 f = f sing2++-- | A convenience function that names a singleton satisfying a certain+-- property. If the singleton does not satisfy the property, then the function+-- returns 'Nothing'. The property is expressed in terms of the underlying+-- representation of the singleton.+singThat :: forall k (a :: k). (SingKind k, SingI a)+ => (Demote k -> Bool) -> Maybe (Sing a)+singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing++-- | A convenience function that names a singleton for a unary type constructor+-- satisfying a certain property. If the singleton does not satisfy the+-- property, then the function returns 'Nothing'. The property is expressed in+-- terms of the underlying representation of the singleton.+singThat1 :: forall k1 k2 (f :: k1 -> k2) (x :: k1).+ (SingKind k2, SingI1 f, SingI x)+ => (Demote k2 -> Bool) -> Maybe (Sing (f x))+singThat1 p = withSing1 $ \x -> if p (fromSing x) then Just x else Nothing++-- | A convenience function that names a singleton for a binary type constructor+-- satisfying a certain property. If the singleton does not satisfy the+-- property, then the function returns 'Nothing'. The property is expressed in+-- terms of the underlying representation of the singleton.+singThat2 :: forall k1 k2 k3 (f :: k1 -> k2 -> k3) (x :: k1) (y :: k2).+ (SingKind k3, SingI2 f, SingI x, SingI y)+ => (Demote k3 -> Bool) -> Maybe (Sing (f x y))+singThat2 p = withSing2 $ \x -> if p (fromSing x) then Just x else Nothing++-- | Allows creation of a singleton when a proxy is at hand.+singByProxy :: SingI a => proxy a -> Sing a+singByProxy _ = sing++-- | Allows creation of a singleton for a unary type constructor when a proxy+-- is at hand.+singByProxy1 :: (SingI1 f, SingI x) => proxy (f x) -> Sing (f x)+singByProxy1 _ = sing1++-- | Allows creation of a singleton for a binary type constructor when a proxy+-- is at hand.+singByProxy2 :: (SingI2 f, SingI x, SingI y) => proxy (f x y) -> Sing (f x y)+singByProxy2 _ = sing2++-- | Allows creation of a singleton when a @proxy#@ is at hand.+singByProxy# :: SingI a => Proxy# a -> Sing a+singByProxy# _ = sing++-- | Allows creation of a singleton for a unary type constructor when a+-- @proxy#@ is at hand.+singByProxy1# :: (SingI1 f, SingI x) => Proxy# (f x) -> Sing (f x)+singByProxy1# _ = sing1++-- | Allows creation of a singleton for a binary type constructor when a+-- @proxy#@ is at hand.+singByProxy2# :: (SingI2 f, SingI x, SingI y) => Proxy# (f x y) -> Sing (f x y)+singByProxy2# _ = sing2++-- | A convenience function that takes a type as input and demotes it to its+-- value-level counterpart as output. This uses 'SingKind' and 'SingI' behind+-- the scenes, so @'demote' = 'fromSing' 'sing'@.+--+-- This function is intended to be used with @TypeApplications@. For example:+--+-- >>> demote @True+-- True+--+-- >>> demote @(Nothing :: Maybe Ordering)+-- Nothing+--+-- >>> demote @(Just EQ)+-- Just EQ+--+-- >>> demote @'(True,EQ)+-- (True,EQ)+demote ::+#if __GLASGOW_HASKELL__ >= 900+ forall {k} (a :: k). (SingKind k, SingI a) => Demote k+#else+ forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a)+#endif+demote = fromSing (sing @a)++-- | A convenience function that takes a unary type constructor and its+-- argument as input, applies them, and demotes the result to its+-- value-level counterpart as output. This uses 'SingKind', 'SingI1', and+-- 'SingI' behind the scenes, so @'demote1' = 'fromSing' 'sing1'@.+--+-- This function is intended to be used with @TypeApplications@. For example:+--+-- >>> demote1 @Just @EQ+-- Just EQ+--+-- >>> demote1 @('(,) True) @EQ+-- (True,EQ)+demote1 ::+#if __GLASGOW_HASKELL__ >= 900+ forall {k1} {k2} (f :: k1 -> k2) (x :: k1).+ (SingKind k2, SingI1 f, SingI x) =>+ Demote k2+#else+ forall f x.+ (SingKind (KindOf (f x)), SingI1 f, SingI x) =>+ Demote (KindOf (f x))+#endif+demote1 = fromSing (sing1 @f @x)++-- | A convenience function that takes a binary type constructor and its+-- arguments as input, applies them, and demotes the result to its+-- value-level counterpart as output. This uses 'SingKind', 'SingI2', and+-- 'SingI' behind the scenes, so @'demote2' = 'fromSing' 'sing2'@.+--+-- This function is intended to be used with @TypeApplications@. For example:+--+-- >>> demote2 @'(,) @True @EQ+-- (True,EQ)+demote2 ::+#if __GLASGOW_HASKELL__ >= 900+ forall {k1} {k2} {k3} (f :: k1 -> k2 -> k3) (x :: k1) (y :: k2).+ (SingKind k3, SingI2 f, SingI x, SingI y) =>+ Demote k3+#else+ forall f x y.+ (SingKind (KindOf (f x y)), SingI2 f, SingI x, SingI y) =>+ Demote (KindOf (f x y))+#endif+demote2 = fromSing (sing2 @f @x @y)++----------------------------------------------------------------------+---- SingI TyCon{N} instances ----------------------------------------+----------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 806+instance forall k1 kr (f :: k1 -> kr).+ ( forall a. SingI a => SingI (f a)+ , (ApplyTyCon :: (k1 -> kr) -> (k1 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon1 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 kr (f :: k1 -> k2 -> kr).+ ( forall a b. (SingI a, SingI b) => SingI (f a b)+ , (ApplyTyCon :: (k2 -> kr) -> (k2 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon2 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 kr (f :: k1 -> k2 -> k3 -> kr).+ ( forall a b c. (SingI a, SingI b, SingI c) => SingI (f a b c)+ , (ApplyTyCon :: (k3 -> kr) -> (k3 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon3 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 kr (f :: k1 -> k2 -> k3 -> k4 -> kr).+ ( forall a b c d. (SingI a, SingI b, SingI c, SingI d) => SingI (f a b c d)+ , (ApplyTyCon :: (k4 -> kr) -> (k4 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon4 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 kr+ (f :: k1 -> k2 -> k3 -> k4 -> k5 -> kr).+ ( forall a b c d e.+ (SingI a, SingI b, SingI c, SingI d, SingI e)+ => SingI (f a b c d e)+ , (ApplyTyCon :: (k5 -> kr) -> (k5 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon5 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 kr+ (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> kr).+ ( forall a b c d e f'.+ (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f')+ => SingI (f a b c d e f')+ , (ApplyTyCon :: (k6 -> kr) -> (k6 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon6 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 k7 kr+ (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> kr).+ ( forall a b c d e f' g.+ (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f', SingI g)+ => SingI (f a b c d e f' g)+ , (ApplyTyCon :: (k7 -> kr) -> (k7 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon7 f) where+ sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 k7 k8 kr+ (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> kr).+ ( forall a b c d e f' g h.+ (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f', SingI g, SingI h)+ => SingI (f a b c d e f' g h)+ , (ApplyTyCon :: (k8 -> kr) -> (k8 ~> kr))+ ~ ApplyTyConAux1+ ) => SingI (TyCon8 f) where+ sing = singFun1 (`withSingI` sing)+#endif++----------------------------------------------------------------------+---- Defunctionalization symbols -------------------------------------+----------------------------------------------------------------------++-- $(genDefunSymbols [''Demote, ''SameKind, ''KindOf, ''(~>), ''Apply, ''(@@)])+-- WrapSing, UnwrapSing, and SingFunction1 et al. are not defunctionalizable+-- at the moment due to GHC#9269++#if __GLASGOW_HASKELL__ >= 810+type DemoteSym0 :: Type ~> Type+type DemoteSym1 :: Type -> Type+#endif++data DemoteSym0 :: Type ~> Type+type DemoteSym1 x = Demote x++type instance Apply DemoteSym0 x = Demote x++-----++#if __GLASGOW_HASKELL__ >= 810+type SameKindSym0 :: forall k. k ~> k ~> Constraint+type SameKindSym1 :: forall k. k -> k ~> Constraint+type SameKindSym2 :: forall k. k -> k -> Constraint+#endif++data SameKindSym0 :: forall k. k ~> k ~> Constraint+data SameKindSym1 :: forall k. k -> k ~> Constraint+type SameKindSym2 (x :: k) (y :: k) = SameKind x y++type instance Apply SameKindSym0 x = SameKindSym1 x+type instance Apply (SameKindSym1 x) y = SameKind x y++-----++#if __GLASGOW_HASKELL__ >= 810+type KindOfSym0 :: forall k. k ~> Type+type KindOfSym1 :: forall k. k -> Type+#endif++data KindOfSym0 :: forall k. k ~> Type+type KindOfSym1 (x :: k) = KindOf x++type instance Apply KindOfSym0 x = KindOf x++-----++infixr 0 ~>@#@$, ~>@#@$$, ~>@#@$$$++#if __GLASGOW_HASKELL__ >= 810+type (~>@#@$) :: Type ~> Type ~> Type+type (~>@#@$$) :: Type -> Type ~> Type+type (~>@#@$$$) :: Type -> Type -> Type+#endif++data (~>@#@$) :: Type ~> Type ~> Type+data (~>@#@$$) :: Type -> Type ~> Type+type x ~>@#@$$$ y = x ~> y++type instance Apply (~>@#@$) x = (~>@#@$$) x+type instance Apply ((~>@#@$$) x) y = x ~> y++-----++#if __GLASGOW_HASKELL__ >= 810+type ApplySym0 :: forall a b. (a ~> b) ~> a ~> b+type ApplySym1 :: forall a b. (a ~> b) -> a ~> b+type ApplySym2 :: forall a b. (a ~> b) -> a -> b+#endif++data ApplySym0 :: forall a b. (a ~> b) ~> a ~> b+data ApplySym1 :: forall a b. (a ~> b) -> a ~> b+type ApplySym2 (f :: a ~> b) (x :: a) = Apply f x++type instance Apply ApplySym0 f = ApplySym1 f+type instance Apply (ApplySym1 f) x = Apply f x++-----++infixl 9 @@@#@$, @@@#@$$, @@@#@$$$++#if __GLASGOW_HASKELL__ >= 810+type (@@@#@$) :: forall a b. (a ~> b) ~> a ~> b+type (@@@#@$$) :: forall a b. (a ~> b) -> a ~> b+type (@@@#@$$$) :: forall a b. (a ~> b) -> a -> b+#endif++data (@@@#@$) :: forall a b. (a ~> b) ~> a ~> b+data (@@@#@$$) :: forall a b. (a ~> b) -> a ~> b+type (f :: a ~> b) @@@#@$$$ (x :: a) = f @@ x++type instance Apply (@@@#@$) f = (@@@#@$$) f+type instance Apply ((@@@#@$$) f) x = f @@ x++{- $SingletonsOfSingletons++Aside from being a data type to hang instances off of, 'WrappedSing' has+another purpose as a general-purpose mechanism for allowing one to write+code that uses singletons of other singletons. For instance, suppose you+had the following data type:++@+data T :: Type -> Type where+ MkT :: forall a (x :: a). 'Sing' x -> F a -> T a+@++A naïve attempt at defining a singleton for @T@ would look something like+this:++@+data ST :: forall a. T a -> Type where+ SMkT :: forall a (x :: a) (sx :: 'Sing' x) (f :: F a).+ 'Sing' sx -> 'Sing' f -> ST (MkT sx f)+@++But there is a problem here: what exactly /is/ @'Sing' sx@? If @x@ were 'True',+for instance, then @sx@ would be 'STrue', but it's not clear what+@'Sing' 'STrue'@ should be. One could define @SSBool@ to be the singleton of+'SBool's, but in order to be thorough, one would have to generate a singleton+for /every/ singleton type out there. Plus, it's not clear when to stop. Should+we also generate @SSSBool@, @SSSSBool@, etc.?++Instead, 'WrappedSing' and its singleton 'SWrappedSing' provide a way to talk+about singletons of other arbitrary singletons without the need to generate a+bazillion instances. For reference, here is the definition of 'SWrappedSing':++@+newtype 'SWrappedSing' :: forall k (a :: k). 'WrappedSing' a -> Type where+ 'SWrapSing' :: forall k (a :: k) (ws :: 'WrappedSing' a).+ { 'sUnwrapSing' :: 'Sing' a } -> 'SWrappedSing' ws+type instance 'Sing' \@('WrappedSing' a) = 'SWrappedSing'+@++'SWrappedSing' is a bit of an unusual singleton in that its field is a+singleton for @'Sing' \@k@, not @'WrappedSing' \@k@. But that's exactly the+point—a singleton of a singleton contains as much type information as the+underlying singleton itself, so we can get away with just @'Sing' \@k@.++As an example of this in action, here is how you would define the singleton+for the earlier @T@ type:++@+data ST :: forall a. T a -> Type where+ SMkT :: forall a (x :: a) (sx :: 'Sing' x) (f :: F a).+ 'Sing' ('WrapSing' sx) -> 'Sing' f -> ST (MkT sx f)+@++With this technique, we won't need anything like @SSBool@ in order to+instantiate @x@ with 'True'. Instead, the field of type+@'Sing' ('WrapSing' sx)@ will simply be a newtype around 'SBool'. In general,+you'll need /n/ layers of 'WrapSing' if you wish to single a singleton /n/+times.++Note that this is not the only possible way to define a singleton for @T@.+An alternative approach that does not make use of singletons-of-singletons is+discussed at some length+<https://github.com/goldfirere/singletons/issues/366#issuecomment-489469086 here>.+Due to the technical limitations of this approach, however, we do not use it+in @singletons@ at the moment, instead favoring the+slightly-clunkier-but-more-reliable 'WrappedSing' approach.+-}++{- $SLambdaPatternSynonyms++@SLambda{2...8}@ are explicitly bidirectional pattern synonyms for+defunctionalized singletons (@'Sing' (f :: k '~>' k' '~>' k'')@).++As __constructors__: Same as @singFun{2..8}@. For example, one can turn a+binary function on singletons @sTake :: 'SingFunction2' TakeSym0@ into a+defunctionalized singleton @'Sing' (TakeSym :: Nat '~>' [a] '~>' [a])@:++@+>>> import Data.List.Singletons >>> :set -XTypeApplications >>> >>> :t 'SLambda2'
− src/Data/Singletons/CustomStar.hs
@@ -1,151 +0,0 @@-{-# LANGUAGE DataKinds, TypeFamilies, KindSignatures, TemplateHaskell, CPP #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.CustomStar--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ This file implements 'singletonStar', which generates a datatype @Rep@ and associated--- singleton from a list of types. The promoted version of @Rep@ is kind @*@ and the--- Haskell types themselves. This is still very experimental, so expect unusual--- results!----------------------------------------------------------------------------------module Data.Singletons.CustomStar (- singletonStar,-- module Data.Singletons.Prelude.Eq,- module Data.Singletons.Prelude.Bool,- module Data.Singletons.TH- ) where--import Language.Haskell.TH-import Data.Singletons.Util-import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Ord-import Data.Singletons.Deriving.Show-import Data.Singletons.Promote-import Data.Singletons.Promote.Monad-import Data.Singletons.Single.Monad-import Data.Singletons.Single.Data-import Data.Singletons.Single-import Data.Singletons.Syntax-import Data.Singletons.Names-import Data.Singletons.TH-import Control.Monad-import Data.Maybe-import Language.Haskell.TH.Desugar-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Bool---- | Produce a representation and singleton for the collection of types given.------ A datatype @Rep@ is created, with one constructor per type in the declared--- universe. When this type is promoted by the singletons library, the--- constructors become full types in @*@, not just promoted data constructors.------ For example,------ > $(singletonStar [''Nat, ''Bool, ''Maybe])------ generates the following:------ > data Rep = Nat | Bool | Maybe Rep deriving (Eq, Ord, Read, Show)------ and its singleton. However, because @Rep@ is promoted to @*@, the singleton--- is perhaps slightly unexpected:------ > data instance Sing (a :: *) where--- > SNat :: Sing Nat--- > SBool :: Sing Bool--- > SMaybe :: Sing a -> Sing (Maybe a)------ The unexpected part is that @Nat@, @Bool@, and @Maybe@ above are the real @Nat@,--- @Bool@, and @Maybe@, not just promoted data constructors.------ Please note that this function is /very/ experimental. Use at your own risk.-singletonStar :: DsMonad q- => [Name] -- ^ A list of Template Haskell @Name@s for types- -> q [Dec]-singletonStar names = do- kinds <- mapM getKind names- ctors <- zipWithM (mkCtor True) names kinds- let repDecl = DDataD Data [] repName [] (Just (DConT typeKindName)) ctors- [DDerivClause Nothing (map DConPr [''Eq, ''Ord, ''Read, ''Show])]- fakeCtors <- zipWithM (mkCtor False) names kinds- let dataDecl = DataDecl repName [] fakeCtors- -- Why do we need withLocalDeclarations here? It's because we end up- -- expanding type synonyms when deriving instances for Rep, which requires- -- reifying Rep itself. Since Rep hasn't been spliced in yet, we must put it- -- into the local declarations.- withLocalDeclarations (decToTH repDecl) $ do- -- We opt to infer the constraints for the Eq instance here so that when it's- -- promoted, Rep will be promoted to Type.- dataDeclEqCxt <- inferConstraints (DConPr ''Eq) (DConT repName) fakeCtors- let dataDeclEqInst = DerivedDecl (Just dataDeclEqCxt) (DConT repName) dataDecl- ordInst <- mkOrdInstance Nothing (DConT repName) dataDecl- showInst <- mkShowInstance Nothing (DConT repName) dataDecl- (pInsts, promDecls) <- promoteM [] $ do promoteDataDec dataDecl- promoteDerivedEqDec dataDeclEqInst- traverse (promoteInstanceDec mempty)- [ordInst, showInst]- singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl- decs2 <- singDerivedEqDecs dataDeclEqInst- decs3 <- traverse singInstD pInsts- return (decs1 ++ decs2 ++ decs3)- return $ decsToTH $ repDecl :- promDecls ++- singletonDecls- where -- get the kinds of the arguments to the tycon with the given name- getKind :: DsMonad q => Name -> q [DKind]- getKind name = do- info <- reifyWithLocals name- dinfo <- dsInfo info- case dinfo of- DTyConI (DDataD _ (_:_) _ _ _ _ _) _ ->- fail "Cannot make a representation of a constrained data type"- DTyConI (DDataD _ [] _ tvbs mk _ _) _ -> do- all_tvbs <- buildDataDTvbs tvbs mk- return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) all_tvbs- DTyConI (DTySynD _ tvbs _) _ ->- return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) tvbs- DPrimTyConI _ n _ ->- return $ replicate n $ DConT typeKindName- _ -> fail $ "Invalid thing for representation: " ++ (show name)-- -- first parameter is whether this is a real ctor (with a fresh name)- -- or a fake ctor (when the name is actually a Haskell type)- mkCtor :: DsMonad q => Bool -> Name -> [DKind] -> q DCon- mkCtor real name args = do- (types, vars) <- evalForPair $ mapM (kindToType []) args- dataName <- if real then mkDataName (nameBase name) else return name- return $ DCon (map DPlainTV vars) [] dataName- (DNormalC False (map (\ty -> (noBang, ty)) types))- (DConT repName)- where- noBang = Bang NoSourceUnpackedness NoSourceStrictness-- -- demote a kind back to a type, accumulating any unbound parameters- kindToType :: DsMonad q => [DType] -> DKind -> QWithAux [Name] q DType- kindToType _ (DForallT _ _ _) = fail "Explicit forall encountered in kind"- kindToType args (DAppT f a) = do- a' <- kindToType [] a- kindToType (a' : args) f- kindToType args (DSigT t k) = do- t' <- kindToType [] t- k' <- kindToType [] k- return $ DSigT t' k' `foldType` args- kindToType args (DVarT n) = do- addElement n- return $ DVarT n `foldType` args- kindToType args (DConT n) = return $ DConT name `foldType` args- where name | isTypeKindName n = repName- | otherwise = n- kindToType args DArrowT = return $ DArrowT `foldType` args- kindToType args k@(DLitT {}) = return $ k `foldType` args- kindToType args DWildCardT = return $ DWildCardT `foldType` args
src/Data/Singletons/Decide.hs view
@@ -1,7 +1,16 @@-{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators,- TypeFamilies, FlexibleContexts, UndecidableInstances, GADTs #-}+{-# LANGUAGE CPP, RankNTypes, PolyKinds, DataKinds, TypeOperators,+ TypeFamilies, FlexibleContexts, UndecidableInstances,+ GADTs, TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} +#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Decide@@ -20,11 +29,12 @@ SDecide(..), -- * Supporting definitions- (:~:)(..), Void, Refuted, Decision(..)+ (:~:)(..), Void, Refuted, Decision(..),+ decideEquality, decideCoercion ) where -import Data.Kind (Type)-import Data.Singletons.Internal+import Data.Kind+import Data.Singletons import Data.Type.Coercion import Data.Type.Equality import Data.Void@@ -36,29 +46,50 @@ -- | Because we can never create a value of type 'Void', a function that type-checks -- at @a -> Void@ shows that objects of type @a@ can never exist. Thus, we say that -- @a@ is 'Refuted'+#if __GLASGOW_HASKELL__ >= 810+type Refuted :: Type -> Type+#endif type Refuted a = (a -> Void) -- | A 'Decision' about a type @a@ is either a proof of existence or a proof that @a@ -- cannot exist.+#if __GLASGOW_HASKELL__ >= 810+type Decision :: Type -> Type+#endif data Decision a = Proved a -- ^ Witness for @a@ | Disproved (Refuted a) -- ^ Proof that no @a@ exists -- | Members of the 'SDecide' "kind" class support decidable equality. Instances -- of this class are generated alongside singleton definitions for datatypes that -- derive an 'Eq' instance.+#if __GLASGOW_HASKELL__ >= 810+type SDecide :: Type -> Constraint+#endif class SDecide k where -- | Compute a proof or disproof of equality, given two singletons. (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b) infix 4 %~ -instance SDecide k => TestEquality (Sing :: k -> Type) where- testEquality a b =- case a %~ b of- Proved Refl -> Just Refl- Disproved _ -> Nothing+-- | A suitable default implementation for 'testEquality' that leverages+-- 'SDecide'.+decideEquality :: forall k (a :: k) (b :: k). SDecide k+ => Sing a -> Sing b -> Maybe (a :~: b)+decideEquality a b =+ case a %~ b of+ Proved Refl -> Just Refl+ Disproved _ -> Nothing -instance SDecide k => TestCoercion (Sing :: k -> Type) where- testCoercion a b =- case a %~ b of- Proved Refl -> Just Coercion- Disproved _ -> Nothing+instance SDecide k => TestEquality (WrappedSing :: k -> Type) where+ testEquality (WrapSing s1) (WrapSing s2) = decideEquality s1 s2++-- | A suitable default implementation for 'testCoercion' that leverages+-- 'SDecide'.+decideCoercion :: forall k (a :: k) (b :: k). SDecide k+ => Sing a -> Sing b -> Maybe (Coercion a b)+decideCoercion a b =+ case a %~ b of+ Proved Refl -> Just Coercion+ Disproved _ -> Nothing++instance SDecide k => TestCoercion (WrappedSing :: k -> Type) where+ testCoercion (WrapSing s1) (WrapSing s2) = decideCoercion s1 s2
− src/Data/Singletons/Deriving/Bounded.hs
@@ -1,59 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Bounded--- Copyright : (C) 2015 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Bounded instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Bounded where--import Language.Haskell.TH.Ppr-import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Util-import Data.Singletons.Syntax-import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Control.Monad---- monadic only for failure and parallelism with other functions--- that make instances-mkBoundedInstance :: DsMonad q => DerivDesc q-mkBoundedInstance mb_ctxt ty (DataDecl _ _ cons) = do- -- We can derive instance of Bounded if datatype is an enumeration (all- -- constructors must be nullary) or has only one constructor. See Section 11- -- of Haskell 2010 Language Report.- -- Note that order of conditions below is important.- when (null cons- || (any (\(DCon _ _ _ f _) -> not . null . tysOfConFields $ f) cons- && (not . null . tail $ cons))) $- fail ("Can't derive Bounded instance for "- ++ pprint (typeToTH ty) ++ ".")- -- at this point we know that either we have a datatype that has only one- -- constructor or a datatype where each constructor is nullary- let (DCon _ _ minName fields _) = head cons- (DCon _ _ maxName _ _) = last cons- fieldsCount = length $ tysOfConFields fields- (minRHS, maxRHS) = case fieldsCount of- 0 -> (DConE minName, DConE maxName)- _ ->- let minEqnRHS = foldExp (DConE minName)- (replicate fieldsCount (DVarE minBoundName))- maxEqnRHS = foldExp (DConE maxName)- (replicate fieldsCount (DVarE maxBoundName))- in (minEqnRHS, maxEqnRHS)-- mk_rhs rhs = UFunction [DClause [] rhs]- constraints <- inferConstraintsDef mb_ctxt (DConPr boundedName) ty cons- return $ InstDecl { id_cxt = constraints- , id_name = boundedName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [ (minBoundName, mk_rhs minRHS)- , (maxBoundName, mk_rhs maxRHS) ] }
− src/Data/Singletons/Deriving/Enum.hs
@@ -1,55 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Enum--- Copyright : (C) 2015 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Enum instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Enum ( mkEnumInstance ) where--import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Ppr-import Language.Haskell.TH.Desugar-import Data.Singletons.Deriving.Util-import Data.Singletons.Syntax-import Data.Singletons.Util-import Data.Singletons.Names-import Control.Monad-import Data.Maybe---- monadic for failure only-mkEnumInstance :: DsMonad q => DerivDesc q-mkEnumInstance mb_ctxt ty (DataDecl data_name tvbs cons) = do- let data_ty = foldTypeTvbs (DConT data_name) tvbs- non_vanilla <- isNonVanillaDataType data_ty cons- when (null cons ||- any (\(DCon _ _ _ f _) ->- non_vanilla || not (null $ tysOfConFields f)) cons) $- fail ("Can't derive Enum instance for " ++ pprint (typeToTH ty) ++ ".")- n <- qNewName "n"- let to_enum = UFunction [DClause [DVarPa n] (to_enum_rhs cons [0..])]- to_enum_rhs [] _ = DVarE errorName `DAppE` DLitE (StringL "toEnum: bad argument")- to_enum_rhs (DCon _ _ name _ _ : rest) (num:nums) =- DCaseE (DVarE equalsName `DAppE` DVarE n `DAppE` DLitE (IntegerL num))- [ DMatch (DConPa trueName []) (DConE name)- , DMatch (DConPa falseName []) (to_enum_rhs rest nums) ]- to_enum_rhs _ _ = error "Internal error: exhausted infinite list in to_enum_rhs"-- from_enum = UFunction (zipWith (\i con -> DClause [DConPa (extractName con) []]- (DLitE (IntegerL i)))- [0..] cons)- return (InstDecl { id_cxt = fromMaybe [] mb_ctxt- , id_name = singletonsEnumName- -- need to use singletons's Enum class to get the types- -- to use Nat instead of Int-- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [ (singletonsToEnumName, to_enum)- , (singletonsFromEnumName, from_enum) ] })
− src/Data/Singletons/Deriving/Foldable.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Foldable--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Foldable instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Foldable where--import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Data.Singletons.Names-import Data.Singletons.Syntax-import Language.Haskell.TH.Desugar--mkFoldableInstance :: forall q. DsMonad q => DerivDesc q-mkFoldableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do- functorLikeValidityChecks False dd- f <- newUniqueName "_f"- z <- newUniqueName "_z"- let ft_foldMap :: FFoldType (q DExp)- ft_foldMap = FT { ft_triv = mkSimpleLam $ \_ -> pure $ DVarE memptyName- -- foldMap f = \x -> mempty- , ft_var = pure $ DVarE f- -- foldMap f = f- , ft_ty_app = \_ g -> DAppE (DVarE foldMapName) <$> g- -- foldMap f = foldMap g- , ft_forall = \_ g -> g- , ft_bad_app = error "in other argument in ft_foldMap"- }-- ft_foldr :: FFoldType (q DExp)- ft_foldr = FT { ft_triv = mkSimpleLam2 $ \_ z' -> pure z'- -- foldr f = \x z -> z- , ft_var = pure $ DVarE f- -- foldr f = f- , ft_ty_app = \_ g -> do- gg <- g- mkSimpleLam2 $ \x z' -> pure $- DVarE foldrName `DAppE` gg `DAppE` z' `DAppE` x- -- foldr f = (\x z -> foldr g z x)- , ft_forall = \_ g -> g- , ft_bad_app = error "in other argument in ft_foldr"- }-- clause_for_foldMap :: [DPat] -> DCon -> [DExp] -> q DClause- clause_for_foldMap = mkSimpleConClause $ \_ -> mkFoldMap- where- -- mappend v1 (mappend v2 ..)- mkFoldMap :: [DExp] -> DExp- mkFoldMap [] = DVarE memptyName- mkFoldMap xs = foldr1 (\x y -> DVarE mappendName `DAppE` x `DAppE` y) xs-- clause_for_foldr :: [DPat] -> DCon -> [DExp] -> q DClause- clause_for_foldr = mkSimpleConClause $ \_ -> mkFoldr- where- -- g1 v1 (g2 v2 (.. z))- mkFoldr :: [DExp] -> DExp- mkFoldr = foldr DAppE (DVarE z)-- mk_foldMap_clause :: DCon -> q DClause- mk_foldMap_clause con = do- parts <- foldDataConArgs ft_foldMap con- clause_for_foldMap [DVarPa f] con =<< sequence parts-- mk_foldr_clause :: DCon -> q DClause- mk_foldr_clause con = do- parts <- foldDataConArgs ft_foldr con- clause_for_foldr [DVarPa f, DVarPa z] con =<< sequence parts-- mk_foldMap :: q [DClause]- mk_foldMap =- case cons of- [] -> pure [DClause [DWildPa, DWildPa] (DVarE memptyName)]- _ -> traverse mk_foldMap_clause cons-- mk_foldr :: q [DClause]- mk_foldr = traverse mk_foldr_clause cons-- foldMap_clauses <- mk_foldMap- foldr_clauses <- mk_foldr- let meths = (foldMapName, UFunction foldMap_clauses)- : case cons of- [] -> []- _ -> [(foldrName, UFunction foldr_clauses)]- constraints <- inferConstraintsDef mb_ctxt (DConPr foldableName) ty cons- return $ InstDecl { id_cxt = constraints- , id_name = foldableName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = meths }
− src/Data/Singletons/Deriving/Functor.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Functor--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Functor instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Functor where--import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Data.Singletons.Names-import Data.Singletons.Syntax-import Data.Singletons.Util-import Language.Haskell.TH.Desugar--mkFunctorInstance :: forall q. DsMonad q => DerivDesc q-mkFunctorInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do- functorLikeValidityChecks False dd- f <- newUniqueName "_f"- z <- newUniqueName "_z"- let ft_fmap :: FFoldType (q DExp)- ft_fmap = FT { ft_triv = mkSimpleLam pure- -- fmap f = \x -> x- , ft_var = pure $ DVarE f- -- fmap f = f- , ft_ty_app = \_ g -> DAppE (DVarE fmapName) <$> g- -- fmap f = fmap g- , ft_forall = \_ g -> g- , ft_bad_app = error "in other argument in ft_fmap"- }-- ft_replace :: FFoldType (q Replacer)- ft_replace = FT { ft_triv = fmap Nested $ mkSimpleLam pure- -- (p <$) = \x -> x- , ft_var = fmap Immediate $ mkSimpleLam $ \_ -> pure $ DVarE z- -- (p <$) = const p- , ft_ty_app = \_ gm -> do- g <- gm- case g of- Nested g' -> pure . Nested $ DVarE fmapName `DAppE` g'- Immediate _ -> pure . Nested $ DVarE replaceName `DAppE` DVarE z- -- (p <$) = fmap (p <$)- , ft_forall = \_ g -> g- , ft_bad_app = error "in other argument in ft_replace"- }-- -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ...- clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause- clause_for_con = mkSimpleConClause $ \con_name ->- foldExp (DConE con_name) -- Con x1 x2 ...-- mk_fmap_clause :: DCon -> q DClause- mk_fmap_clause con = do- parts <- foldDataConArgs ft_fmap con- clause_for_con [DVarPa f] con =<< sequence parts-- mk_replace_clause :: DCon -> q DClause- mk_replace_clause con = do- parts <- foldDataConArgs ft_replace con- clause_for_con [DVarPa z] con =<< traverse (fmap replace) parts-- mk_fmap :: q [DClause]- mk_fmap = case cons of- [] -> do v <- newUniqueName "v"- pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])]- _ -> traverse mk_fmap_clause cons-- mk_replace :: q [DClause]- mk_replace = case cons of- [] -> do v <- newUniqueName "v"- pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])]- _ -> traverse mk_replace_clause cons-- fmap_clauses <- mk_fmap- replace_clauses <- mk_replace- constraints <- inferConstraintsDef mb_ctxt (DConPr functorName) ty cons- return $ InstDecl { id_cxt = constraints- , id_name = functorName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [ (fmapName, UFunction fmap_clauses)- , (replaceName, UFunction replace_clauses)- ] }--data Replacer = Immediate { replace :: DExp }- | Nested { replace :: DExp }
− src/Data/Singletons/Deriving/Infer.hs
@@ -1,163 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Infer--- Copyright : (C) 2015 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Infers constraints for a `deriving` class----------------------------------------------------------------------------------module Data.Singletons.Deriving.Infer ( inferConstraints, inferConstraintsDef ) where--import Language.Haskell.TH.Desugar-import Language.Haskell.TH.Syntax-import Data.Singletons.Deriving.Util-import Data.Singletons.Util-import Data.List-import Data.List.NonEmpty (NonEmpty(..))-import Data.Generics.Twins---- @inferConstraints cls inst_ty cons@ infers the instance context for a--- derived type class instance of @cls@ for @inst_ty@, using the constructors--- @cons@. For instance, if @cls@ is 'Ord' and @inst_ty@ is @Either a b@, then--- that means we are attempting to derive the instance:------ @--- instance ??? => Ord (Either a b)--- @------ The role of 'inferConstraints' is to determine what @???@ should be in that--- derived instance. To accomplish this, the list of @cons@ (in this example,--- @cons@ would be @[Left a, Right b]@) is used as follows:------ 1. For each @con@ in @cons@, find the types of each of its fields--- (call these @field_tys@), perhaps after renaming the type variables of--- @field_tys@.--- 2. For each @field_ty@ in @field_tys@, apply @cls@ to @field_ty@ to obtain--- a constraint.--- 3. The final instance context is the set of all such constraints obtained--- in step 2.------ To complete the running example, this algorithm would produce the instance--- context @(Ord a, Ord b)@, since @Left a@ has one field of type @a@, and--- @Right b@ has one field of type @b@.------ This algorithm is a crude approximation of what GHC actually does when--- deriving instances. It is crude in the sense that one can end up with--- redundant constraints. For instance, if the data type for which an 'Ord'--- instance is being derived is @data Foo = MkFoo Bool Foo@, then the--- inferred constraints would be @(Ord Bool, Ord Foo)@. Technically, neither--- constraint is necessary, but it is not simple in general to eliminate--- redundant constraints like these, so we do not attept to do so. (This is--- one reason why @singletons@ requires the use of the @UndecidableInstances@--- GHC extension.)------ Observant readers will notice that the phrase \"perhaps afer renaming the--- type variables\" was casually dropped in step 1 of the above algorithm.--- For more information on what this means, refer to the documentation for--- infer_ct below.-inferConstraints :: forall q. DsMonad q => DPred -> DType -> [DCon] -> q DCxt-inferConstraints pr inst_ty = fmap (nubBy geq) . concatMapM infer_ct- where- -- A thorny situation arises when attempting to infer an instance context- -- for a GADT. Consider the following example:- --- -- newtype Bar a where- -- MkBar :: b -> Bar b- -- deriving Show- --- -- If we blindly apply 'Show' to the field type of @MkBar@, we will end up- -- with a derived instance of:- --- -- instance Show b => Show (Bar a)- --- -- This is completely wrong, since the type variable @b@ is never used in- -- the instance head! This reveals that we need a slightly more nuanced- -- strategy for gathering constraints for GADT constructors. To account- -- for this, when gathering @field_tys@ (from step 1 in the above algorithm)- -- we perform the following extra steps:- --- -- 1(a). Take the return type of @con@ and match it with @inst_ty@ (e.g.,- -- match @Bar b@ with @Bar a@). Doing so will produce a substitution- -- that maps the universally quantified type variables in the GADT- -- (i.e., @b@) to the corresponding type variables in the data type- -- constructor (i.e., @a@).- -- 1(b). Use the resulting substitution to rename the universally- -- quantified type variables of @con@ as necessary.- --- -- After this renaming, the algorithm will produce an instance context of- -- @Show a@ (since @b@ was renamed to @a@), as expected.- infer_ct :: DCon -> q DCxt- infer_ct (DCon _ _ _ fields res_ty) = do- let field_tys = tysOfConFields fields- -- We need to match the constructor's result type with the type given- -- in the generated instance. But if we have:- --- -- data Foo a where- -- MkFoo :: a -> Foo a- -- deriving Functor- --- -- Then the generated instance will be:- --- -- instance Functor Foo where ...- --- -- Which means that if we're not careful, we might try to match the- -- types (Foo a) and (Foo), which will fail.- --- -- To avoid this, we employ a grimy hack where we pad the instance- -- type with an extra (dummy) type variable. It doesn't matter what- -- we name it, since none of the inferred constraints will mention- -- it anyway.- eta_expanded_inst_ty- | is_functor_like = inst_ty `DAppT` DVarT (mkName "dummy")- | otherwise = inst_ty- res_ty' <- expandType res_ty- inst_ty' <- expandType eta_expanded_inst_ty- field_tys' <- case matchTy YesIgnore res_ty' inst_ty' of- Nothing -> fail $ showString "Unable to match type "- . showsPrec 11 res_ty'- . showString " with "- . showsPrec 11 inst_ty'- $ ""- Just subst -> traverse (substTy subst) field_tys- if is_functor_like- then mk_functor_like_constraints field_tys' res_ty'- else pure $ map (pr `DAppPr`) field_tys'-- -- If we derive a Functor-like class, e.g.,- --- -- data Foo f g h a = MkFoo (f a) (g (h a)) deriving Functor- --- -- Then we infer constraints by sticking Functor on the subtypes of kind- -- (Type -> Type). In the example above, that would give us- -- (Functor f, Functor g, Functor h).- mk_functor_like_constraints :: [DType] -> DType -> q DCxt- mk_functor_like_constraints fields res_ty = do- -- This function is partial. But that's OK, because- -- functorLikeValidityChecks ensures that this is total by the time- -- we invoke this.- let _ :| res_ty_args = unfoldType res_ty- (_, last_res_ty_arg) = snocView res_ty_args- Just last_tv = getDVarTName_maybe last_res_ty_arg- deep_subtypes <- concatMapM (deepSubtypesContaining last_tv) fields- pure $ map (pr `DAppPr`) deep_subtypes-- is_functor_like :: Bool- is_functor_like- | DConT pr_class_name :| _ <- unfoldType (predToType pr)- = isFunctorLikeClassName pr_class_name- | otherwise- = False---- For @inferConstraintsDef mb_cxt@, if @mb_cxt@ is 'Just' a context, then it will--- simply return that context. Otherwise, if @mb_cxt@ is 'Nothing', then--- 'inferConstraintsDef' will infer an instance context (using 'inferConstraints').-inferConstraintsDef :: DsMonad q => Maybe DCxt -> DPred -> DType -> [DCon] -> q DCxt-inferConstraintsDef mb_ctxt pr inst_ty cons =- maybe (inferConstraints pr inst_ty cons) pure mb_ctxt
− src/Data/Singletons/Deriving/Ord.hs
@@ -1,71 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Ord--- Copyright : (C) 2015 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Ord instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Ord ( mkOrdInstance ) where--import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Util-import Language.Haskell.TH.Syntax-import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Data.Singletons.Syntax---- | Make a *non-singleton* Ord instance-mkOrdInstance :: DsMonad q => DerivDesc q-mkOrdInstance mb_ctxt ty (DataDecl _ _ cons) = do- constraints <- inferConstraintsDef mb_ctxt (DConPr ordName) ty cons- compare_eq_clauses <- mapM mk_equal_clause cons- let compare_noneq_clauses = map (uncurry mk_nonequal_clause)- [ (con1, con2)- | con1 <- zip cons [1..]- , con2 <- zip cons [1..]- , extractName (fst con1) /=- extractName (fst con2) ]- clauses | null cons = [mk_empty_clause]- | otherwise = compare_eq_clauses ++ compare_noneq_clauses- return (InstDecl { id_cxt = constraints- , id_name = ordName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [(compareName, UFunction clauses)] })--mk_equal_clause :: Quasi q => DCon -> q DClause-mk_equal_clause (DCon _tvbs _cxt name fields _rty) = do- let tys = tysOfConFields fields- a_names <- mapM (const $ newUniqueName "a") tys- b_names <- mapM (const $ newUniqueName "b") tys- let pat1 = DConPa name (map DVarPa a_names)- pat2 = DConPa name (map DVarPa b_names)- return $ DClause [pat1, pat2] (DVarE foldlName `DAppE`- DVarE thenCmpName `DAppE`- DConE cmpEQName `DAppE`- mkListE (zipWith- (\a b -> DVarE compareName `DAppE` DVarE a- `DAppE` DVarE b)- a_names b_names))--mk_nonequal_clause :: (DCon, Int) -> (DCon, Int) -> DClause-mk_nonequal_clause (DCon _tvbs1 _cxt1 name1 fields1 _rty1, n1)- (DCon _tvbs2 _cxt2 name2 fields2 _rty2, n2) =- DClause [pat1, pat2] (case n1 `compare` n2 of- LT -> DConE cmpLTName- EQ -> DConE cmpEQName- GT -> DConE cmpGTName)- where- pat1 = DConPa name1 (map (const DWildPa) (tysOfConFields fields1))- pat2 = DConPa name2 (map (const DWildPa) (tysOfConFields fields2))---- A variant of mk_equal_clause tailored to empty datatypes-mk_empty_clause :: DClause-mk_empty_clause = DClause [DWildPa, DWildPa] (DConE cmpEQName)
− src/Data/Singletons/Deriving/Show.hs
@@ -1,162 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Show--- Copyright : (C) 2017 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Show instances---------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables #-}-module Data.Singletons.Deriving.Show (- mkShowInstance- , mkShowSingContext- ) where--import Language.Haskell.TH.Syntax hiding (showName)-import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Util-import Data.Singletons.Syntax-import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Data.Maybe (fromMaybe)-import GHC.Lexeme (startsConSym, startsVarSym)-import GHC.Show (appPrec, appPrec1)--mkShowInstance :: DsMonad q => DerivDesc q-mkShowInstance mb_ctxt ty (DataDecl _ _ cons) = do- clauses <- mk_showsPrec cons- constraints <- inferConstraintsDef mb_ctxt (DConPr showName) ty cons- return $ InstDecl { id_cxt = constraints- , id_name = showName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [ (showsPrecName, UFunction clauses) ] }--mk_showsPrec :: DsMonad q => [DCon] -> q [DClause]-mk_showsPrec cons = do- p <- newUniqueName "p" -- The precedence argument (not always used)- if null cons- then do v <- newUniqueName "v"- pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])]- else mapM (mk_showsPrec_clause p) cons--mk_showsPrec_clause :: forall q. DsMonad q- => Name -> DCon- -> q DClause-mk_showsPrec_clause p (DCon _ _ con_name con_fields _) = go con_fields- where- go :: DConFields -> q DClause-- -- No fields: print just the constructor name, with no parentheses- go (DNormalC _ []) = return $- DClause [DWildPa, DConPa con_name []] $- DVarE showStringName `DAppE` dStringE (parenInfixConName con_name "")-- -- Infix constructors have special Show treatment.- go (DNormalC True [_, _]) = do- argL <- newUniqueName "argL"- argR <- newUniqueName "argR"- fi <- fromMaybe defaultFixity <$> reifyFixityWithLocals con_name- let con_prec = case fi of Fixity prec _ -> prec- op_name = nameBase con_name- infixOpE = DAppE (DVarE showStringName) . dStringE $- if isInfixDataCon op_name- then " " ++ op_name ++ " "- -- Make sure to handle infix data constructors- -- like (Int `Foo` Int)- else " `" ++ op_name ++ "` "- return $ DClause [DVarPa p, DConPa con_name [DVarPa argL, DVarPa argR]] $- (DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p- `DAppE` dIntegerE con_prec))- `DAppE` (DVarE composeName- `DAppE` showsPrecE (con_prec + 1) argL- `DAppE` (DVarE composeName- `DAppE` infixOpE- `DAppE` showsPrecE (con_prec + 1) argR))-- go (DNormalC _ tys) = do- args <- mapM (const $ newUniqueName "arg") tys- let show_args = map (showsPrecE appPrec1) args- composed_args = foldr1 (\v q -> DVarE composeName- `DAppE` v- `DAppE` (DVarE composeName- `DAppE` DVarE showSpaceName- `DAppE` q)) show_args- named_args = DVarE composeName- `DAppE` (DVarE showStringName- `DAppE` dStringE (parenInfixConName con_name " "))- `DAppE` composed_args- return $ DClause [DVarPa p, DConPa con_name $ map DVarPa args] $- DVarE showParenName- `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec)- `DAppE` named_args-- -- We show a record constructor with no fields the same way we'd show a- -- normal constructor with no fields.- go (DRecC []) = go (DNormalC False [])-- go (DRecC tys) = do- args <- mapM (const $ newUniqueName "arg") tys- let show_args =- concatMap (\((arg_name, _, _), arg) ->- let arg_nameBase = nameBase arg_name- infix_rec = showParen (isSym arg_nameBase)- (showString arg_nameBase) ""- in [ DVarE showStringName `DAppE` dStringE (infix_rec ++ " = ")- , showsPrecE 0 arg- , DVarE showCommaSpaceName- ])- (zip tys args)- brace_comma_args = (DVarE showCharName `DAppE` dCharE '{')- : take (length show_args - 1) show_args- composed_args = foldr (\x y -> DVarE composeName `DAppE` x `DAppE` y)- (DVarE showCharName `DAppE` dCharE '}')- brace_comma_args- named_args = DVarE composeName- `DAppE` (DVarE showStringName- `DAppE` dStringE (parenInfixConName con_name " "))- `DAppE` composed_args- return $ DClause [DVarPa p, DConPa con_name $ map DVarPa args] $- DVarE showParenName- `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec)- `DAppE` named_args---- | Parenthesize an infix constructor name if it is being applied as a prefix--- function (e.g., data Amp a = (:&) a a)-parenInfixConName :: Name -> ShowS-parenInfixConName conName =- let conNameBase = nameBase conName- in showParen (isInfixDataCon conNameBase) $ showString conNameBase--showsPrecE :: Int -> Name -> DExp-showsPrecE prec n = DVarE showsPrecName `DAppE` dIntegerE prec `DAppE` DVarE n--dCharE :: Char -> DExp-dCharE c = DLitE $ StringL [c] -- There aren't type-level characters yet,- -- so fake it with a string--dStringE :: String -> DExp-dStringE = DLitE . StringL--dIntegerE :: Int -> DExp-dIntegerE = DLitE . IntegerL . fromIntegral--isSym :: String -> Bool-isSym "" = False-isSym (c : _) = startsVarSym c || startsConSym c---- | Turn a context like @('Show' a, 'Show' b)@ into @('ShowSing' a, 'ShowSing' b)@.--- This is necessary for standalone-derived 'Show' instances for singleton types.-mkShowSingContext :: DCxt -> DCxt-mkShowSingContext = map show_to_SingShow- where- show_to_SingShow :: DPred -> DPred- show_to_SingShow = modifyConNameDPred $ \n ->- if n == showName- then showSingName- else n
− src/Data/Singletons/Deriving/Traversable.hs
@@ -1,69 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Traversable--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Implements deriving of Traversable instances----------------------------------------------------------------------------------module Data.Singletons.Deriving.Traversable where--import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Util-import Data.Singletons.Names-import Data.Singletons.Syntax-import Language.Haskell.TH.Desugar--mkTraversableInstance :: forall q. DsMonad q => DerivDesc q-mkTraversableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do- functorLikeValidityChecks False dd- f <- newUniqueName "_f"- let ft_trav :: FFoldType (q DExp)- ft_trav = FT { ft_triv = pure $ DVarE pureName- -- traverse f = pure x- , ft_var = pure $ DVarE f- -- traverse f = f x- , ft_ty_app = \_ g -> DAppE (DVarE traverseName) <$> g- -- traverse f = traverse g- , ft_forall = \_ g -> g- , ft_bad_app = error "in other argument in ft_trav"- }-- -- Con a1 a2 ... -> Con <$> g1 a1 <*> g2 a2 <*> ...- clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause- clause_for_con = mkSimpleConClause $ \con_name -> mkApCon (DConE con_name)- where- -- ((Con <$> x1) <*> x2) <*> ...- mkApCon :: DExp -> [DExp] -> DExp- mkApCon con [] = DVarE pureName `DAppE` con- mkApCon con [x] = DVarE fmapName `DAppE` con `DAppE` x- mkApCon con (x1:x2:xs) =- foldl appAp (DVarE liftA2Name `DAppE` con `DAppE` x1 `DAppE` x2) xs- where appAp x y = DVarE apName `DAppE` x `DAppE` y-- mk_trav_clause :: DCon -> q DClause- mk_trav_clause con = do- parts <- foldDataConArgs ft_trav con- clause_for_con [DVarPa f] con =<< sequence parts-- mk_trav :: q [DClause]- mk_trav = case cons of- [] -> do v <- newUniqueName "v"- pure [DClause [DWildPa, DVarPa v]- (DVarE pureName `DAppE` DCaseE (DVarE v) [])]- _ -> traverse mk_trav_clause cons-- trav_clauses <- mk_trav- constraints <- inferConstraintsDef mb_ctxt (DConPr traversableName) ty cons- return $ InstDecl { id_cxt = constraints- , id_name = traversableName- , id_arg_tys = [ty]- , id_sigs = mempty- , id_meths = [ (traverseName, UFunction trav_clauses) ] }
− src/Data/Singletons/Deriving/Util.hs
@@ -1,313 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Deriving.Util--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Utilities used by the `deriving` machinery in singletons.---------------------------------------------------------------------------------module Data.Singletons.Deriving.Util where--import Control.Monad-import Data.List-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Set as Set-import Data.Singletons.Names-import Data.Singletons.Syntax-import Data.Singletons.Util-import Language.Haskell.TH.Desugar-import Language.Haskell.TH.Syntax---- A generic type signature for describing how to produce a derived instance.-type DerivDesc q- = Maybe DCxt -- (Just ctx) if ctx was provided via StandaloneDeriving.- -- Nothing if using a deriving clause.- -> DType -- The data type argument to the class.- -> DataDecl -- The original data type information.- -> q UInstDecl -- The derived instance.---- | Is this data type a non-vanilla data type? Here, \"non-vanilla\" refers to--- any data type that cannot be expressed using Haskell98 syntax. For instance,--- this GADT:------ @--- data Foo :: Type -> Type where--- MkFoo :: forall a. a -> Foo a--- @------ Is equivalent to this Haskell98 data type:------ @--- data Foo a = MkFoo a--- @------ However, the following GADT is non-vanilla:------ @--- data Bar :: Type -> Type where--- MkBar :: Int -> Bar Int--- @------ Since there is no equivalent Haskell98 data type. The closest you could get--- is this:------ @--- data Bar a = (a ~ Int) => MkBar Int--- @------ Which requires language extensions to write.------ A data type is a non-vanilla if one of the following conditions are met:------ 1. A constructor has any existentially quantified type variables.------ 2. A constructor has a context.------ We care about this because some derivable stock classes, such as 'Enum',--- forbid derived instances for non-vanilla data types.-isNonVanillaDataType :: forall q. DsMonad q => DType -> [DCon] -> q Bool-isNonVanillaDataType data_ty = anyM $ \con@(DCon _ ctxt _ _ _) -> do- ex_tvbs <- conExistentialTvbs data_ty con- return $ not $ null ex_tvbs && null ctxt- where- anyM :: (a -> q Bool) -> [a] -> q Bool- anyM _ [] = return False- anyM p (x:xs) = do- b <- p x- if b then return True else anyM p xs---------- Utilities for deriving Functor-like classes.--- Much of this was cargo-culted from the GHC source code.--------data FFoldType a -- Describes how to fold over a DType in a functor like way- = FT { ft_triv :: a- -- ^ Does not contain variable- , ft_var :: a- -- ^ The variable itself- , ft_ty_app :: DType -> a -> a- -- ^ Type app, variable only in last argument- , ft_bad_app :: a- -- ^ Type app, variable other than in last argument- , ft_forall :: [DTyVarBndr] -> a -> a- -- ^ Forall type- }---- Note that in GHC, this function is pure. It must be monadic here since we:------ (1) Expand type synonyms--- (2) Detect type family applications------ Which require reification in Template Haskell, but are pure in Core.-functorLikeTraverse :: forall q a.- DsMonad q- => Name -- ^ Variable to look for- -> FFoldType a -- ^ How to fold- -> DType -- ^ Type to process- -> q a-functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar- , ft_ty_app = caseTyApp, ft_bad_app = caseWrongArg- , ft_forall = caseForAll })- ty- = do ty' <- expandType ty- (res, _) <- go ty'- pure res- where- go :: DType- -> q (a, Bool) -- (result of type a, does type contain var)- go (DAppT f x) = do- (_, fc) <- go f- if fc- then pure (caseWrongArg, True)- else do (xr, xc) <- go x- if xc- then let tyApp :: q (a, Bool)- tyApp = pure (caseTyApp f xr, True)-- inspect :: DType -> q (a, Bool)- inspect (DConT n) = do- itf <- isTyFamilyName n- if itf -- We can't decompose type families, so- -- error if we encounter one here.- then pure (caseWrongArg, True)- else tyApp- inspect (DForallT _ _ t) = inspect t- inspect (DSigT t _) = inspect t- inspect (DAppT t _) = inspect t- inspect (DVarT {}) = tyApp- inspect DArrowT = tyApp- inspect (DLitT {}) = tyApp- inspect DWildCardT = tyApp-- in case unfoldType f of- f_head :| _ -> inspect f_head- else trivial- go (DSigT t k) = do- (_, kc) <- go k- if kc- then pure (caseWrongArg, True)- else go t- go (DVarT v)- | v == var = pure (caseVar, True)- | otherwise = trivial- go (DForallT tvbs _ t) = do- (tr, tc) <- go t- if var `notElem` map extractTvbName tvbs && tc- then pure (caseForAll tvbs tr, True)- else trivial- go (DConT {}) = trivial- go DArrowT = trivial- go (DLitT {}) = trivial- go DWildCardT = trivial-- trivial :: q (a, Bool)- trivial = pure (caseTrivial, False)--isTyFamilyName :: DsMonad q => Name -> q Bool-isTyFamilyName n = do- info <- dsReify n- pure $ case info of- Just (DTyConI dec _)- | DOpenTypeFamilyD{} <- dec -> True- | DClosedTypeFamilyD{} <- dec -> True- _ -> False---- A crude approximation of cond_functorOK from GHC. This checks that:------ (1) There's at least one type variable in the data type.--- (2) It doesn't use the last type variable in the wrong place, e.g. data T a = MkT (X a a)--- (3) It doesn't constrain the last type variable, e.g., data T a = Eq a => MkT a-functorLikeValidityChecks :: forall q. DsMonad q => Bool -> DataDecl -> q ()-functorLikeValidityChecks allowConstrainedLastTyVar (DataDecl n data_tvbs cons)- | null data_tvbs -- (1)- = fail $ "Data type " ++ nameBase n ++ " must have some type parameters"- | otherwise- = mapM_ check_con cons- where- check_con :: DCon -> q ()- check_con con = do- check_universal con- checks <- foldDataConArgs (ft_check (extractName con)) con- sequence_ checks-- -- (2)- check_universal :: DCon -> q ()- check_universal con@(DCon con_tvbs con_theta con_name _ res_ty)- | allowConstrainedLastTyVar- = pure ()- | _ :| res_ty_args <- unfoldType res_ty- , (_, last_res_ty_arg) <- snocView res_ty_args- , Just last_tv <- getDVarTName_maybe last_res_ty_arg- = do ex_tvbs <- conExistentialTvbs (foldTypeTvbs (DConT n) data_tvbs) con- let univ_tvb_names = map extractTvbName con_tvbs \\ map extractTvbName ex_tvbs- if last_tv `elem` univ_tvb_names- && last_tv `Set.notMember` foldMap (fvDType . predToType) con_theta- then pure ()- else fail $ badCon con_name existential- | otherwise- = fail $ badCon con_name existential-- -- (3)- ft_check :: Name -> FFoldType (q ())- ft_check con_name =- FT { ft_triv = pure ()- , ft_var = pure ()- , ft_ty_app = \_ x -> x- , ft_bad_app = fail $ badCon con_name wrong_arg- , ft_forall = \_ x -> x- }-- badCon :: Name -> String -> String- badCon con_name msg = "Constructor " ++ nameBase con_name ++ " " ++ msg-- existential, wrong_arg :: String- existential = "must be truly polymorphic in the last argument of the data type"- wrong_arg = "must use the type variable only as the last argument of a data type"---- Return all syntactic subterms of a type that contain the given variable somewhere.--- These are the things that should appear in Functor-like instance constraints.-deepSubtypesContaining :: DsMonad q => Name -> DType -> q [DType]-deepSubtypesContaining tv- = functorLikeTraverse tv- (FT { ft_triv = []- , ft_var = []- , ft_ty_app = (:)- , ft_bad_app = error "in other argument in deepSubtypesContaining"- , ft_forall = \tvbs xs -> filter (\x -> all (not_in_ty x) tvbs) xs })- where- not_in_ty :: DType -> DTyVarBndr -> Bool- not_in_ty ty tvb = extractTvbName tvb `Set.notMember` fvDType ty---- Fold over the arguments of a data constructor in a Functor-like way.-foldDataConArgs :: forall q a. DsMonad q => FFoldType a -> DCon -> q [a]-foldDataConArgs ft (DCon _ _ _ fields res_ty) = do- field_tys <- traverse expandType $ tysOfConFields fields- traverse foldArg field_tys- where- foldArg :: DType -> q a- foldArg- | _ :| res_ty_args <- unfoldType res_ty- , (_, last_res_ty_arg) <- snocView res_ty_args- , Just last_tv <- getDVarTName_maybe last_res_ty_arg- = functorLikeTraverse last_tv ft- | otherwise- = const (return (ft_triv ft))---- If a type is a type variable (or a variable with a kind signature), return--- 'Just' that. Otherwise, return 'Nothing'.-getDVarTName_maybe :: DType -> Maybe Name-getDVarTName_maybe (DSigT t _) = getDVarTName_maybe t-getDVarTName_maybe (DVarT n) = Just n-getDVarTName_maybe _ = Nothing---- Make a 'DLamE' using a fresh variable.-mkSimpleLam :: Quasi q => (DExp -> q DExp) -> q DExp-mkSimpleLam lam = do- n <- newUniqueName "n"- body <- lam (DVarE n)- return $ DLamE [n] body---- Make a 'DLamE' using two fresh variables.-mkSimpleLam2 :: Quasi q => (DExp -> DExp -> q DExp) -> q DExp-mkSimpleLam2 lam = do- n1 <- newUniqueName "n1"- n2 <- newUniqueName "n2"- body <- lam (DVarE n1) (DVarE n2)- return $ DLamE [n1, n2] body---- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]"------ @mkSimpleConClause fold extra_pats con insides@ produces a match clause in--- which the LHS pattern-matches on @extra_pats@, followed by a match on the--- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@--- and its arguments, applying an expression (from @insides@) to each of the--- respective arguments of @con@.-mkSimpleConClause :: Quasi q- => (Name -> [DExp] -> DExp)- -> [DPat]- -> DCon- -> [DExp]- -> q DClause-mkSimpleConClause fold extra_pats (DCon _ _ con_name _ _) insides = do- vars_needed <- replicateM (length insides) $ newUniqueName "a"- let pat = DConPa con_name (map DVarPa vars_needed)- rhs = fold con_name (zipWith (\i v -> i `DAppE` DVarE v) insides vars_needed)- pure $ DClause (extra_pats ++ [pat]) rhs---- 'True' if the derived class's last argument is of kind (Type -> Type),--- and thus needs a different constraint inference approach.------ Really, we should be determining this information by inspecting the kind--- of the class being used. But that comes dangerously close to kind--- inference territory, so for now we simply hardcode which stock derivable--- classes are Functor-like.-isFunctorLikeClassName :: Name -> Bool-isFunctorLikeClassName class_name- = class_name `elem` [functorName, foldableName, traversableName]
− src/Data/Singletons/Internal.hs
@@ -1,430 +0,0 @@-{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds,- FlexibleContexts, FlexibleInstances,- TypeFamilies, TypeOperators, TypeFamilyDependencies,- UndecidableInstances, ConstraintKinds,- ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes,- PatternSynonyms, ViewPatterns #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Internal--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ This module exports the basic definitions to use singletons. This module--- exists since we need to define instances for 'SomeSing' in--- "Data.Singletons", as defining them elsewhere would almost inevitably lead--- to import cycles.----------------------------------------------------------------------------------module Data.Singletons.Internal (- module Data.Singletons.Internal- , Proxy(..)- ) where--import Data.Kind (Type)-import Unsafe.Coerce-import Data.Proxy ( Proxy(..) )-import GHC.Exts ( Proxy#, Constraint )---- | Convenient synonym to refer to the kind of a type variable:--- @type KindOf (a :: k) = k@-type KindOf (a :: k) = k---- | Force GHC to unify the kinds of @a@ and @b@. Note that @SameKind a b@ is--- different from @KindOf a ~ KindOf b@ in that the former makes the kinds--- unify immediately, whereas the latter is a proposition that GHC considers--- as possibly false.-type SameKind (a :: k) (b :: k) = (() :: Constraint)----------------------------------------------------------------------------- Sing & friends ----------------------------------------------------------------------------------------------------------------------------- | The singleton kind-indexed data family.-data family Sing :: k -> Type---- | A 'SingI' constraint is essentially an implicitly-passed singleton.--- If you need to satisfy this constraint with an explicit singleton, please--- see 'withSingI' or the 'Sing' pattern synonym.-class SingI a where- -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@- -- extension to use this method the way you want.- sing :: Sing a---- | An explicitly bidirectional pattern synonym for implicit singletons.------ As an __expression__: Constructs a singleton @Sing a@ given a--- implicit singleton constraint @SingI a@.------ As a __pattern__: Matches on an explicit @Sing a@ witness bringing--- an implicit @SingI a@ constraint into scope.-{-# COMPLETE Sing #-}-pattern Sing :: forall k (a :: k). () => SingI a => Sing a-pattern Sing <- (singInstance -> SingInstance)- where Sing = sing---- | The 'SingKind' class is a /kind/ class. It classifies all kinds--- for which singletons are defined. The class supports converting between a singleton--- type and the base (unrefined) type which it is built from.------ For a 'SingKind' instance to be well behaved, it should obey the following laws:------ @--- 'toSing' . 'fromSing' ≡ 'SomeSing'--- (\\x -> 'withSomeSing' x 'fromSing') ≡ 'id'--- @------ The final law can also be expressed in terms of the 'FromSing' pattern--- synonym:------ @--- (\\('FromSing' sing) -> 'FromSing' sing) ≡ 'id'--- @-class SingKind k where- -- | Get a base type from the promoted kind. For example,- -- @Demote Bool@ will be the type @Bool@. Rarely, the type and kind do not- -- match. For example, @Demote Nat@ is @Natural@.- type Demote k = (r :: Type) | r -> k-- -- | Convert a singleton to its unrefined version.- fromSing :: Sing (a :: k) -> Demote k-- -- | Convert an unrefined type to an existentially-quantified singleton type.- toSing :: Demote k -> SomeSing k---- | An /existentially-quantified/ singleton. This type is useful when you want a--- singleton type, but there is no way of knowing, at compile-time, what the type--- index will be. To make use of this type, you will generally have to use a--- pattern-match:------ > foo :: Bool -> ...--- > foo b = case toSing b of--- > SomeSing sb -> {- fancy dependently-typed code with sb -}------ An example like the one above may be easier to write using 'withSomeSing'.-data SomeSing k where- SomeSing :: Sing (a :: k) -> SomeSing k---- | An explicitly bidirectional pattern synonym for going between a--- singleton and the corresponding demoted term.------ As an __expression__: this takes a singleton to its demoted (base)--- type.------ >>> :t FromSing \@Bool--- FromSing \@Bool :: Sing a -> Bool--- >>> FromSing SFalse--- False------ As a __pattern__: It extracts a singleton from its demoted (base)--- type.------ @--- singAnd :: 'Bool' -> 'Bool' -> 'SomeSing' 'Bool'--- singAnd ('FromSing' singBool1) ('FromSing' singBool2) =--- 'SomeSing' (singBool1 %&& singBool2)--- @------ instead of writing it with 'withSomeSing':------ @--- singAnd bool1 bool2 =--- 'withSomeSing' bool1 $ \singBool1 ->--- 'withSomeSing' bool2 $ \singBool2 ->--- 'SomeSing' (singBool1 %&& singBool2)--- @-{-# COMPLETE FromSing #-}-pattern FromSing :: SingKind k => forall (a :: k). Sing a -> Demote k-pattern FromSing sng <- ((\demotedVal -> withSomeSing demotedVal SomeSing) -> SomeSing sng)- where FromSing sng = fromSing sng----------------------------------------------------------------------------- SingInstance ------------------------------------------------------------------------------------------------------------------------------- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling.-data SingInstance (a :: k) where- SingInstance :: SingI a => SingInstance a---- dirty implementation of explicit-to-implicit conversion-newtype DI a = Don'tInstantiate (SingI a => SingInstance a)---- | Get an implicit singleton (a 'SingI' instance) from an explicit one.-singInstance :: forall k (a :: k). Sing a -> SingInstance a-singInstance s = with_sing_i SingInstance- where- with_sing_i :: (SingI a => SingInstance a) -> SingInstance a- with_sing_i si = unsafeCoerce (Don'tInstantiate si) s----------------------------------------------------------------------------- Defunctionalization ------------------------------------------------------------------------------------------------------------------------ | Representation of the kind of a type-level function. The difference--- between term-level arrows and this type-level arrow is that at the term--- level applications can be unsaturated, whereas at the type level all--- applications have to be fully saturated.-data TyFun :: Type -> Type -> Type---- | Something of kind `a ~> b` is a defunctionalized type function that is--- not necessarily generative or injective.-type a ~> b = TyFun a b -> Type-infixr 0 ~>---- | Type level function application-type family Apply (f :: k1 ~> k2) (x :: k1) :: k2---- | An infix synonym for `Apply`-type a @@ b = Apply a b-infixl 9 @@---- | Workhorse for the 'TyCon1', etc., types. This can be used directly--- in place of any of the @TyConN@ types, but it will work only with--- /monomorphic/ types. When GHC#14645 is fixed, this should fully supersede--- the @TyConN@ types.-data family TyCon :: (k1 -> k2) -> unmatchable_fun--- That unmatchable_fun should really be a function of k1 and k2,--- but GHC 8.4 doesn't support type family calls in the result kind--- of a data family. It should. See GHC#14645.---- The result kind of this is also a bit wrong; it should line--- up with unmatchable_fun above. However, we can't do that--- because GHC is too stupid to remember that f's kind can't--- have more than one argument when kind-checking the RHS of--- the second equation. Note that this infelicity is independent--- of the problem in the kind of TyCon. There is no GHC ticket--- here because dealing with inequality like this is hard, and--- I (Richard) wasn't sure what concrete value the ticket would--- have, given that we don't know how to begin fixing it.-type family ApplyTyCon (f :: k1 -> k2) (x :: k1) :: k3 where- ApplyTyCon (f :: k1 -> k2 -> k3) x = TyCon (f x)- ApplyTyCon f x = f x--type instance Apply (TyCon f) x = ApplyTyCon f x---- | Wrapper for converting the normal type-level arrow into a '~>'.--- For example, given:------ > data Nat = Zero | Succ Nat--- > type family Map (a :: a ~> b) (a :: [a]) :: [b]--- > Map f '[] = '[]--- > Map f (x ': xs) = Apply f x ': Map f xs------ We can write:------ > Map (TyCon1 Succ) [Zero, Succ Zero]-type TyCon1 = (TyCon :: (k1 -> k2) -> (k1 ~> k2))---- | Similar to 'TyCon1', but for two-parameter type constructors.-type TyCon2 = (TyCon :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3))-type TyCon3 = (TyCon :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4))-type TyCon4 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5))-type TyCon5 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)- -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6))-type TyCon6 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)- -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7))-type TyCon7 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)- -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8))-type TyCon8 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)- -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9))----------------------------------------------------------------------------- Defunctionalized Sing instance and utilities ---------------------------------------------------------------------------------------------newtype instance Sing (f :: k1 ~> k2) =- SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) }---- | An infix synonym for `applySing`-(@@) :: forall k1 k2 (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t)-(@@) = applySing---- | Note that this instance's 'toSing' implementation crucially relies on the fact--- that the 'SingKind' instances for 'k1' and 'k2' both satisfy the 'SingKind' laws.--- If they don't, 'toSing' might produce strange results!-instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where- type Demote (k1 ~> k2) = Demote k1 -> Demote k2- fromSing sFun x = withSomeSing x (fromSing . applySing sFun)- toSing f = SomeSing slam- where- -- Here, we are essentially "manufacturing" a type-level version of the- -- function f. As long as k1 and k2 obey the SingKind laws, this is a- -- perfectly fine thing to do, since the computational content of Sing f- -- will be isomorphic to that of the function f.- slam :: forall (f :: k1 ~> k2). Sing f- slam = singFun1 @f lam- where- -- Here's the tricky part. We need to demote the argument Sing, apply the- -- term-level function f to it, and promote it back to a Sing. However,- -- we don't have a way to convince the typechecker that for all argument- -- types t, f @@ t should be the same thing as res, which motivates the- -- use of unsafeCoerce.- lam :: forall (t :: k1). Sing t -> Sing (f @@ t)- lam x = withSomeSing (f (fromSing x)) (\(r :: Sing res) -> unsafeCoerce r)--type SingFunction1 f = forall t. Sing t -> Sing (f @@ t)---- | Use this function when passing a function on singletons as--- a higher-order function. You will need visible type application--- to get this to work. For example:------ > falses = sMap (singFun1 @NotSym0 sNot)--- > (STrue `SCons` STrue `SCons` SNil)------ There are a family of @singFun...@ functions, keyed by the number--- of parameters of the function.-singFun1 :: forall f. SingFunction1 f -> Sing f-singFun1 f = SLambda f--type SingFunction2 f = forall t. Sing t -> SingFunction1 (f @@ t)-singFun2 :: forall f. SingFunction2 f -> Sing f-singFun2 f = SLambda (\x -> singFun1 (f x))--type SingFunction3 f = forall t. Sing t -> SingFunction2 (f @@ t)-singFun3 :: forall f. SingFunction3 f -> Sing f-singFun3 f = SLambda (\x -> singFun2 (f x))--type SingFunction4 f = forall t. Sing t -> SingFunction3 (f @@ t)-singFun4 :: forall f. SingFunction4 f -> Sing f-singFun4 f = SLambda (\x -> singFun3 (f x))--type SingFunction5 f = forall t. Sing t -> SingFunction4 (f @@ t)-singFun5 :: forall f. SingFunction5 f -> Sing f-singFun5 f = SLambda (\x -> singFun4 (f x))--type SingFunction6 f = forall t. Sing t -> SingFunction5 (f @@ t)-singFun6 :: forall f. SingFunction6 f -> Sing f-singFun6 f = SLambda (\x -> singFun5 (f x))--type SingFunction7 f = forall t. Sing t -> SingFunction6 (f @@ t)-singFun7 :: forall f. SingFunction7 f -> Sing f-singFun7 f = SLambda (\x -> singFun6 (f x))--type SingFunction8 f = forall t. Sing t -> SingFunction7 (f @@ t)-singFun8 :: forall f. SingFunction8 f -> Sing f-singFun8 f = SLambda (\x -> singFun7 (f x))---- | This is the inverse of 'singFun1', and likewise for the other--- @unSingFun...@ functions.-unSingFun1 :: forall f. Sing f -> SingFunction1 f-unSingFun1 sf = applySing sf--unSingFun2 :: forall f. Sing f -> SingFunction2 f-unSingFun2 sf x = unSingFun1 (sf @@ x)--unSingFun3 :: forall f. Sing f -> SingFunction3 f-unSingFun3 sf x = unSingFun2 (sf @@ x)--unSingFun4 :: forall f. Sing f -> SingFunction4 f-unSingFun4 sf x = unSingFun3 (sf @@ x)--unSingFun5 :: forall f. Sing f -> SingFunction5 f-unSingFun5 sf x = unSingFun4 (sf @@ x)--unSingFun6 :: forall f. Sing f -> SingFunction6 f-unSingFun6 sf x = unSingFun5 (sf @@ x)--unSingFun7 :: forall f. Sing f -> SingFunction7 f-unSingFun7 sf x = unSingFun6 (sf @@ x)--unSingFun8 :: forall f. Sing f -> SingFunction8 f-unSingFun8 sf x = unSingFun7 (sf @@ x)--{-# COMPLETE SLambda2 #-}-pattern SLambda2 :: forall f. SingFunction2 f -> Sing f-pattern SLambda2 {applySing2} <- (unSingFun2 -> applySing2)- where SLambda2 lam2 = singFun2 lam2--{-# COMPLETE SLambda3 #-}-pattern SLambda3 :: forall f. SingFunction3 f -> Sing f-pattern SLambda3 {applySing3} <- (unSingFun3 -> applySing3)- where SLambda3 lam3 = singFun3 lam3--{-# COMPLETE SLambda4 #-}-pattern SLambda4 :: forall f. SingFunction4 f -> Sing f-pattern SLambda4 {applySing4} <- (unSingFun4 -> applySing4)- where SLambda4 lam4 = singFun4 lam4--{-# COMPLETE SLambda5 #-}-pattern SLambda5 :: forall f. SingFunction5 f -> Sing f-pattern SLambda5 {applySing5} <- (unSingFun5 -> applySing5)- where SLambda5 lam5 = singFun5 lam5--{-# COMPLETE SLambda6 #-}-pattern SLambda6 :: forall f. SingFunction6 f -> Sing f-pattern SLambda6 {applySing6} <- (unSingFun6 -> applySing6)- where SLambda6 lam6 = singFun6 lam6--{-# COMPLETE SLambda7 #-}-pattern SLambda7 :: forall f. SingFunction7 f -> Sing f-pattern SLambda7 {applySing7} <- (unSingFun7 -> applySing7)- where SLambda7 lam7 = singFun7 lam7--{-# COMPLETE SLambda8 #-}-pattern SLambda8 :: forall f. SingFunction8 f -> Sing f-pattern SLambda8 {applySing8} <- (unSingFun8 -> applySing8)- where SLambda8 lam8 = singFun8 lam8----------------------------------------------------------------------------- Convenience -------------------------------------------------------------------------------------------------------------------------------- | Convenience function for creating a context with an implicit singleton--- available.-withSingI :: Sing n -> (SingI n => r) -> r-withSingI sn r =- case singInstance sn of- SingInstance -> r---- | Convert a normal datatype (like 'Bool') to a singleton for that datatype,--- passing it into a continuation.-withSomeSing :: forall k r- . SingKind k- => Demote k -- ^ The original datatype- -> (forall (a :: k). Sing a -> r) -- ^ Function expecting a singleton- -> r-withSomeSing x f =- case toSing x of- SomeSing x' -> f x'---- | A convenience function useful when we need to name a singleton value--- multiple times. Without this function, each use of 'sing' could potentially--- refer to a different singleton, and one has to use type signatures (often--- with @ScopedTypeVariables@) to ensure that they are the same.-withSing :: SingI a => (Sing a -> b) -> b-withSing f = f sing---- | A convenience function that names a singleton satisfying a certain--- property. If the singleton does not satisfy the property, then the function--- returns 'Nothing'. The property is expressed in terms of the underlying--- representation of the singleton.-singThat :: forall k (a :: k). (SingKind k, SingI a)- => (Demote k -> Bool) -> Maybe (Sing a)-singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing---- | Allows creation of a singleton when a proxy is at hand.-singByProxy :: SingI a => proxy a -> Sing a-singByProxy _ = sing---- | Allows creation of a singleton when a @proxy#@ is at hand.-singByProxy# :: SingI a => Proxy# a -> Sing a-singByProxy# _ = sing---- | A convenience function that takes a type as input and demotes it to its--- value-level counterpart as output. This uses 'SingKind' and 'SingI' behind--- the scenes, so @'demote' = 'fromSing' 'sing'@.------ This function is intended to be used with @TypeApplications@. For example:------ >>> demote @True--- True------ >>> demote @(Nothing :: Maybe Ordering)--- Nothing-demote :: forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a)-demote = fromSing (sing @a)
− src/Data/Singletons/Names.hs
@@ -1,362 +0,0 @@-{- Data/Singletons/Names.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--Defining names and manipulations on names for use in promotion and singling.--}--{-# LANGUAGE TemplateHaskell #-}--module Data.Singletons.Names where--import Data.Singletons.Internal-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.Decide-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Desugar-import GHC.TypeLits ( Nat, Symbol )-import GHC.Exts ( Constraint )-import GHC.Show ( showCommaSpace, showSpace )-import Data.Typeable ( TypeRep )-import Data.Singletons.Util-import Control.Applicative-import Control.Monad--boolName, andName, tyEqName, compareName, minBoundName,- maxBoundName, repName,- nilName, consName, listName, tyFunArrowName,- applyName, natName, symbolName, typeRepName, stringName,- eqName, ordName, boundedName, orderingName,- singFamilyName, singIName, singMethName, demoteName,- singKindClassName, sEqClassName, sEqMethName, sconsName, snilName, strueName,- sIfName,- someSingTypeName, someSingDataName,- sListName, sDecideClassName, sDecideMethName,- provedName, disprovedName, reflName, toSingName, fromSingName,- equalityName, applySingName, suppressClassName, suppressMethodName,- thenCmpName,- sameKindName, tyFromIntegerName, tyNegateName, sFromIntegerName,- sNegateName, errorName, foldlName, cmpEQName, cmpLTName, cmpGTName,- singletonsToEnumName, singletonsFromEnumName, enumName, singletonsEnumName,- equalsName, constraintName,- showName, showCharName, showCommaSpaceName, showParenName, showsPrecName,- showSpaceName, showStringName, showSingName,- composeName, gtName, tyFromStringName, sFromStringName,- foldableName, foldMapName, memptyName, mappendName, foldrName,- functorName, fmapName, replaceName,- traversableName, traverseName, pureName, apName, liftA2Name :: Name-boolName = ''Bool-andName = '(&&)-compareName = 'compare-minBoundName = 'minBound-maxBoundName = 'maxBound-tyEqName = mk_name_tc "Data.Singletons.Prelude.Eq" "=="-repName = mkName "Rep" -- this is actually defined in client code!-nilName = '[]-consName = '(:)-listName = ''[]-tyFunArrowName = ''(~>)-applyName = ''Apply-symbolName = ''Symbol-natName = ''Nat-typeRepName = ''TypeRep-stringName = ''String-eqName = ''Eq-ordName = ''Ord-boundedName = ''Bounded-orderingName = ''Ordering-singFamilyName = ''Sing-singIName = ''SingI-singMethName = 'sing-toSingName = 'toSing-fromSingName = 'fromSing-demoteName = ''Demote-singKindClassName = ''SingKind-sEqClassName = mk_name_tc "Data.Singletons.Prelude.Eq" "SEq"-sEqMethName = mk_name_v "Data.Singletons.Prelude.Eq" "%=="-sIfName = mk_name_v "Data.Singletons.Prelude.Bool" "sIf"-sconsName = mk_name_d "Data.Singletons.Prelude.Instances" "SCons"-snilName = mk_name_d "Data.Singletons.Prelude.Instances" "SNil"-strueName = mk_name_d "Data.Singletons.Prelude.Instances" "STrue"-someSingTypeName = ''SomeSing-someSingDataName = 'SomeSing-sListName = mk_name_tc "Data.Singletons.Prelude.Instances" "SList"-sDecideClassName = ''SDecide-sDecideMethName = '(%~)-provedName = 'Proved-disprovedName = 'Disproved-reflName = 'Refl-equalityName = ''(~)-applySingName = 'applySing-suppressClassName = ''SuppressUnusedWarnings-suppressMethodName = 'suppressUnusedWarnings-thenCmpName = mk_name_v "Data.Singletons.Prelude.Ord" "thenCmp"-sameKindName = ''SameKind-tyFromIntegerName = mk_name_tc "Data.Singletons.Prelude.Num" "FromInteger"-tyNegateName = mk_name_tc "Data.Singletons.Prelude.Num" "Negate"-sFromIntegerName = mk_name_v "Data.Singletons.Prelude.Num" "sFromInteger"-sNegateName = mk_name_v "Data.Singletons.Prelude.Num" "sNegate"-errorName = 'error-foldlName = 'foldl-cmpEQName = 'EQ-cmpLTName = 'LT-cmpGTName = 'GT-singletonsToEnumName = mk_name_v "Data.Singletons.Prelude.Enum" "toEnum"-singletonsFromEnumName = mk_name_v "Data.Singletons.Prelude.Enum" "fromEnum"-enumName = ''Enum-singletonsEnumName = mk_name_tc "Data.Singletons.Prelude.Enum" "Enum"-equalsName = '(==)-constraintName = ''Constraint-showName = ''Show-showCharName = 'showChar-showParenName = 'showParen-showSpaceName = 'showSpace-showsPrecName = 'showsPrec-showStringName = 'showString-showSingName = mk_name_tc "Data.Singletons.ShowSing" "ShowSing"-composeName = '(.)-gtName = '(>)-showCommaSpaceName = 'showCommaSpace-tyFromStringName = mk_name_tc "Data.Singletons.Prelude.IsString" "FromString"-sFromStringName = mk_name_v "Data.Singletons.Prelude.IsString" "sFromString"-foldableName = ''Foldable-foldMapName = 'foldMap-memptyName = 'mempty-mappendName = 'mappend-foldrName = 'foldr-functorName = ''Functor-fmapName = 'fmap-replaceName = '(<$)-traversableName = ''Traversable-traverseName = 'traverse-pureName = 'pure-apName = '(<*>)-liftA2Name = 'liftA2--singPkg :: String-singPkg = $( (LitE . StringL . loc_package) `liftM` location )--mk_name_tc :: String -> String -> Name-mk_name_tc = mkNameG_tc singPkg--mk_name_d :: String -> String -> Name-mk_name_d = mkNameG_d singPkg--mk_name_v :: String -> String -> Name-mk_name_v = mkNameG_v singPkg--mkTupleTypeName :: Int -> Name-mkTupleTypeName n = mk_name_tc "Data.Singletons.Prelude.Instances" $- "STuple" ++ (show n)--mkTupleDataName :: Int -> Name-mkTupleDataName n = mk_name_d "Data.Singletons.Prelude.Instances" $- "STuple" ++ (show n)---- used when a value name appears in a pattern context--- works only for proper variables (lower-case names)-promoteValNameLhs :: Name -> Name-promoteValNameLhs = promoteValNameLhsPrefix noPrefix---- like promoteValNameLhs, but adds a prefix to the promoted name-promoteValNameLhsPrefix :: (String, String) -> Name -> Name-promoteValNameLhsPrefix pres@(alpha, symb) n- | nameBase n == "."- = mkName $ symb ++ ":."- | nameBase n == "!"- = mkName $ symb ++ ":!"- -- See Note [Special cases for (.) and (!)]-- -- We can't promote promote idenitifers beginning with underscores to- -- type names, so we work around the issue by prepending "US" at the- -- front of the name (#229).- | Just (us, rest) <- splitUnderscores (nameBase n)- = mkName $ alpha ++ "US" ++ us ++ rest-- | otherwise- = mkName $ toUpcaseStr pres n---- used when a value name appears in an expression context--- works for both variables and datacons-promoteValRhs :: Name -> DType-promoteValRhs name- | name == nilName- = DConT nilName -- workaround for #21-- | otherwise- = DConT $ promoteTySym name 0---- generates type-level symbol for a given name. Int parameter represents--- saturation: 0 - no parameters passed to the symbol, 1 - one parameter--- passed to the symbol, and so on. Works on both promoted and unpromoted--- names.-promoteTySym :: Name -> Int -> Name-promoteTySym name sat- | nameBase name == ":."- = default_case (mkName ".")- | nameBase name == ":!"- = default_case (mkName "!")- -- Although (:.) and (:!) are special cases, we need not have a colon in- -- front of their defunctionalization symbols, since only the names- -- (.) and (!) are problematic for the parser.- -- See Note [Special cases for (.) and (!)]-- -- We can't promote promote idenitifers beginning with underscores to- -- type names, so we work around the issue by prepending "US" at the- -- front of the name (#229).- | Just (us, rest) <- splitUnderscores (nameBase name)- = default_case (mkName $ "US" ++ us ++ rest)-- | name == nilName- = mkName $ "NilSym" ++ (show sat)-- -- treat unboxed tuples like tuples- | Just degree <- tupleNameDegree_maybe name `mplus`- unboxedTupleNameDegree_maybe name- = mk_name_tc "Data.Singletons.Prelude.Instances" $- "Tuple" ++ show degree ++ "Sym" ++ (show sat)-- | otherwise- = default_case name- where- default_case :: Name -> Name- default_case name' =- let capped = toUpcaseStr noPrefix name' in- if isHsLetter (head capped)- then mkName (capped ++ "Sym" ++ (show sat))- else mkName (capped ++ "@#@" -- See Note [Defunctionalization symbol suffixes]- ++ (replicate (sat + 1) '$'))--promoteClassName :: Name -> Name-promoteClassName = prefixName "P" "#"--mkTyName :: Quasi q => Name -> q Name-mkTyName tmName = do- let nameStr = nameBase tmName- symbolic = not (isHsLetter (head nameStr))- qNewName (if symbolic then "ty" else nameStr)--mkTyConName :: Int -> Name-mkTyConName i = mk_name_tc "Data.Singletons.Internal" $ "TyCon" ++ show i--falseTySym :: DType-falseTySym = promoteValRhs falseName--trueTySym :: DType-trueTySym = promoteValRhs trueName--boolKi :: DKind-boolKi = DConT boolName--andTySym :: DType-andTySym = promoteValRhs andName---- Singletons--singDataConName :: Name -> Name-singDataConName nm- | nm == nilName = snilName- | nm == consName = sconsName- | Just degree <- tupleNameDegree_maybe nm = mkTupleDataName degree- | Just degree <- unboxedTupleNameDegree_maybe nm = mkTupleDataName degree- | otherwise = prefixConName "S" "%" nm--singTyConName :: Name -> Name-singTyConName name- | name == listName = sListName- | Just degree <- tupleNameDegree_maybe name = mkTupleTypeName degree- | Just degree <- unboxedTupleNameDegree_maybe name = mkTupleTypeName degree- | otherwise = prefixName "S" "%" name--singClassName :: Name -> Name-singClassName = singTyConName--singValName :: Name -> Name-singValName n- -- Push the 's' past the underscores, as this lets us avoid some unused- -- variable warnings (#229).- | Just (us, rest) <- splitUnderscores (nameBase n)- = prefixName (us ++ "s") "%" $ mkName rest- | otherwise- = prefixName "s" "%" $ upcase n--singFamily :: DType-singFamily = DConT singFamilyName--singKindConstraint :: DKind -> DPred-singKindConstraint = DAppPr (DConPr singKindClassName)--demote :: DType-demote = DConT demoteName--apply :: DType -> DType -> DType-apply t1 t2 = DAppT (DAppT (DConT applyName) t1) t2--mkListE :: [DExp] -> DExp-mkListE =- foldr (\h t -> DConE consName `DAppE` h `DAppE` t) (DConE nilName)---- apply a type to a list of types using Apply type family--- This is defined here, not in Utils, to avoid cyclic dependencies-foldApply :: DType -> [DType] -> DType-foldApply = foldl apply---- make and equality predicate-mkEqPred :: DType -> DType -> DPred-mkEqPred ty1 ty2 = foldPred (DConPr equalityName) [ty1, ty2]---- | If a 'String' begins with one or more underscores, return--- @'Just' (us, rest)@, where @us@ contain all of the underscores at the--- beginning of the 'String' and @rest@ contains the remainder of the 'String'.--- Otherwise, return 'Nothing'.-splitUnderscores :: String -> Maybe (String, String)-splitUnderscores s = case span (== '_') s of- ([], _) -> Nothing- res -> Just res---- Walk a DPred, applying a function to all occurrences of constructor names.-modifyConNameDPred :: (Name -> Name) -> DPred -> DPred-modifyConNameDPred mod_con_name = go- where- go (DForallPr tvbs cxt p) = DForallPr tvbs (map go cxt) (go p)- go (DAppPr p t) = DAppPr (go p) t- go (DSigPr p k) = DSigPr (go p) k- go p@(DVarPr _) = p- go (DConPr n) = DConPr (mod_con_name n)- go p@DWildCardPr = p--{--Note [Defunctionalization symbol suffixes]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Before, we used to denote defunctionalization symbols by simply appending dollar-signs at the end (e.g., (+$) and (+$$)). But this can lead to ambiguity when you-have function names that consist of solely $ characters. For instance, if you-tried to promote ($) and ($$) simultaneously, you'd get these promoted types:--$-$$--And these defunctionalization symbols:--$$-$$$--But now there's a name clash between the promoted type for ($) and the-defunctionalization symbol for ($$)! The solution is to use a precede these-defunctionalization dollar signs with another string (we choose @#@).-So now the new defunctionalization symbols would be:--$@#@$-$@#@$$--And there is no conflict.--Note [Special cases for (.) and (!)]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Almost every infix value name can be promoted trivially. For example, (+) works-both at the value- and type-level. The two exceptions to this rule are (.) and (!),-which we promote to the special type names (:.) and (:!), respectively.-This is necessary since one cannot define or apply (.) or (!) at the type level ---they simply won't parse. Bummer.--}
− src/Data/Singletons/Partition.hs
@@ -1,306 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Partition--- Copyright : (C) 2015 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Partitions a list of declarations into its bits----------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}--module Data.Singletons.Partition where--import Prelude hiding ( exp )-import Data.Singletons.Syntax-import Data.Singletons.Deriving.Ord-import Data.Singletons.Deriving.Bounded-import Data.Singletons.Deriving.Enum-import Data.Singletons.Deriving.Foldable-import Data.Singletons.Deriving.Functor-import Data.Singletons.Deriving.Show-import Data.Singletons.Deriving.Traversable-import Data.Singletons.Deriving.Util-import Data.Singletons.Names-import Language.Haskell.TH.Syntax hiding (showName)-import Language.Haskell.TH.Ppr-import Language.Haskell.TH.Desugar-import Data.Singletons.Util--import Control.Monad-import Data.Bifunctor (bimap)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Map as Map-import Data.Map (Map)-import Data.Maybe-import Data.Semigroup (Semigroup(..))--data PartitionedDecs =- PDecs { pd_let_decs :: [DLetDec]- , pd_class_decs :: [UClassDecl]- , pd_instance_decs :: [UInstDecl]- , pd_data_decs :: [DataDecl]- , pd_ty_syn_decs :: [TySynDecl]- , pd_open_type_family_decs :: [OpenTypeFamilyDecl]- , pd_closed_type_family_decs :: [ClosedTypeFamilyDecl]- , pd_derived_eq_decs :: [DerivedEqDecl]- , pd_derived_show_decs :: [DerivedShowDecl]- }--instance Semigroup PartitionedDecs where- PDecs a1 b1 c1 d1 e1 f1 g1 h1 i1 <> PDecs a2 b2 c2 d2 e2 f2 g2 h2 i2 =- PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) (e1 <> e2) (f1 <> f2)- (g1 <> g2) (h1 <> h2) (i1 <> i2)--instance Monoid PartitionedDecs where- mempty = PDecs [] [] [] [] [] [] [] [] []- mappend = (<>)---- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances--- from deriving clauses-partitionDecs :: DsMonad m => [DDec] -> m PartitionedDecs-partitionDecs = concatMapM partitionDec--partitionDec :: DsMonad m => DDec -> m PartitionedDecs-partitionDec (DLetDec (DPragmaD {})) = return mempty-partitionDec (DLetDec letdec) = return $ mempty { pd_let_decs = [letdec] }--partitionDec (DDataD _nd _cxt name tvbs mk cons derivings) = do- all_tvbs <- buildDataDTvbs tvbs mk- let data_decl = DataDecl name all_tvbs cons- derived_dec = mempty { pd_data_decs = [data_decl] }- derived_decs- <- mapM (\(strat, deriv_pred) ->- let etad_tvbs- | DConT pred_name :| _ <- unfoldType deriv_pred- , isFunctorLikeClassName pred_name- -- If deriving Functor, Foldable, or Traversable,- -- we need to use one less type variable than we normally do.- = take (length all_tvbs - 1) all_tvbs- | otherwise- = all_tvbs- ty = foldTypeTvbs (DConT name) etad_tvbs- in partitionDeriving strat deriv_pred Nothing ty data_decl)- $ concatMap flatten_clause derivings- return $ mconcat $ derived_dec : derived_decs- where- flatten_clause :: DDerivClause -> [(Maybe DDerivStrategy, DType)]- flatten_clause (DDerivClause strat preds) =- map (\p -> (strat, predToType p)) preds--partitionDec (DClassD cxt name tvbs fds decs) = do- (lde, otfs) <- concatMapM partitionClassDec decs- return $ mempty { pd_class_decs = [ClassDecl { cd_cxt = cxt- , cd_name = name- , cd_tvbs = tvbs- , cd_fds = fds- , cd_lde = lde }]- , pd_open_type_family_decs = otfs }-partitionDec (DInstanceD _ cxt ty decs) = do- (defns, sigs) <- liftM (bimap catMaybes mconcat) $- mapAndUnzipM partitionInstanceDec decs- (name, tys) <- split_app_tys [] ty- return $ mempty { pd_instance_decs = [InstDecl { id_cxt = cxt- , id_name = name- , id_arg_tys = tys- , id_sigs = sigs- , id_meths = defns }] }- where- split_app_tys acc (DAppT t1 t2) = split_app_tys (t2:acc) t1- split_app_tys acc (DConT name) = return (name, acc)- split_app_tys acc (DSigT t _) = split_app_tys acc t- split_app_tys _ _ = fail $ "Illegal instance head: " ++ show ty-partitionDec (DRoleAnnotD {}) = return mempty -- ignore these-partitionDec (DTySynD name tvbs _type) =- -- See Note [Partitioning, type synonyms, and type families]- pure $ mempty { pd_ty_syn_decs = [TySynDecl name tvbs] }-partitionDec (DClosedTypeFamilyD tf_head _) =- -- See Note [Partitioning, type synonyms, and type families]- pure $ mempty { pd_closed_type_family_decs = [TypeFamilyDecl tf_head] }-partitionDec (DOpenTypeFamilyD tf_head) =- -- See Note [Partitioning, type synonyms, and type families]- pure $ mempty { pd_open_type_family_decs = [TypeFamilyDecl tf_head] }-partitionDec (DTySynInstD {}) = pure mempty- -- There's no need to track type family instances, since- -- we already record the type family itself separately.-partitionDec (DStandaloneDerivD mb_strat ctxt ty) =- case unfoldType ty of- cls_pred_ty :| cls_tys- | not (null cls_tys) -- We can't handle zero-parameter type classes- , let cls_arg_tys = init cls_tys- data_ty = last cls_tys- data_ty_head = case unfoldType data_ty of ty_head :| _ -> ty_head- , DConT data_tycon <- data_ty_head -- We can't handle deriving an instance for something- -- other than a type constructor application- -> do let cls_pred = foldType cls_pred_ty cls_arg_tys- dinfo <- dsReify data_tycon- case dinfo of- Just (DTyConI (DDataD _ _ dn dtvbs dk dcons _) _) -> do- all_tvbs <- buildDataDTvbs dtvbs dk- let data_decl = DataDecl dn all_tvbs dcons- partitionDeriving mb_strat cls_pred (Just ctxt) data_ty data_decl- Just _ ->- fail $ "Standalone derived instance for something other than a datatype: "- ++ show data_ty- _ -> fail $ "Cannot find " ++ show data_ty- _ -> return mempty-partitionDec dec =- fail $ "Declaration cannot be promoted: " ++ pprint (decToTH dec)--partitionClassDec :: Monad m => DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl])-partitionClassDec (DLetDec (DSigD name ty)) =- pure (typeBinding name ty, mempty)-partitionClassDec (DLetDec (DValD (DVarPa name) exp)) =- pure (valueBinding name (UValue exp), mempty)-partitionClassDec (DLetDec (DFunD name clauses)) =- pure (valueBinding name (UFunction clauses), mempty)-partitionClassDec (DLetDec (DInfixD fixity name)) =- pure (infixDecl fixity name, mempty)-partitionClassDec (DLetDec (DPragmaD {})) =- pure (mempty, mempty)-partitionClassDec (DOpenTypeFamilyD tf_head) =- -- See Note [Partitioning, type synonyms, and type families]- pure (mempty, [TypeFamilyDecl tf_head])-partitionClassDec (DTySynInstD {}) =- -- There's no need to track associated type family default equations, since- -- we already record the type family itself separately.- pure (mempty, mempty)-partitionClassDec _ =- fail "Only method declarations can be promoted within a class."--partitionInstanceDec :: Monad m => DDec- -> m ( Maybe (Name, ULetDecRHS) -- right-hand sides of methods- , Map Name DType -- method type signatures- )-partitionInstanceDec (DLetDec (DValD (DVarPa name) exp)) =- pure (Just (name, UValue exp), mempty)-partitionInstanceDec (DLetDec (DFunD name clauses)) =- pure (Just (name, UFunction clauses), mempty)-partitionInstanceDec (DLetDec (DSigD name ty)) =- pure (Nothing, Map.singleton name ty)-partitionInstanceDec (DLetDec (DPragmaD {})) =- pure (Nothing, mempty)-partitionInstanceDec (DTySynInstD {}) =- pure (Nothing, mempty)- -- There's no need to track associated type family instances, since- -- we already record the type family itself separately.-partitionInstanceDec _ =- fail "Only method bodies can be promoted within an instance."--partitionDeriving- :: forall m. DsMonad m- => Maybe DDerivStrategy- -- ^ The deriving strategy, if present.- -> DType -- ^ The class being derived (e.g., 'Eq'), possibly applied to- -- some number of arguments (e.g., @C Int Bool@).- -> Maybe DCxt -- ^ @'Just' ctx@ if @ctx@ was provided via @StandaloneDeriving@.- -- 'Nothing' if using a @deriving@ clause.- -> DType -- ^ The data type argument to the class.- -> DataDecl -- ^ The original data type information (e.g., its constructors).- -> m PartitionedDecs-partitionDeriving mb_strat deriv_pred mb_ctxt ty data_decl =- case unfoldType deriv_pred of- DConT deriv_name :| arg_tys- -- Here, we are more conservative than GHC: DeriveAnyClass only kicks- -- in if the user explicitly chooses to do so with the anyclass- -- deriving strategy- | Just DAnyclassStrategy <- mb_strat- -> return $ mk_derived_inst- InstDecl { id_cxt = fromMaybe [] mb_ctxt- -- For now at least, there's no point in attempting to- -- infer an instance context for DeriveAnyClass, since- -- the other language feature that requires it,- -- DefaultSignatures, can't be singled. Thus, inferring an- -- empty context will Just Work for all currently supported- -- default implementations.- --- -- (Of course, if a user specifies a context with- -- StandaloneDeriving, use that.)-- , id_name = deriv_name- , id_arg_tys = arg_tys ++ [ty]- , id_sigs = mempty- , id_meths = [] }-- | Just DNewtypeStrategy <- mb_strat- -> do qReportWarning "GeneralizedNewtypeDeriving is ignored by `singletons`."- return mempty-- | Just (DViaStrategy {}) <- mb_strat- -> do qReportWarning "DerivingVia is ignored by `singletons`."- return mempty-- -- Stock classes. These are derived only if `singletons` supports them- -- (and, optionally, if an explicit stock deriving strategy is used)- DConT deriv_name :| [] -- For now, all stock derivable class supported in- -- singletons take just one argument (the data- -- type itself)- | stock_or_default- , Just decs <- Map.lookup deriv_name stock_map- -> decs-- -- If we can't find a stock class, but the user bothered to use an- -- explicit stock keyword, we can at least warn them about it.- | Just DStockStrategy <- mb_strat- -> do qReportWarning $ "`singletons` doesn't recognize the stock class "- ++ nameBase deriv_name- return mempty-- _ -> return mempty -- singletons doesn't support deriving this instance- where- mk_instance :: DerivDesc m -> m UInstDecl- mk_instance maker = maker mb_ctxt ty data_decl-- mk_derived_inst dec = mempty { pd_instance_decs = [dec] }- mk_derived_eq_inst dec = mempty { pd_derived_eq_decs = [dec] }- derived_decl = DerivedDecl { ded_mb_cxt = mb_ctxt- , ded_type = ty- , ded_decl = data_decl }- stock_or_default = isStockOrDefault mb_strat-- -- A mapping from all stock derivable classes (that singletons supports)- -- to to derived code that they produce.- stock_map :: Map Name (m PartitionedDecs)- stock_map = Map.fromList- [ ( ordName, mk_derived_inst <$> mk_instance mkOrdInstance )- , ( boundedName, mk_derived_inst <$> mk_instance mkBoundedInstance )- , ( enumName, mk_derived_inst <$> mk_instance mkEnumInstance )- , ( functorName, mk_derived_inst <$> mk_instance mkFunctorInstance )- , ( foldableName, mk_derived_inst <$> mk_instance mkFoldableInstance )- , ( traversableName, mk_derived_inst <$> mk_instance mkTraversableInstance )- -- See Note [DerivedDecl] in Data.Singletons.Syntax- , ( eqName, return $ mk_derived_eq_inst derived_decl )- -- See Note [DerivedDecl] in Data.Singletons.Syntax- , ( showName, do -- These will become PShow/SShow instances...- inst_for_promotion <- mk_instance mkShowInstance- -- ...and this will become a Show instance.- let inst_for_show = derived_decl- pure $ mempty { pd_instance_decs = [inst_for_promotion]- , pd_derived_show_decs = [inst_for_show] } )- ]---- Is this being used with an explicit stock strategy, or no strategy at all?-isStockOrDefault :: Maybe DDerivStrategy -> Bool-isStockOrDefault Nothing = True-isStockOrDefault (Just DStockStrategy) = True-isStockOrDefault (Just _) = False--{--Note [Partitioning, type synonyms, and type families]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The process of singling does not produce any new declarations corresponding to-type synonyms or type families, so they are "ignored" in a sense. Nevertheless,-we explicitly track them during partitioning, since we want to create-defunctionalization symbols for them.--Also note that:--1. Other uses of type synonyms in singled code will be expanded away.-2. Other uses of type families in singled code are unlikely to work at present- due to Trac #12564.--}
− src/Data/Singletons/Prelude.hs
@@ -1,279 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Mimics the Haskell Prelude, but with singleton types. Includes the basic--- singleton definitions. Note: This is currently very incomplete!------ Because many of these definitions are produced by Template Haskell, it is--- not possible to create proper Haddock documentation. Also, please excuse--- the apparent repeated variable names. This is due to an interaction between--- Template Haskell and Haddock.----------------------------------------------------------------------------------{-# LANGUAGE ExplicitNamespaces #-}-module Data.Singletons.Prelude (- -- * Basic singleton definitions- module Data.Singletons,-- Sing(SFalse, STrue, SNil, SCons, SJust, SNothing, SLeft, SRight, SLT, SEQ, SGT,- STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7),-- -- * Singleton type synonyms-- -- | These synonyms are all kind-restricted synonyms of 'Sing'.- -- For example 'SBool' requires an argument of kind 'Bool'.- SBool, SList, SMaybe, SEither, SOrdering,- STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7,-- -- * Functions working with 'Bool'- If, sIf, Not, sNot, type (&&), type (||), (%&&), (%||), Otherwise, sOtherwise,-- -- * Error reporting- Error, sError,- ErrorWithoutStackTrace, sErrorWithoutStackTrace,- Undefined, sUndefined,-- -- * Singleton equality- module Data.Singletons.Prelude.Eq,-- -- * Singleton comparisons- POrd(..), SOrd(..),-- -- * Singleton Enum and Bounded- -- | As a matter of convenience, the singletons Prelude does /not/ export- -- promoted/singletonized @succ@ and @pred@, due to likely conflicts with- -- unary numbers. Please import 'Data.Singletons.Prelude.Enum' directly if- -- you want these.- module Data.Singletons.Prelude.Enum,-- -- * Singletons numbers- module Data.Singletons.Prelude.Num,- type (^), (%^),-- -- * Singleton 'Show'- PShow(..), SShow(..), ShowS, SChar,- Shows, sShows, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen,-- -- * Singleton 'Semigroup' and 'Monoid'- PSemigroup(type (<>)), SSemigroup((%<>)),- PMonoid(..), SMonoid(..),-- -- * Singleton 'Functor', 'Applicative', and 'Monad'- PFunctor(Fmap, type (<$)), SFunctor(sFmap, (%<$)), type (<$>), (%<$>),- PApplicative(Pure, type (<*>), type (*>), type (<*)),- SApplicative(sPure, (%<*>), (%*>), (%<*)),- PMonad(type (>>=), type (>>), Return, Fail),- SMonad((%>>=), (%>>), sReturn, sFail),- MapM_, sMapM_,- Sequence_, sSequence_,- type (=<<), (%=<<),-- -- * Singleton 'Foldable' and 'Traversable'- PFoldable(Elem, FoldMap, Foldr, Foldl, Foldr1, Foldl1,- Maximum, Minimum, Product, Sum),- SFoldable(sElem, sFoldMap, sFoldr, sFoldl, sFoldr1, sFoldl1,- sMaximum, sMinimum, sProduct, sSum),- PTraversable(Traverse, SequenceA, MapM, Sequence),- STraversable(sTraverse, sSequenceA, sMapM, sSequence),-- -- ** Miscellaneous functions- Id, sId, Const, sConst, (:.), (%.), type ($), (%$), type ($!), (%$!),- Flip, sFlip, AsTypeOf, sAsTypeOf,- Seq, sSeq,-- -- * List operations- Map, sMap, type (++), (%++), Filter, sFilter,- Head, sHead, Last, sLast, Tail, sTail,- Init, sInit, Null, sNull, Reverse, sReverse,- -- *** Special folds- And, sAnd, Or, sOr, Any, sAny, All, sAll,- Concat, sConcat, ConcatMap, sConcatMap,- -- *** Scans- Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1,- -- *** Infinite lists- Replicate, sReplicate,- -- ** Sublists- Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile,- Span, sSpan, Break, sBreak,- -- ** Searching lists- NotElem, sNotElem, Lookup, sLookup,- -- ** Zipping and unzipping lists- Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3,- Unzip, sUnzip, Unzip3, sUnzip3,- -- ** Functions on 'Symbol's- Unlines, sUnlines, Unwords, sUnwords,-- -- * Other datatypes- Maybe_, sMaybe_,- Either_, sEither_,- Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry,- Symbol,-- -- * Other functions- either_, -- reimplementation of either to be used with singletons library- maybe_,- bool_,- show_,-- -- * Defunctionalization symbols- FalseSym0, TrueSym0,- NotSym0, NotSym1,- type (&&@#@$), type (&&@#@$$), type (&&@#@$$$),- type (||@#@$), type (||@#@$$), type (||@#@$$$),- OtherwiseSym0,-- NothingSym0, JustSym0, JustSym1,- Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3,-- LeftSym0, LeftSym1, RightSym0, RightSym1,- Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3,-- Tuple0Sym0,- Tuple2Sym0, Tuple2Sym1, Tuple2Sym2,- Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3,- Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4,- Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5,- Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6,- Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7,- FstSym0, FstSym1, SndSym0, SndSym1,- CurrySym0, CurrySym1, CurrySym2, CurrySym3,- UncurrySym0, UncurrySym1, UncurrySym2,-- ErrorSym0, ErrorSym1,- ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,- UndefinedSym0,-- LTSym0, EQSym0, GTSym0,- CompareSym0, CompareSym1, CompareSym2,- type (<@#@$), type (<@#@$$), type (<@#@$$$),- type (<=@#@$), type (<=@#@$$), type (<=@#@$$$),- type (>@#@$), type (>@#@$$), type (>@#@$$$),- type (>=@#@$), type (>=@#@$$), type (>=@#@$$$),- MaxSym0, MaxSym1, MaxSym2,- MinSym0, MinSym1, MinSym2,-- type (^@#@$), type (^@#@$$), type (^@#@$$$),-- ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,- Show_Sym0, Show_Sym1,- ShowListSym0, ShowListSym1, ShowListSym2,- ShowsSym0, ShowsSym1, ShowsSym2,- ShowCharSym0, ShowCharSym1, ShowCharSym2,- ShowStringSym0, ShowStringSym1, ShowStringSym2,- ShowParenSym0, ShowParenSym1, ShowParenSym2,-- type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),- MemptySym0,- MappendSym0, MappendSym1, MappendSym2,- MconcatSym0, MconcatSym1,-- FmapSym0, FmapSym1, FmapSym2,- type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),- type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$),- PureSym0, PureSym1,- type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),- type (*>@#@$), type (*>@#@$$), type (*>@#@$$$),- type (<*@#@$), type (<*@#@$$), type (<*@#@$$$),- type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$),- type (>>@#@$), type (>>@#@$$), type (>>@#@$$$),- ReturnSym0, ReturnSym1, FailSym0, FailSym1,- MapM_Sym0, MapM_Sym1, MapM_Sym2,- Sequence_Sym0, Sequence_Sym1,- type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$),-- ElemSym0, ElemSym1, ElemSym2,- FoldMapSym0, FoldMapSym1, FoldMapSym2,- FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,- FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,- Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,- Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,- MaximumSym0, MaximumSym1,- MinimumSym0, MinimumSym1,- SumSym0, SumSym1,- ProductSym0, ProductSym1,-- TraverseSym0, TraverseSym1, TraverseSym2,- SequenceASym0, SequenceASym1,- MapMSym0, MapMSym1, MapMSym2,- SequenceSym0, SequenceSym1,-- IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2,- type (.@#@$), type (.@#@$$), type (.@#@$$$),- type ($@#@$), type ($@#@$$), type ($@#@$$$),- type ($!@#@$), type ($!@#@$$), type ($!@#@$$$),- FlipSym0, FlipSym1, FlipSym2,- AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2,-- (:@#@$), (:@#@$$), (:@#@$$$), NilSym0,- MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1,- type (++@#@$$), type (++@#@$), FilterSym0, FilterSym1, FilterSym2,- HeadSym0, HeadSym1, LastSym0, LastSym1,- TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1,-- ConcatSym0, ConcatSym1,- ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,- AndSym0, AndSym1, OrSym0, OrSym1,- AnySym0, AnySym1, AnySym2,- AllSym0, AllSym1, AllSym2,-- ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,- Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,- ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,- Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,-- ReplicateSym0, ReplicateSym1, ReplicateSym2,-- TakeSym0, TakeSym1, TakeSym2,- DropSym0, DropSym1, DropSym2,- SplitAtSym0, SplitAtSym1, SplitAtSym2,- TakeWhileSym0, TakeWhileSym1, TakeWhileSym2,- DropWhileSym0, DropWhileSym1, DropWhileSym2,- DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2,- SpanSym0, SpanSym1, SpanSym2,- BreakSym0, BreakSym1, BreakSym2,-- NotElemSym0, NotElemSym1, NotElemSym2,-- ZipSym0, ZipSym1, ZipSym2,- Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3,- ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,- ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3,- UnzipSym0, UnzipSym1,-- UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1- ) where--import Data.Singletons-import Data.Singletons.Prelude.Applicative- hiding (Const, ConstSym0, ConstSym1)-import Data.Singletons.Prelude.Base- hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Either-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Functor-import Data.Singletons.Prelude.List-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Monad-import Data.Singletons.Prelude.Tuple-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Enum- hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred)-import Data.Singletons.Prelude.Monoid- ( PMonoid(..), SMonoid(..), MemptySym0, MappendSym0- , MappendSym1, MappendSym2, MconcatSym0, MconcatSym1 )-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Semigroup- ( PSemigroup(..), SSemigroup(..)- , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) )-import Data.Singletons.Prelude.Show-import Data.Singletons.Prelude.Traversable-import Data.Singletons.TypeLits
− src/Data/Singletons/Prelude/Applicative.hs
@@ -1,73 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Applicative--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'Applicative' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Applicative (- PApplicative(..), SApplicative(..),- PAlternative(..), SAlternative(..),- Sing (SConst, sGetConst), SConst, Const, GetConst,- type (<$>), (%<$>), type (<$), (%<$), type (<**>), (%<**>),- LiftA, sLiftA, LiftA3, sLiftA3, Optional, sOptional,-- -- * Defunctionalization symbols- PureSym0, PureSym1,- type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),- type (*>@#@$), type (*>@#@$$), type (*>@#@$$$),- type (<*@#@$), type (<*@#@$$), type (<*@#@$$$),- EmptySym0, type (<|>@#@$), type (<|>@#@$$), type (<|>@#@$$$),- ConstSym0, ConstSym1, GetConstSym0, GetConstSym1,- type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$),- type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),- type (<**>@#@$), type (<**>@#@$$), type (<**>@#@$$$),- LiftASym0, LiftASym1, LiftASym2,- LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3,- LiftA3Sym0, LiftA3Sym1, LiftA3Sym2, LiftA3Sym3,- OptionalSym0, OptionalSym1- ) where--import Control.Applicative-import Data.Ord (Down(..))-import Data.Singletons.Prelude.Const-import Data.Singletons.Prelude.Functor-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Ord-import Data.Singletons.Single--$(singletonsOnly [d|- -- -| One or none.- optional :: Alternative f => f a -> f (Maybe a)- optional v = Just <$> v <|> pure Nothing-- instance Monoid a => Applicative ((,) a) where- pure x = (mempty, x)- (u, f) <*> (v, x) = (u `mappend` v, f x)- liftA2 f (u, x) (v, y) = (u `mappend` v, f x y)-- instance Applicative Down where- pure = Down- Down f <*> Down x = Down (f x)- |])
− src/Data/Singletons/Prelude/Base.hs
@@ -1,115 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds, PolyKinds,- ScopedTypeVariables, TypeFamilies, GADTs,- UndecidableInstances, BangPatterns #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Base--- Copyright : (C) 2014 Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability : experimental--- Portability : non-portable------ Implements singletonized versions of functions from @GHC.Base@ module.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Tuple@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Base (- -- * Basic functions- Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise,- Id, sId, Const, sConst, (:.), (%.), type ($), type ($!), (%$), (%$!),- Until, sUntil, Flip, sFlip, AsTypeOf, sAsTypeOf,- Seq, sSeq,-- -- * Defunctionalization symbols- FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,- MapSym0, MapSym1, MapSym2,- type (++@#@$), type (++@#@$$), type (++@#@$$$),- OtherwiseSym0,- IdSym0, IdSym1,- ConstSym0, ConstSym1, ConstSym2,- type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),- type ($@#@$), type ($@#@$$), type ($@#@$$$),- type ($!@#@$), type ($!@#@$$), type ($!@#@$$$),- UntilSym0, UntilSym1, UntilSym2, UntilSym3,- FlipSym0, FlipSym1, FlipSym2, FlipSym3,- AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2,- SeqSym0, SeqSym1, SeqSym2- ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Singletons.Prelude.Bool---- Promoted and singletonized versions of "otherwise" are imported and--- re-exported from Data.Singletons.Prelude.Bool. This is done to avoid cyclic--- module dependencies.--$(singletonsOnly [d|- foldr :: (a -> b -> b) -> b -> [a] -> b- foldr k z = go- where- go [] = z- go (y:ys) = y `k` go ys-- map :: (a -> b) -> [a] -> [b]- map _ [] = []- map f (x:xs) = f x : map f xs-- (++) :: [a] -> [a] -> [a]- (++) [] ys = ys- (++) (x:xs) ys = x : xs ++ ys- infixr 5 ++-- id :: a -> a- id x = x-- const :: a -> b -> a- const x _ = x-- (.) :: (b -> c) -> (a -> b) -> a -> c- (.) f g = \x -> f (g x)- infixr 9 .-- flip :: (a -> b -> c) -> b -> a -> c- flip f x y = f y x-- asTypeOf :: a -> a -> a- asTypeOf = const-- ($) :: (a -> b) -> a -> b- f $ x = f x- infixr 0 $-- ($!) :: (a -> b) -> a -> b- f $! x = let {-!-}vx = x in f vx- infixr 0 $!-- until :: (a -> Bool) -> (a -> a) -> a -> a- until p f = go- where- -- Does not singletonize due to overlapping patterns.- {-- go x | p x = x- | otherwise = go (f x)- -}- go x = if p x then x else go (f x)-- -- This is not part of GHC.Base, but we need to emulate seq and this is a good- -- place to do it.- seq :: a -> b -> b- seq _ x = x- infixr 0 `seq`- |])---- Workaround for #326-infixr 5 ++-infixr 0 $-infixr 0 $!
− src/Data/Singletons/Prelude/Bool.hs
@@ -1,108 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeApplications, TypeFamilies, TypeOperators,- GADTs, ScopedTypeVariables, DeriveDataTypeable, UndecidableInstances,- DataKinds, PolyKinds #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Bool--- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for 'Bool',--- including a singletons version of all the definitions in @Data.Bool@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Bool@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Bool (- -- * The 'Bool' singleton-- Sing(SFalse, STrue),- -- | Though Haddock doesn't show it, the 'Sing' instance above declares- -- constructors- --- -- > SFalse :: Sing False- -- > STrue :: Sing True-- SBool,- -- | 'SBool' is a kind-restricted synonym for 'Sing': @type SBool (a :: Bool) = Sing a@-- -- * Conditionals- If, sIf,-- -- * Singletons from @Data.Bool@- Not, sNot, type (&&), type (||), (%&&), (%||),-- -- | The following are derived from the function 'bool' in @Data.Bool@. The extra- -- underscore is to avoid name clashes with the type 'Bool'.- bool_, Bool_, sBool_, Otherwise, sOtherwise,-- -- * Defunctionalization symbols- TrueSym0, FalseSym0,-- NotSym0, NotSym1,- type (&&@#@$), type (&&@#@$$), type (&&@#@$$$),- type (||@#@$), type (||@#@$$), type (||@#@$$$),- Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3,- OtherwiseSym0- ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Instances-import Data.Singletons.Promote-import Data.Singletons.Single-import Data.Type.Bool ( If, type (&&), type (||), Not )--$(singletons [d|- bool_ :: a -> a -> Bool -> a- bool_ fls _tru False = fls- bool_ _fls tru True = tru- |])--$(singletonsOnly [d|- otherwise :: Bool- otherwise = True- |])---- | Conjunction of singletons-(%&&) :: Sing a -> Sing b -> Sing (a && b)-SFalse %&& _ = SFalse-STrue %&& a = a-infixr 3 %&&-$(genDefunSymbols [''(&&)])-instance SingI (&&@#@$) where- sing = singFun2 (%&&)-instance SingI x => SingI ((&&@#@$$) x) where- sing = singFun1 (sing @x %&&)---- | Disjunction of singletons-(%||) :: Sing a -> Sing b -> Sing (a || b)-SFalse %|| a = a-STrue %|| _ = STrue-infixr 2 %||-$(genDefunSymbols [''(||)])-instance SingI (||@#@$) where- sing = singFun2 (%||)-instance SingI x => SingI ((||@#@$$) x) where- sing = singFun1 (sing @x %||)---- | Negation of a singleton-sNot :: Sing a -> Sing (Not a)-sNot SFalse = STrue-sNot STrue = SFalse-$(genDefunSymbols [''Not])-instance SingI NotSym0 where- sing = singFun1 sNot---- | Conditional over singletons-sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c)-sIf STrue b _ = b-sIf SFalse _ c = c
− src/Data/Singletons/Prelude/Const.hs
@@ -1,141 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Const--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability : experimental--- Portability : non-portable------ Exports the promoted and singled versions of the 'Const' data type.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Const (- -- * The 'Const' singleton- Sing(SConst, sGetConst),- SConst, GetConst,-- -- * Defunctionalization symbols- ConstSym0, ConstSym1,- GetConstSym0, GetConstSym1- ) where--import Control.Applicative-import Data.Kind (Type)-import Data.Singletons.Internal-import Data.Singletons.Prelude.Base- hiding ( Const, ConstSym0, ConstSym1- , Foldr, FoldrSym0, sFoldr )-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Instances hiding (FoldlSym0, sFoldl)-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Semigroup.Internal-import Data.Singletons.Prelude.Show-import Data.Singletons.Promote-import Data.Singletons.Single--{--Const's argument `b` is poly-kinded, and as a result, we have a choice as to-what Sing instance to give it. We could use either--1. data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type-2. data instance Sing :: forall (a :: Type) (b :: Type). Const a b -> Type--Option (1) is the more permissive one, so we opt for that. However, singletons'-TH machinery does not jive with this option, since the SingKind instance it-tries to generate:-- instance (SingKind a, SingKind b) => SingKind (Const a b) where- type Demote (Const a b) = Const (Demote a) (Demote b)--Assumes that `b` is of kind Type. Until we get a more reliable story for-poly-kinded Sing instances (see #150), we simply write the Sing instance by-hand.--}-data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type where- SConst :: { sGetConst :: Sing a } -> Sing ('Const a)-type SConst = (Sing :: Const a b -> Type)-instance SingKind a => SingKind (Const a b) where- type Demote (Const a b) = Const (Demote a) b- fromSing (SConst sa) = Const (fromSing sa)- toSing (Const a) = withSomeSing a $ SomeSing . SConst-instance SingI a => SingI ('Const a) where- sing = SConst sing--$(genDefunSymbols [''Const])-instance SingI ConstSym0 where- sing = singFun1 SConst-instance SingI (TyCon1 'Const) where- sing = singFun1 SConst--$(singletons [d|- type family GetConst (x :: Const a b) :: a where- GetConst ('Const x) = x- |])--$(singletonsOnly [d|- deriving instance Bounded a => Bounded (Const a b)- deriving instance Eq a => Eq (Const a b)- deriving instance Ord a => Ord (Const a b)-- -- deriving instance Enum a => Enum (Const a b)- instance Enum a => Enum (Const a b) where- succ (Const x) = Const (succ x)- pred (Const x) = Const (pred x)- toEnum i = Const (toEnum i)- fromEnum (Const x) = fromEnum x- enumFromTo (Const x) (Const y) = map Const (enumFromTo x y)- enumFromThenTo (Const x) (Const y) (Const z) =- map Const (enumFromThenTo x y z)-- -- deriving instance Monoid a => Monoid (Const a b)- instance Monoid a => Monoid (Const a b) where- mempty = Const mempty-- -- deriving instance Num a => Num (Const a b)- instance Num a => Num (Const a b) where- Const x + Const y = Const (x + y)- Const x - Const y = Const (x - y)- Const x * Const y = Const (x * y)- negate (Const x) = Const (negate x)- abs (Const x) = Const (abs x)- signum (Const x) = Const (signum x)- fromInteger n = Const (fromInteger n)-- -- deriving instance Semigroup a => Semigroup (Const a b)- instance Semigroup a => Semigroup (Const a b) where- Const x <> Const y = Const (x <> y)-- -- -| This instance would be equivalent to the derived instances of the- -- 'Const' newtype if the 'runConst' field were removed- instance Show a => Show (Const a b) where- showsPrec d (Const x) = showParen (d > 10) $- showString "Const " . showsPrec 11 x-- deriving instance Functor (Const m)- deriving instance Foldable (Const m)-- instance Monoid m => Applicative (Const m) where- pure _ = Const mempty- liftA2 _ (Const x) (Const y) = Const (x `mappend` y)- Const x <*> Const y = Const (x `mappend` y)- |])
− src/Data/Singletons/Prelude/Either.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, GADTs,- RankNTypes, UndecidableInstances, DataKinds, PolyKinds #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Either--- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for 'Either',--- including a singletons version of all the definitions in @Data.Either@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Either@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Either (- -- * The 'Either' singleton- Sing(SLeft, SRight),- -- | Though Haddock doesn't show it, the 'Sing' instance above declares- -- constructors- --- -- > SLeft :: Sing a -> Sing (Left a)- -- > SRight :: Sing b -> Sing (Right b)-- SEither,- -- | 'SEither' is a kind-restricted synonym for 'Sing':- -- @type SEither (a :: Either x y) = Sing a@-- -- * Singletons from @Data.Either@- either_, Either_, sEither_,- -- | The preceding two definitions are derived from the function 'either' in- -- @Data.Either@. The extra underscore is to avoid name clashes with the type- -- 'Either'.-- Lefts, sLefts, Rights, sRights,- PartitionEithers, sPartitionEithers, IsLeft, sIsLeft, IsRight, sIsRight,-- -- * Defunctionalization symbols- LeftSym0, LeftSym1, RightSym0, RightSym1,-- Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3,- LeftsSym0, LeftsSym1, RightsSym0, RightsSym1,- IsLeftSym0, IsLeftSym1, IsRightSym0, IsRightSym1- ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Base-import Data.Singletons.Single---- NB: The haddock comments are disabled because TH can't deal with them.--$(singletons [d|- -- Renamed to avoid name clash- -- -| Case analysis for the 'Either' type.- -- If the value is @'Left' a@, apply the first function to @a@;- -- if it is @'Right' b@, apply the second function to @b@.- either_ :: (a -> c) -> (b -> c) -> Either a b -> c- either_ f _ (Left x) = f x- either_ _ g (Right y) = g y- |])--$(singletonsOnly [d|- -- -| Extracts from a list of 'Either' all the 'Left' elements- -- All the 'Left' elements are extracted in order.-- -- Modified to avoid list comprehensions- lefts :: [Either a b] -> [a]- lefts [] = []- lefts (Left x : xs) = x : lefts xs- lefts (Right _ : xs) = lefts xs-- -- -| Extracts from a list of 'Either' all the 'Right' elements- -- All the 'Right' elements are extracted in order.-- -- Modified to avoid list comprehensions- rights :: [Either a b] -> [b]- rights [] = []- rights (Left _ : xs) = rights xs- rights (Right x : xs) = x : rights xs-- -- -| Partitions a list of 'Either' into two lists- -- All the 'Left' elements are extracted, in order, to the first- -- component of the output. Similarly the 'Right' elements are extracted- -- to the second component of the output.- partitionEithers :: [Either a b] -> ([a],[b])- partitionEithers = foldr (either_ left right) ([],[])- where- left a (l, r) = (a:l, r)- right a (l, r) = (l, a:r)-- -- -| Return `True` if the given value is a `Left`-value, `False` otherwise.- --- -- /Since: 4.7.0.0/- isLeft :: Either a b -> Bool- isLeft (Left _) = True- isLeft (Right _) = False-- -- -| Return `True` if the given value is a `Right`-value, `False` otherwise.- --- -- /Since: 4.7.0.0/- isRight :: Either a b -> Bool- isRight (Left _) = False- isRight (Right _) = True- |])
− src/Data/Singletons/Prelude/Enum.hs
@@ -1,137 +0,0 @@-{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables,- TypeFamilies, TypeOperators, GADTs, UndecidableInstances,- FlexibleContexts, DefaultSignatures, BangPatterns,- InstanceSigs #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Enum--- Copyright : (C) 2014 Jan Stolarek, Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singleton version of Bounded, 'PBounded'--- and 'SBounded'-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Enum (- PBounded(..), SBounded(..),- PEnum(..), SEnum(..),-- -- ** Defunctionalization symbols- MinBoundSym0,- MaxBoundSym0,- SuccSym0, SuccSym1,- PredSym0, PredSym1,- ToEnumSym0, ToEnumSym1,- FromEnumSym0, FromEnumSym1,- EnumFromToSym0, EnumFromToSym1, EnumFromToSym2,- EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2,- EnumFromThenToSym3-- ) where--import Data.Singletons.Single-import Data.Singletons.Util-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Instances-import Data.Singletons.TypeLits--$(singletonsOnly [d|- class Bounded a where- minBound, maxBound :: a- |])--$(singBoundedInstances boundedBasicTypes)--$(singletonsOnly [d|- class Enum a where- -- | the successor of a value. For numeric types, 'succ' adds 1.- succ :: a -> a- -- | the predecessor of a value. For numeric types, 'pred' subtracts 1.- pred :: a -> a- -- | Convert from a 'Nat'.- toEnum :: Nat -> a- -- | Convert to a 'Nat'.- fromEnum :: a -> Nat-- -- The following use infinite lists, and are not promotable:- -- -- | Used in Haskell's translation of @[n..]@.- -- enumFrom :: a -> [a]- -- -- | Used in Haskell's translation of @[n,n'..]@.- -- enumFromThen :: a -> a -> [a]-- -- | Used in Haskell's translation of @[n..m]@.- enumFromTo :: a -> a -> [a]- -- | Used in Haskell's translation of @[n,n'..m]@.- enumFromThenTo :: a -> a -> a -> [a]-- succ = toEnum . (+1) . fromEnum- pred = toEnum . (subtract 1) . fromEnum- -- enumFrom x = map toEnum [fromEnum x ..]- -- enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]- enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]- enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]-- -- Nat instance for Enum- eftNat :: Nat -> Nat -> [Nat]- -- [x1..x2]- eftNat x0 y | (x0 > y) = []- | otherwise = go x0- where- go x = x : if (x == y) then [] else go (x + 1)-- efdtNat :: Nat -> Nat -> Nat -> [Nat]- -- [x1,x2..y]- efdtNat x1 x2 y- | x2 >= x1 = efdtNatUp x1 x2 y- | otherwise = efdtNatDn x1 x2 y-- -- Requires x2 >= x1- efdtNatUp :: Nat -> Nat -> Nat -> [Nat]- efdtNatUp x1 x2 y -- Be careful about overflow!- | y < x2 = if y < x1 then [] else [x1]- | otherwise = -- Common case: x1 <= x2 <= y- let delta = x2 - x1 -- >= 0- y' = y - delta -- x1 <= y' <= y; hence y' is representable-- -- Invariant: x <= y- -- Note that: z <= y' => z + delta won't overflow- -- so we are guaranteed not to overflow if/when we recurse- go_up x | x > y' = [x]- | otherwise = x : go_up (x + delta)- in x1 : go_up x2-- -- Requires x2 <= x1- efdtNatDn :: Nat -> Nat -> Nat -> [Nat]- efdtNatDn x1 x2 y -- Be careful about underflow!- | y > x2 = if y > x1 then [] else [x1]- | otherwise = -- Common case: x1 >= x2 >= y- let delta = x2 - x1 -- <= 0- y' = y - delta -- y <= y' <= x1; hence y' is representable-- -- Invariant: x >= y- -- Note that: z >= y' => z + delta won't underflow- -- so we are guaranteed not to underflow if/when we recurse- go_dn x | x < y' = [x]- | otherwise = x : go_dn (x + delta)- in x1 : go_dn x2-- instance Enum Nat where- succ x = x + 1- pred x = x - 1-- toEnum x = x- fromEnum x = x-- enumFromTo = eftNat- enumFromThenTo = efdtNat- |])--$(singEnumInstances enumBasicTypes)
− src/Data/Singletons/Prelude/Eq.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies,- RankNTypes, FlexibleContexts, TemplateHaskell,- UndecidableInstances, GADTs, DefaultSignatures,- ScopedTypeVariables, TypeApplications #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Eq--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the SEq singleton version of the Eq type class.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Eq (- PEq(..), SEq(..),- DefaultEq,-- -- * Defunctionalization symbols- type (==@#@$), type (==@#@$$), type (==@#@$$$),- type (/=@#@$), type (/=@#@$$), type (/=@#@$$$),- DefaultEqSym0, DefaultEqSym1, DefaultEqSym2- ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Bool-import Data.Singletons.Single-import Data.Singletons.Prelude.Instances-import Data.Singletons.Util-import Data.Singletons.Promote-import qualified Data.Type.Equality as DTE ()---- NB: These must be defined by hand because of the custom handling of the--- default for (==) to use DefaultEq---- | The promoted analogue of 'Eq'. If you supply no definition for '(==)',--- then it defaults to a use of 'DefaultEq'.-class PEq a where- type (==) (x :: a) (y :: a) :: Bool- type (/=) (x :: a) (y :: a) :: Bool-- type (x :: a) == (y :: a) = x `DefaultEq` y- type (x :: a) /= (y :: a) = Not (x == y)-- infix 4 ==- infix 4 /=---- | A sensible way to compute Boolean equality for types of any kind. Note--- that this definition is slightly different from the '(DTE.==)' type family--- from "Data.Type.Equality" in @base@, as '(DTE.==)' attempts to distinguish--- applications of type constructors from other types. As a result,--- @a == a@ does not reduce to 'True' for every @a@, but @'DefaultEq' a a@--- /does/ reduce to 'True' for every @a@. The latter behavior is more desirable--- for @singletons@' purposes, so we use it instead of '(DTE.==)'.-type family DefaultEq (a :: k) (b :: k) :: Bool where- DefaultEq a a = 'True- DefaultEq a b = 'False--$(genDefunSymbols [''(==), ''(/=), ''DefaultEq])---- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is required--- that instances define a body for '(%==)'. You may also supply a body for '(%/=)'.-class SEq k where- -- | Boolean equality on singletons- (%==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a == b)- infix 4 %==-- -- | Boolean disequality on singletons- (%/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a /= b)- default (%/=) :: forall (a :: k) (b :: k).- ((a /= b) ~ Not (a == b))- => Sing a -> Sing b -> Sing (a /= b)- a %/= b = sNot (a %== b)- infix 4 %/=--$(singEqInstances basicTypes)--instance SEq a => SingI ((==@#@$) :: a ~> a ~> Bool) where- sing = singFun2 (%==)-instance (SEq a, SingI x) => SingI ((==@#@$$) x :: a ~> Bool) where- sing = singFun1 (sing @x %==)--instance SEq a => SingI ((/=@#@$) :: a ~> a ~> Bool) where- sing = singFun2 (%/=)-instance (SEq a, SingI x) => SingI ((/=@#@$$) x :: a ~> Bool) where- sing = singFun1 (sing @x %/=)
− src/Data/Singletons/Prelude/Foldable.hs
@@ -1,645 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Foldable--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'Foldable' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Foldable (- PFoldable(..), SFoldable(..),-- FoldrM, sFoldrM,- FoldlM, sFoldlM,-- Traverse_, sTraverse_,- For_, sFor_,- SequenceA_, sSequenceA_,- Asum, sAsum,-- MapM_, sMapM_,- ForM_, sForM_,- Sequence_, sSequence_,- Msum, sMsum,-- Concat, sConcat,- ConcatMap, sConcatMap,- And, sAnd,- Or, sOr,- Any, sAny,- All, sAll,- MaximumBy, sMaximumBy,- MinimumBy, sMinimumBy,-- NotElem, sNotElem,- Find, sFind,-- -- * Defunctionalization symbols- FoldSym0, FoldSym1,- FoldMapSym0, FoldMapSym1, FoldMapSym2,- FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,- Foldr'Sym0, Foldr'Sym1, Foldr'Sym2, Foldr'Sym3,- FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,- Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3,- Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,- Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,- ToListSym0, ToListSym1,- NullSym0, NullSym1,- LengthSym0, LengthSym1,- ElemSym0, ElemSym1, ElemSym2,- MaximumSym0, MaximumSym1,- MinimumSym0, MinimumSym1,- SumSym0, SumSym1,- ProductSym0, ProductSym1,-- FoldrMSym0, FoldrMSym1, FoldrMSym2, FoldrMSym3,- FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3,-- Traverse_Sym0, Traverse_Sym1, Traverse_Sym2,- For_Sym0, For_Sym1, For_Sym2,- SequenceA_Sym0, SequenceA_Sym1,- AsumSym0, AsumSym1,-- MapM_Sym0, MapM_Sym1, MapM_Sym2,- ForM_Sym0, ForM_Sym1, ForM_Sym2,- Sequence_Sym0, Sequence_Sym1,- MsumSym0, MsumSym1,-- ConcatSym0, ConcatSym1,- ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,- AndSym0, AndSym1,- OrSym0, OrSym1,- AnySym0, AnySym1, AnySym2,- AllSym0, AllSym1, AllSym2,- MaximumBySym0, MaximumBySym1, MaximumBySym2,- MinimumBySym0, MinimumBySym1, MinimumBySym2,-- NotElemSym0, NotElemSym1, NotElemSym2,- FindSym0, FindSym1, FindSym2- ) where--import Control.Applicative-import Control.Monad-import Data.Kind-import Data.List.NonEmpty (NonEmpty(..))-import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..))-import qualified Data.Monoid as Monoid (All(..), Any(..), Product(..), Sum(..))-import Data.Singletons.Internal-import Data.Singletons.Prelude.Base- hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Either-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Instances (Sing(..), type (:@#@$))-import Data.Singletons.Prelude.List.Internal.Disambiguation-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid- hiding ( AllSym0, AllSym1- , AnySym0, AnySym1- , ProductSym0, ProductSym1- , SumSym0, SumSym1 )-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord- hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax- , Min, MinSym0, MinSym1, MinSym2, sMin )-import Data.Singletons.Prelude.Semigroup.Internal- hiding ( AllSym0(..), AllSym1, SAll- , AnySym0(..), AnySym1, SAny- , FirstSym0, FirstSym1, SFirst- , LastSym0, LastSym1, SLast- , ProductSym0(..), ProductSym1, SProduct- , SumSym0(..), SumSym1, SSum )-import Data.Singletons.Promote-import Data.Singletons.Single-import Data.Singletons.TypeLits.Internal--newtype Endo a = Endo (a ~> a)-data instance Sing :: forall a. Endo a -> Type where- SEndo :: Sing x -> Sing ('Endo x)-data EndoSym0 :: forall a. (a ~> a) ~> Endo a-type instance Apply EndoSym0 x = 'Endo x--$(singletonsOnly [d|- instance Semigroup (Endo a) where- Endo x <> Endo y = Endo (x . y)-- instance Monoid (Endo a) where- mempty = Endo id- |])--newtype MaxInternal a = MaxInternal (Maybe a)-data instance Sing :: forall a. MaxInternal a -> Type where- SMaxInternal :: Sing x -> Sing ('MaxInternal x)-$(genDefunSymbols [''MaxInternal])--newtype MinInternal a = MinInternal (Maybe a)-data instance Sing :: forall a. MinInternal a -> Type where- SMinInternal :: Sing x -> Sing ('MinInternal x)-$(genDefunSymbols [''MinInternal])--$(singletonsOnly [d|- instance Ord a => Semigroup (MaxInternal a) where- m <> MaxInternal Nothing = m- MaxInternal Nothing <> n = n- (MaxInternal m@(Just x)) <> (MaxInternal n@(Just y))- = if x >= y then MaxInternal m else MaxInternal n-- instance Ord a => Monoid (MaxInternal a) where- mempty = MaxInternal Nothing-- instance Ord a => Semigroup (MinInternal a) where- m <> MinInternal Nothing = m- MinInternal Nothing <> n = n- (MinInternal m@(Just x)) <> (MinInternal n@(Just y))- = if x <= y then MinInternal m else MinInternal n-- instance Ord a => Monoid (MinInternal a) where- mempty = MinInternal Nothing- |])--$(singletonsOnly [d|- -- -| Data structures that can be folded.- --- -- For example, given a data type- --- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)- --- -- a suitable instance would be- --- -- > instance Foldable Tree where- -- > foldMap f Empty = mempty- -- > foldMap f (Leaf x) = f x- -- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r- --- -- This is suitable even for abstract types, as the monoid is assumed- -- to satisfy the monoid laws. Alternatively, one could define @foldr@:- --- -- > instance Foldable Tree where- -- > foldr f z Empty = z- -- > foldr f z (Leaf x) = f x z- -- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l- --- -- @Foldable@ instances are expected to satisfy the following laws:- --- -- > foldr f z t = appEndo (foldMap (Endo . f) t ) z- --- -- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z- --- -- > fold = foldMap id- --- -- > length = getSum . foldMap (Sum . const 1)- --- -- @sum@, @product@, @maximum@, and @minimum@ should all be essentially- -- equivalent to @foldMap@ forms, such as- --- -- > sum = getSum . foldMap Sum- --- -- but may be less defined.- --- -- If the type is also a 'Functor' instance, it should satisfy- --- -- > foldMap f = fold . fmap f- --- -- which implies that- --- -- > foldMap f . fmap g = foldMap (f . g)-- class Foldable (t :: Type -> Type) where- -- {-# MINIMAL foldMap | foldr #-}-- -- -| Combine the elements of a structure using a monoid.- fold :: Monoid m => t m -> m- fold = foldMap id-- -- -| Map each element of the structure to a monoid,- -- and combine the results.- foldMap :: Monoid m => (a -> m) -> t a -> m- foldMap f = foldr (mappend . f) mempty-- -- -| Right-associative fold of a structure.- --- -- In the case of lists, 'foldr', when applied to a binary operator, a- -- starting value (typically the right-identity of the operator), and a- -- list, reduces the list using the binary operator, from right to left:- --- -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)- --- -- Note that, since the head of the resulting expression is produced by- -- an application of the operator to the first element of the list,- -- 'foldr' can produce a terminating expression from an infinite list.- --- -- For a general 'Foldable' structure this should be semantically identical- -- to,- --- -- @foldr f z = 'List.foldr' f z . 'toList'@- --- foldr :: (a -> b -> b) -> b -> t a -> b- foldr f z t = case foldMap (Endo . f) t of- Endo g -> g z-- -- -| Right-associative fold of a structure, but with strict application of- -- the operator.- --- foldr' :: (a -> b -> b) -> b -> t a -> b- foldr' f z0 xs = foldl f' id xs z0- where f' k x z = k $! f x z-- -- -| Left-associative fold of a structure.- --- -- In the case of lists, 'foldl', when applied to a binary- -- operator, a starting value (typically the left-identity of the operator),- -- and a list, reduces the list using the binary operator, from left to- -- right:- --- -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn- --- -- Note that to produce the outermost application of the operator the- -- entire input list must be traversed. This means that 'foldl'' will- -- diverge if given an infinite list.- --- -- Also note that if you want an efficient left-fold, you probably want to- -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does- -- not force the "inner" results (e.g. @z `f` x1@ in the above example)- -- before applying them to the operator (e.g. to @(`f` x2)@). This results- -- in a thunk chain @O(n)@ elements long, which then must be evaluated from- -- the outside-in.- --- -- For a general 'Foldable' structure this should be semantically identical- -- to,- --- -- @foldl f z = 'List.foldl' f z . 'toList'@- --- foldl :: (b -> a -> b) -> b -> t a -> b- foldl f z t = case foldMap (Dual . Endo . flip f) t of- Dual (Endo g) -> g z- -- There's no point mucking around with coercions here,- -- because flip forces us to build a new function anyway.-- -- -| Left-associative fold of a structure but with strict application of- -- the operator.- --- -- This ensures that each step of the fold is forced to weak head normal- -- form before being applied, avoiding the collection of thunks that would- -- otherwise occur. This is often what you want to strictly reduce a finite- -- list to a single, monolithic result (e.g. 'length').- --- -- For a general 'Foldable' structure this should be semantically identical- -- to,- --- -- @foldl f z = 'List.foldl'' f z . 'toList'@- --- foldl' :: (b -> a -> b) -> b -> t a -> b- foldl' f z0 xs = foldr f' id xs z0- where f' x k z = k $! f z x-- -- -| A variant of 'foldr' that has no base case,- -- and thus may only be applied to non-empty structures.- --- -- @'foldr1' f = 'List.foldr1' f . 'toList'@- foldr1 :: (a -> a -> a) -> t a -> a- foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")- (foldr mf Nothing xs)- where- mf x m = Just (case m of- Nothing -> x- Just y -> f x y)-- -- -| A variant of 'foldl' that has no base case,- -- and thus may only be applied to non-empty structures.- --- -- @'foldl1' f = 'List.foldl1' f . 'toList'@- foldl1 :: (a -> a -> a) -> t a -> a- foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")- (foldl mf Nothing xs)- where- mf m y = Just (case m of- Nothing -> y- Just x -> f x y)-- -- -| List of elements of a structure, from left to right.- toList :: t a -> [a]- toList = foldr (:) []-- -- -| Test whether the structure is empty. The default implementation is- -- optimized for structures that are similar to cons-lists, because there- -- is no general way to do better.- null :: t a -> Bool- null = foldr (\_ _ -> False) True-- -- -| Returns the size/length of a finite structure as an 'Int'. The- -- default implementation is optimized for structures that are similar to- -- cons-lists, because there is no general way to do better.- length :: t a -> Nat- length = foldl' (\c _ -> c+1) 0-- -- -| Does the element occur in the structure?- elem :: Eq a => a -> t a -> Bool- elem = any . (==)-- -- -| The largest element of a non-empty structure.- maximum :: forall a . Ord a => t a -> a- maximum x =- case foldMap (MaxInternal . Just) x of- MaxInternal y -> fromMaybe (errorWithoutStackTrace "maximum: empty structure") y-- -- -| The least element of a non-empty structure.- minimum :: forall a . Ord a => t a -> a- minimum x =- case foldMap (MinInternal . Just) x of- MinInternal y -> fromMaybe (errorWithoutStackTrace "minimum: empty structure") y-- -- -| The 'sum' function computes the sum of the numbers of a structure.- sum :: Num a => t a -> a- sum x = case foldMap sum_ x of- Monoid.Sum y -> y-- -- -| The 'product' function computes the product of the numbers of a- -- structure.- product :: Num a => t a -> a- product x = case foldMap product_ x of- Monoid.Product y -> y-- -- instances for Prelude types-- instance Foldable Maybe where- foldMap = maybe_ mempty-- foldr _ z Nothing = z- foldr f z (Just x) = f x z-- foldl _ z Nothing = z- foldl f z (Just x) = f z x-- instance Foldable [] where- elem = listelem- foldl = listfoldl- foldl' = listfoldl'- foldl1 = listfoldl1- foldr = listfoldr- foldr1 = listfoldr1- length = listlength- maximum = listmaximum- minimum = listminimum- null = listnull- product = listproduct- sum = listsum- toList = id-- instance Foldable NonEmpty where- foldr f z (a :| as) = f a (listfoldr f z as)- foldl f z (a :| as) = listfoldl f (f z a) as- foldl1 f (a :| as) = listfoldl f a as-- -- GHC isn't clever enough to transform the default definition- -- into anything like this, so we'd end up shuffling a bunch of- -- Maybes around.- foldr1 f (p :| ps) = foldr go id ps p- where- go x r prev = f prev (r x)-- -- We used to say- --- -- length (_ :| as) = 1 + length as- --- -- but the default definition is better, counting from 1.- --- -- The default definition also works great for null and foldl'.- -- As usual for cons lists, foldr' is basically hopeless.-- foldMap f (a :| as) = f a `mappend` foldMap f as- fold (m :| ms) = m `mappend` fold ms- toList (a :| as) = a : as-- instance Foldable (Either a) where- foldMap _ (Left _) = mempty- foldMap f (Right y) = f y-- foldr _ z (Left _) = z- foldr f z (Right y) = f y z-- length (Left _) = 0- length (Right _) = 1-- null = isLeft-- instance Foldable Dual where- foldMap f (Dual x) = f x-- elem x (Dual y) = x == y- foldl f z (Dual x) = f z x- foldl' f z (Dual x) = f z x- foldl1 _ (Dual x) = x- foldr f z (Dual x) = f x z- foldr' = foldr- foldr1 _ (Dual x) = x- length _ = 1- maximum (Dual x) = x- minimum (Dual x) = x- null _ = False- product (Dual x) = x- sum (Dual x) = x- toList (Dual x) = [x]-- instance Foldable Monoid.Sum where- foldMap f (Monoid.Sum x) = f x-- elem x (Monoid.Sum y) = x == y- foldl f z (Monoid.Sum x) = f z x- foldl' f z (Monoid.Sum x) = f z x- foldl1 _ (Monoid.Sum x) = x- foldr f z (Monoid.Sum x) = f x z- foldr' = foldr- foldr1 _ (Monoid.Sum x) = x- length _ = 1- maximum (Monoid.Sum x) = x- minimum (Monoid.Sum x) = x- null _ = False- product (Monoid.Sum x) = x- sum (Monoid.Sum x) = x- toList (Monoid.Sum x) = [x]-- instance Foldable Monoid.Product where- foldMap f (Monoid.Product x) = f x-- elem x (Monoid.Product y) = x == y- foldl f z (Monoid.Product x) = f z x- foldl' f z (Monoid.Product x) = f z x- foldl1 _ (Monoid.Product x) = x- foldr f z (Monoid.Product x) = f x z- foldr' = foldr- foldr1 _ (Monoid.Product x) = x- length _ = 1- maximum (Monoid.Product x) = x- minimum (Monoid.Product x) = x- null _ = False- product (Monoid.Product x) = x- sum (Monoid.Product x) = x- toList (Monoid.Product x) = [x]-- -- -| Monadic fold over the elements of a structure,- -- associating to the right, i.e. from right to left.- foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b- foldrM f z0 xs = foldl f' return xs z0- where f' k x z = f x z >>= k-- -- -| Monadic fold over the elements of a structure,- -- associating to the left, i.e. from left to right.- foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b- foldlM f z0 xs = foldr f' return xs z0- where f' x k z = f z x >>= k-- -- -| Map each element of a structure to an action, evaluate these- -- actions from left to right, and ignore the results. For a version- -- that doesn't ignore the results see 'Data.Traversable.traverse'.- traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()- traverse_ f = foldr ((*>) . f) (pure ())-- -- -| 'for_' is 'traverse_' with its arguments flipped. For a version- -- that doesn't ignore the results see 'Data.Traversable.for'.- --- -- >>> for_ [1..4] print- -- 1- -- 2- -- 3- -- 4- for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()- for_ = flip traverse_-- -- -| Map each element of a structure to a monadic action, evaluate- -- these actions from left to right, and ignore the results. For a- -- version that doesn't ignore the results see- -- 'Data.Traversable.mapM'.- --- -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to- -- 'Monad'.- mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()- mapM_ f= foldr ((>>) . f) (return ())-- -- -| 'forM_' is 'mapM_' with its arguments flipped. For a version that- -- doesn't ignore the results see 'Data.Traversable.forM'.- --- -- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'.- forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()- forM_ = flip mapM_-- -- -| Evaluate each action in the structure from left to right, and- -- ignore the results. For a version that doesn't ignore the results- -- see 'Data.Traversable.sequenceA'.- sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()- sequenceA_ = foldr (*>) (pure ())-- -- -| Evaluate each monadic action in the structure from left to right,- -- and ignore the results. For a version that doesn't ignore the- -- results see 'Data.Traversable.sequence'.- --- -- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized- -- to 'Monad'.- sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()- sequence_ = foldr (>>) (return ())-- -- -| The sum of a collection of actions, generalizing 'concat'.- --- -- asum [Just "Hello", Nothing, Just "World"]- -- Just "Hello"- asum :: (Foldable t, Alternative f) => t (f a) -> f a- asum = foldr (<|>) empty-- -- -| The sum of a collection of actions, generalizing 'concat'.- -- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'.- msum :: (Foldable t, MonadPlus m) => t (m a) -> m a- msum = asum-- -- -| The concatenation of all the elements of a container of lists.- concat :: Foldable t => t [a] -> [a]- concat xs = foldr (\x y -> foldr (:) y x) [] xs-- -- -| Map a function over all the elements of a container and concatenate- -- the resulting lists.- concatMap :: Foldable t => (a -> [b]) -> t a -> [b]- concatMap f xs = foldr (\x b -> foldr (:) b (f x)) [] xs-- -- These use foldr rather than foldMap to avoid repeated concatenation.-- -- -| 'and' returns the conjunction of a container of Bools. For the- -- result to be 'True', the container must be finite; 'False', however,- -- results from a 'False' value finitely far from the left end.- and :: Foldable t => t Bool -> Bool- and x = case foldMap all_ x of- Monoid.All y -> y-- -- -| 'or' returns the disjunction of a container of Bools. For the- -- result to be 'False', the container must be finite; 'True', however,- -- results from a 'True' value finitely far from the left end.- or :: Foldable t => t Bool -> Bool- or x = case foldMap any_ x of- Monoid.Any y -> y-- -- -| Determines whether any element of the structure satisfies the predicate.- any :: Foldable t => (a -> Bool) -> t a -> Bool- any p x = case foldMap (any_ . p) x of- Monoid.Any y -> y-- -- -| Determines whether all elements of the structure satisfy the predicate.- all :: Foldable t => (a -> Bool) -> t a -> Bool- all p x = case foldMap (all_ . p) x of- Monoid.All y -> y-- -- -| The largest element of a non-empty structure with respect to the- -- given comparison function.-- -- See Note [maximumBy/minimumBy space usage]- maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a- maximumBy cmp = foldl1 max'- where max' x y = case cmp x y of- GT -> x- LT -> y- EQ -> y-- -- -| The least element of a non-empty structure with respect to the- -- given comparison function.-- -- See Note [maximumBy/minimumBy space usage]- minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a- minimumBy cmp = foldl1 min'- where min' x y = case cmp x y of- GT -> y- LT -> x- EQ -> x-- -- -| 'notElem' is the negation of 'elem'.- notElem :: (Foldable t, Eq a) => a -> t a -> Bool- notElem x = not . elem x-- -- -| The 'find' function takes a predicate and a structure and returns- -- the leftmost element of the structure matching the predicate, or- -- 'Nothing' if there is no such element.- find :: Foldable t => (a -> Bool) -> t a -> Maybe a- find p y = case foldMap (\ x -> First (if p x then Just x else Nothing)) y of- First z -> z- |])--$(singletonsOnly [d|- -- instances for Prelude types (part 2)-- deriving instance Foldable ((,) a)- deriving instance Foldable First- deriving instance Foldable Last- |])
− src/Data/Singletons/Prelude/Function.hs
@@ -1,119 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Function--- Copyright : (C) 2016 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines singleton versions of the definitions in @Data.Function@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Function@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies,- TypeOperators, UndecidableInstances, GADTs,- DataKinds, PolyKinds #-}--module Data.Singletons.Prelude.Function (- -- * "Prelude" re-exports- Id, sId, Const, sConst, (:.), (%.), Flip, sFlip, type ($), (%$)- -- * Other combinators- , type (&), (%&), On, sOn-- -- * Defunctionalization symbols- , IdSym0, IdSym1- , ConstSym0, ConstSym1, ConstSym2- , type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$)- , FlipSym0, FlipSym1, FlipSym2, FlipSym3- , type ($@#@$), type ($@#@$$), type ($@#@$$$)- , type (&@#@$), type (&@#@$$), type (&@#@$$$)- , OnSym0, OnSym1, OnSym2, OnSym3, OnSym4- ) where--import Data.Singletons.Prelude.Base-import Data.Singletons.Single--$(singletonsOnly [d|- {- GHC falls into a loop here. Not really a surprise.-- -- | @'fix' f@ is the least fixed point of the function @f@,- -- i.e. the least defined @x@ such that @f x = x@.- fix :: (a -> a) -> a- fix f = let x = f x in x- -}-- -- -| @(*) \`on\` f = \\x y -> f x * f y@.- --- -- Typical usage: @'Data.List.sortBy' ('compare' \`on\` 'fst')@.- --- -- Algebraic properties:- --- -- -* @(*) \`on\` 'id' = (*)@ (if @(*) ∉ {⊥, 'const' ⊥}@)- --- -- -* @((*) \`on\` f) \`on\` g = (*) \`on\` (f . g)@- --- -- -* @'flip' on f . 'flip' on g = 'flip' on (g . f)@-- -- Proofs (so that I don't have to edit the test-suite):-- -- (*) `on` id- -- =- -- \x y -> id x * id y- -- =- -- \x y -> x * y- -- = { If (*) /= _|_ or const _|_. }- -- (*)-- -- (*) `on` f `on` g- -- =- -- ((*) `on` f) `on` g- -- =- -- \x y -> ((*) `on` f) (g x) (g y)- -- =- -- \x y -> (\x y -> f x * f y) (g x) (g y)- -- =- -- \x y -> f (g x) * f (g y)- -- =- -- \x y -> (f . g) x * (f . g) y- -- =- -- (*) `on` (f . g)- -- =- -- (*) `on` f . g-- -- flip on f . flip on g- -- =- -- (\h (*) -> (*) `on` h) f . (\h (*) -> (*) `on` h) g- -- =- -- (\(*) -> (*) `on` f) . (\(*) -> (*) `on` g)- -- =- -- \(*) -> (*) `on` g `on` f- -- = { See above. }- -- \(*) -> (*) `on` g . f- -- =- -- (\h (*) -> (*) `on` h) (g . f)- -- =- -- flip on (g . f)-- on :: (b -> b -> c) -> (a -> b) -> a -> a -> c- (.*.) `on` f = \x y -> f x .*. f y- infixl 0 `on`-- -- -| '&' is a reverse application operator. This provides notational- -- convenience. Its precedence is one higher than that of the forward- -- application operator '$', which allows '&' to be nested in '$'.- --- -- @since 4.8.0.0- (&) :: a -> (a -> b) -> b- x & f = f x- infixl 1 &- |])---- Workaround for #326-infixl 1 &
− src/Data/Singletons/Prelude/Functor.hs
@@ -1,206 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Functor--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'Functor' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Functor (- PFunctor(..), SFunctor(..),- type ($>), (%$>),- type (<$>), (%<$>),- type (<&>), (%<&>),- Void, sVoid,-- -- * Defunctionalization symbols- FmapSym0, FmapSym1, FmapSym2,- type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),- type ($>@#@$), type ($>@#@$$), type ($>@#@$$$),- type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$),- type (<&>@#@$), type (<&>@#@$$), type (<&>@#@$$$),- VoidSym0, VoidSym1- ) where--import Data.Ord (Down(..))-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Ord-import Data.Singletons.Single--$(singletonsOnly [d|- infixl 4 <$>-- -- -| An infix synonym for 'fmap'.- --- -- The name of this operator is an allusion to '$'.- -- Note the similarities between their types:- --- -- > ($) :: (a -> b) -> a -> b- -- > (<$>) :: Functor f => (a -> b) -> f a -> f b- --- -- Whereas '$' is function application, '<$>' is function- -- application lifted over a 'Functor'.- --- -- ==== __Examples__- --- -- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show':- --- -- >>> show <$> Nothing- -- Nothing- -- >>> show <$> Just 3- -- Just "3"- --- -- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@- -- 'String' using 'show':- --- -- >>> show <$> Left 17- -- Left 17- -- >>> show <$> Right 17- -- Right "17"- --- -- Double each element of a list:- --- -- >>> (*2) <$> [1,2,3]- -- [2,4,6]- --- -- Apply 'even' to the second element of a pair:- --- -- >>> even <$> (2,2)- -- (2,True)- --- (<$>) :: Functor f => (a -> b) -> f a -> f b- (<$>) = fmap-- infixl 4 $>-- -- -| Flipped version of '<$>'.- --- -- @- -- ('<&>') = 'flip' 'fmap'- -- @- --- -- @since 4.11.0.0- --- -- ==== __Examples__- -- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right':- --- -- >>> Just 2 <&> (+1)- -- Just 3- --- -- >>> [1,2,3] <&> (+1)- -- [2,3,4]- --- -- >>> Right 3 <&> (+1)- -- Right 4- --- (<&>) :: Functor f => f a -> (a -> b) -> f b- as <&> f = f <$> as-- infixl 1 <&>-- -- -| Flipped version of '<$'.- --- -- @since 4.7.0.0- --- -- ==== __Examples__- --- -- Replace the contents of a @'Maybe' 'Int'@ with a constant 'String':- --- -- >>> Nothing $> "foo"- -- Nothing- -- >>> Just 90210 $> "foo"- -- Just "foo"- --- -- Replace the contents of an @'Either' 'Int' 'Int'@ with a constant- -- 'String', resulting in an @'Either' 'Int' 'String'@:- --- -- >>> Left 8675309 $> "foo"- -- Left 8675309- -- >>> Right 8675309 $> "foo"- -- Right "foo"- --- -- Replace each element of a list with a constant 'String':- --- -- >>> [1,2,3] $> "foo"- -- ["foo","foo","foo"]- --- -- Replace the second element of a pair with a constant 'String':- --- -- >>> (1,2) $> "foo"- -- (1,"foo")- --- ($>) :: Functor f => f a -> b -> f b- ($>) = flip (<$)-- -- -| @'void' value@ discards or ignores the result of evaluation, such- -- as the return value of an 'System.IO.IO' action.- --- -- ==== __Examples__- --- -- Replace the contents of a @'Maybe' 'Int'@ with unit:- --- -- >>> void Nothing- -- Nothing- -- >>> void (Just 3)- -- Just ()- --- -- Replace the contents of an @'Either' 'Int' 'Int'@ with unit,- -- resulting in an @'Either' 'Int' '()'@:- --- -- >>> void (Left 8675309)- -- Left 8675309- -- >>> void (Right 8675309)- -- Right ()- --- -- Replace every element of a list with unit:- --- -- >>> void [1,2,3]- -- [(),(),()]- --- -- Replace the second element of a pair with unit:- --- -- >>> void (1,2)- -- (1,())- --- -- Discard the result of an 'System.IO.IO' action:- --- -- >>> mapM print [1,2]- -- 1- -- 2- -- [(),()]- -- >>> void $ mapM print [1,2]- -- 1- -- 2- --- void :: Functor f => f a -> f ()- void x = () <$ x-- deriving instance Functor ((,) a)- deriving instance Functor Down- |])---- Workaround for #326-infixl 4 <$>-infixl 4 $>-infixl 1 <&>
− src/Data/Singletons/Prelude/Identity.hs
@@ -1,114 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Identity--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability : experimental--- Portability : non-portable------ Exports the promoted and singled versions of the 'Identity' data type.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Identity (- -- * The 'Identity' singleton- Sing(SIdentity, sRunIdentity),- SIdentity, RunIdentity,-- -- * Defunctionalization symbols- IdentitySym0, IdentitySym1,- RunIdentitySym0, RunIdentitySym1- ) where--import Control.Applicative-import Data.Foldable (Foldable(..))-import Data.Functor.Identity-import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr)-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Instances hiding (Foldl, sFoldl)-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Semigroup.Internal-import Data.Singletons.Prelude.Show-import Data.Singletons.Single--$(singletonsOnly [d|- -- deriving instance Enum a => Enum (Identity a)- instance Enum a => Enum (Identity a) where- succ (Identity x) = Identity (succ x)- pred (Identity x) = Identity (pred x)- toEnum i = Identity (toEnum i)- fromEnum (Identity x) = fromEnum x- enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y)- enumFromThenTo (Identity x) (Identity y) (Identity z) =- map Identity (enumFromThenTo x y z)-- -- deriving instance Monoid a => Monoid (Identity a)- instance Monoid a => Monoid (Identity a) where- mempty = Identity mempty-- -- deriving instance Num a => Num (Identity a)- instance Num a => Num (Identity a) where- Identity x + Identity y = Identity (x + y)- Identity x - Identity y = Identity (x - y)- Identity x * Identity y = Identity (x * y)- negate (Identity x) = Identity (negate x)- abs (Identity x) = Identity (abs x)- signum (Identity x) = Identity (signum x)- fromInteger n = Identity (fromInteger n)-- -- deriving instance Semigroup a => Semigroup (Identity a)- instance Semigroup a => Semigroup (Identity a) where- Identity x <> Identity y = Identity (x <> y)-- -- -| This instance would be equivalent to the derived instances of the- -- 'Identity' newtype if the 'runIdentity' field were removed- instance Show a => Show (Identity a) where- showsPrec d (Identity x) = showParen (d > 10) $- showString "Identity " . showsPrec 11 x-- deriving instance Functor Identity-- instance Foldable Identity where- foldMap f (Identity x) = f x-- elem x (Identity y) = x == y- foldl f z (Identity x) = f z x- foldl' f z (Identity x) = f z x- foldl1 _ (Identity x) = x- foldr f z (Identity x) = f x z- foldr' = foldr- foldr1 _ (Identity x) = x- length _ = 1- maximum (Identity x) = x- minimum (Identity x) = x- null _ = False- product (Identity x) = x- sum (Identity x) = x- toList (Identity x) = [x]-- instance Applicative Identity where- pure = Identity- Identity f <*> Identity x = Identity (f x)- liftA2 f (Identity x) (Identity y) = Identity (f x y)-- instance Monad Identity where- Identity m >>= k = k m- |])
− src/Data/Singletons/Prelude/Instances.hs
@@ -1,34 +0,0 @@-{- Data/Singletons/Instances.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--This (internal) module contains the main class definitions for singletons,-re-exported from various places.---}--{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs, TypeFamilies, EmptyCase,- FlexibleContexts, TemplateHaskell, ScopedTypeVariables,- UndecidableInstances, TypeOperators, FlexibleInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}--module Data.Singletons.Prelude.Instances where--import Data.Singletons.Single-import Data.Singletons.Util---- some useful singletons-$(genSingletons basicTypes)-$(singDecideInstances basicTypes)---- basic definitions we need right away--$(singletonsOnly [d|- foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b- foldl f z0 xs0 = lgo z0 xs0- where- lgo :: b -> [a] -> b- lgo z [] = z- lgo z (x:xs) = lgo (f z x) xs- |])
− src/Data/Singletons/Prelude/IsString.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.IsString--- Copyright : (C) 2017 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines and exports a promoted and singled version of the 'IsString'--- type class from "Data.String".-------------------------------------------------------------------------------module Data.Singletons.Prelude.IsString (- PIsString(..), SIsString(..),-- -- ** Defunctionalization symbols- FromStringSym0, FromStringSym1- ) where--import Data.Functor.Const-import Data.Functor.Identity-import Data.Singletons.Prelude.Const-import Data.Singletons.Prelude.Identity-import Data.Singletons.Single-import Data.Singletons.TypeLits () -- for the IsString instance!-import GHC.TypeLits (Symbol)--$(singletonsOnly [d|- -- -| Class for string-like datastructures; used by the overloaded string- -- extension (-XOverloadedStrings in GHC).- class IsString a where- fromString :: Symbol -> a-- -- deriving instance IsString a => IsString (Const a (b :: k))- instance IsString a => IsString (Const a (b :: k)) where- fromString x = Const (fromString x)-- -- deriving instance IsString a => IsString (Identity a)- instance IsString a => IsString (Identity a) where- fromString x = Identity (fromString x)- |])---- PIsString instance-instance PIsString Symbol where- type FromString a = a---- SIsString instance-instance SIsString Symbol where- sFromString x = x
− src/Data/Singletons/Prelude/List.hs
@@ -1,296 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.List--- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for '[]',--- including a singletons version of a few of the definitions in @Data.List@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.List@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.List (- -- * The singleton for lists- Sing(SNil, SCons),- -- | Though Haddock doesn't show it, the 'Sing' instance above declares- -- constructors- --- -- > SNil :: Sing '[]- -- > SCons :: Sing (h :: k) -> Sing (t :: [k]) -> Sing (h ': t)-- SList,- -- | 'SList' is a kind-restricted synonym for 'Sing': @type SList (a :: [k]) = Sing a@-- -- * Basic functions- type (++), (%++), Head, sHead, Last, sLast, Tail, sTail, Init, sInit,- Null, sNull, Length, sLength,-- -- * List transformations- Map, sMap, Reverse, sReverse, Intersperse, sIntersperse,- Intercalate, sIntercalate, Transpose, sTranspose,- Subsequences, sSubsequences, Permutations, sPermutations,-- -- * Reducing lists (folds)- Foldl, sFoldl, Foldl', sFoldl', Foldl1, sFoldl1, Foldl1', sFoldl1',- Foldr, sFoldr, Foldr1, sFoldr1,-- -- ** Special folds- Concat, sConcat, ConcatMap, sConcatMap,- And, sAnd, Or, sOr, Any, sAny, All, sAll,- Sum, sSum, Product, sProduct, Maximum, sMaximum,- Minimum, sMinimum,-- -- * Building lists-- -- ** Scans- Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1,-- -- ** Accumulating maps- MapAccumL, sMapAccumL, MapAccumR, sMapAccumR,-- -- ** Cyclical lists- Replicate, sReplicate,-- -- ** Unfolding- Unfoldr, sUnfoldr,-- -- * Sublists-- -- ** Extracting sublists- Take, sTake, Drop, sDrop, SplitAt, sSplitAt,- TakeWhile, sTakeWhile, DropWhile, sDropWhile, DropWhileEnd, sDropWhileEnd,- Span, sSpan, Break, sBreak,- StripPrefix,- Group, sGroup,- Inits, sInits, Tails, sTails,-- -- ** Predicates- IsPrefixOf, sIsPrefixOf, IsSuffixOf, sIsSuffixOf, IsInfixOf, sIsInfixOf,-- -- * Searching lists-- -- ** Searching by equality- Elem, sElem, NotElem, sNotElem, Lookup, sLookup,-- -- ** Searching with a predicate- Find, sFind, Filter, sFilter, Partition, sPartition,-- -- * Indexing lists- type (!!), (%!!),- ElemIndex, sElemIndex, ElemIndices, sElemIndices,- FindIndex, sFindIndex, FindIndices, sFindIndices,-- -- * Zipping and unzipping lists- Zip, sZip, Zip3, sZip3,- Zip4, Zip5, Zip6, Zip7,- ZipWith, sZipWith, ZipWith3, sZipWith3,- ZipWith4, ZipWith5, ZipWith6, ZipWith7,- Unzip, sUnzip, Unzip3, sUnzip3, Unzip4, sUnzip4,- Unzip5, sUnzip5, Unzip6, sUnzip6, Unzip7, sUnzip7,-- -- * Special lists-- -- ** Functions on 'Symbol's- Unlines, sUnlines,- Unwords, sUnwords,-- -- ** \"Set\" operations- Nub, sNub, Delete, sDelete, type (\\), (%\\),- Union, sUnion, Intersect, sIntersect,-- -- ** Ordered lists- Insert, sInsert, Sort, sSort,-- -- * Generalized functions-- -- ** The \"@By@\" operations-- -- *** User-supplied equality (replacing an @Eq@ context)- -- | The predicate is assumed to define an equivalence.- NubBy, sNubBy,- DeleteBy, sDeleteBy, DeleteFirstsBy, sDeleteFirstsBy,- UnionBy, sUnionBy, IntersectBy, sIntersectBy,- GroupBy, sGroupBy,-- -- *** User-supplied comparison (replacing an @Ord@ context)- -- | The function is assumed to define a total ordering.- SortBy, sSortBy, InsertBy, sInsertBy,- MaximumBy, sMaximumBy, MinimumBy, sMinimumBy,-- -- ** The \"@generic@\" operations- -- | The prefix \`@generic@\' indicates an overloaded function that- -- is a generalized version of a "Prelude" function.- GenericLength, sGenericLength,- GenericTake, GenericDrop,- GenericSplitAt, GenericIndex, GenericReplicate,-- -- * Defunctionalization symbols- NilSym0,- (:@#@$), (:@#@$$), (:@#@$$$),-- type (++@#@$$$), type (++@#@$$), type (++@#@$),- HeadSym0, HeadSym1, LastSym0, LastSym1,- TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1,- LengthSym0, LengthSym1,-- MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1,- IntersperseSym0, IntersperseSym1, IntersperseSym2,- IntercalateSym0, IntercalateSym1, IntercalateSym2,- TransposeSym0, TransposeSym1,- SubsequencesSym0, SubsequencesSym1,- PermutationsSym0, PermutationsSym1,-- FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,- Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3,- Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,- Foldl1'Sym0, Foldl1'Sym1, Foldl1'Sym2,- FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,- Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,-- ConcatSym0, ConcatSym1,- ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,- AndSym0, AndSym1, OrSym0, OrSym1,- AnySym0, AnySym1, AnySym2,- AllSym0, AllSym1, AllSym2,- SumSym0, SumSym1,- ProductSym0, ProductSym1,- MaximumSym0, MaximumSym1,- MinimumSym0, MinimumSym1,-- ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,- Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,- ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,- Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,-- MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3,- MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3,-- ReplicateSym0, ReplicateSym1, ReplicateSym2,-- UnfoldrSym0, UnfoldrSym1, UnfoldrSym2,-- TakeSym0, TakeSym1, TakeSym2,- DropSym0, DropSym1, DropSym2,- SplitAtSym0, SplitAtSym1, SplitAtSym2,- TakeWhileSym0, TakeWhileSym1, TakeWhileSym2,- DropWhileSym0, DropWhileSym1, DropWhileSym2,- DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2,- SpanSym0, SpanSym1, SpanSym2,- BreakSym0, BreakSym1, BreakSym2,- StripPrefixSym0, StripPrefixSym1, StripPrefixSym2,- GroupSym0, GroupSym1,- InitsSym0, InitsSym1, TailsSym0, TailsSym1,-- IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2,- IsSuffixOfSym0, IsSuffixOfSym1, IsSuffixOfSym2,- IsInfixOfSym0, IsInfixOfSym1, IsInfixOfSym2,-- ElemSym0, ElemSym1, ElemSym2,- NotElemSym0, NotElemSym1, NotElemSym2,- LookupSym0, LookupSym1, LookupSym2,-- FindSym0, FindSym1, FindSym2,- FilterSym0, FilterSym1, FilterSym2,- PartitionSym0, PartitionSym1, PartitionSym2,-- type (!!@#@$), type (!!@#@$$), type (!!@#@$$$),- ElemIndexSym0, ElemIndexSym1, ElemIndexSym2,- ElemIndicesSym0, ElemIndicesSym1, ElemIndicesSym2,- FindIndexSym0, FindIndexSym1, FindIndexSym2,- FindIndicesSym0, FindIndicesSym1, FindIndicesSym2,-- ZipSym0, ZipSym1, ZipSym2,- Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3,- Zip4Sym0, Zip4Sym1, Zip4Sym2, Zip4Sym3, Zip4Sym4,- Zip5Sym0, Zip5Sym1, Zip5Sym2, Zip5Sym3, Zip5Sym4, Zip5Sym5,- Zip6Sym0, Zip6Sym1, Zip6Sym2, Zip6Sym3, Zip6Sym4, Zip6Sym5, Zip6Sym6,- Zip7Sym0, Zip7Sym1, Zip7Sym2, Zip7Sym3, Zip7Sym4, Zip7Sym5, Zip7Sym6, Zip7Sym7,- ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,- ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4,- ZipWith4Sym0, ZipWith4Sym1, ZipWith4Sym2, ZipWith4Sym3, ZipWith4Sym4, ZipWith4Sym5,- ZipWith5Sym0, ZipWith5Sym1, ZipWith5Sym2, ZipWith5Sym3, ZipWith5Sym4, ZipWith5Sym5, ZipWith5Sym6,- ZipWith6Sym0, ZipWith6Sym1, ZipWith6Sym2, ZipWith6Sym3, ZipWith6Sym4, ZipWith6Sym5, ZipWith6Sym6, ZipWith6Sym7,- ZipWith7Sym0, ZipWith7Sym1, ZipWith7Sym2, ZipWith7Sym3, ZipWith7Sym4, ZipWith7Sym5, ZipWith7Sym6, ZipWith7Sym7, ZipWith7Sym8,- UnzipSym0, UnzipSym1,- Unzip3Sym0, Unzip3Sym1,- Unzip4Sym0, Unzip4Sym1,- Unzip5Sym0, Unzip5Sym1,- Unzip6Sym0, Unzip6Sym1,- Unzip7Sym0, Unzip7Sym1,-- UnlinesSym0, UnlinesSym1,- UnwordsSym0, UnwordsSym1,-- NubSym0, NubSym1,- DeleteSym0, DeleteSym1, DeleteSym2,- type (\\@#@$), type (\\@#@$$), type (\\@#@$$$),- UnionSym0, UnionSym1, UnionSym2,- IntersectSym0, IntersectSym1, IntersectSym2,-- InsertSym0, InsertSym1, InsertSym2,- SortSym0, SortSym1,-- NubBySym0, NubBySym1, NubBySym2,- DeleteBySym0, DeleteBySym1, DeleteBySym2, DeleteBySym3,- DeleteFirstsBySym0, DeleteFirstsBySym1, DeleteFirstsBySym2, DeleteFirstsBySym3,- UnionBySym0, UnionBySym1, UnionBySym2, UnionBySym3,- IntersectBySym0, IntersectBySym1, IntersectBySym2, IntersectBySym3,- GroupBySym0, GroupBySym1, GroupBySym2,-- SortBySym0, SortBySym1, SortBySym2,- InsertBySym0, InsertBySym1, InsertBySym2, InsertBySym3,- MaximumBySym0, MaximumBySym1, MaximumBySym2,- MinimumBySym0, MinimumBySym1, MinimumBySym2,-- GenericLengthSym0, GenericLengthSym1,- GenericTakeSym0, GenericTakeSym1, GenericTakeSym2,- GenericDropSym0, GenericDropSym1, GenericDropSym2,- GenericSplitAtSym0, GenericSplitAtSym1, GenericSplitAtSym2,- GenericIndexSym0, GenericIndexSym1, GenericIndexSym2,- GenericReplicateSym0, GenericReplicateSym1, GenericReplicateSym2,- ) where--import Data.Singletons.Prelude.Base- ( Map, MapSym0, MapSym1, MapSym2, sMap- , type (++), type (++@#@$), type (++@#@$$), type (++@#@$$$), (%++)- )-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Instances- (Sing(..), SList, NilSym0, type (:@#@$), type (:@#@$$), type (:@#@$$$))-import Data.Singletons.Prelude.Traversable--import Data.Singletons.Prelude.List.Internal- hiding ( All, AllSym0, AllSym1, AllSym2, sAll- , And, AndSym0, AndSym1, sAnd- , Any, AnySym0, AnySym1, AnySym2, sAny- , Concat, ConcatSym0, ConcatSym1, sConcat- , ConcatMap, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, sConcatMap- , Elem, ElemSym0, ElemSym1, ElemSym2, sElem- , Find, FindSym0, FindSym1, FindSym2, sFind- , Foldl1, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, sFoldl1- , Foldl', Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, sFoldl'- , Foldr1, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, sFoldr1- , MapAccumL, MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, sMapAccumL- , MapAccumR, MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, sMapAccumR- , Maximum, MaximumSym0, MaximumSym1, sMaximum- , MaximumBy, MaximumBySym0, MaximumBySym1, MaximumBySym2, sMaximumBy- , Minimum, MinimumSym0, MinimumSym1, sMinimum- , MinimumBy, MinimumBySym0, MinimumBySym1, MinimumBySym2, sMinimumBy- , Length, LengthSym0, LengthSym1, sLength- , NotElem, NotElemSym0, NotElemSym1, NotElemSym2, sNotElem- , Null, NullSym0, NullSym1, sNull- , Or, OrSym0, OrSym1, sOr- , Product, ProductSym0, ProductSym1, sProduct- , Sum, SumSym0, SumSym1, sSum- )
− src/Data/Singletons/Prelude/List/Internal.hs
@@ -1,670 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies,- TemplateHaskell, GADTs, UndecidableInstances, RankNTypes,- ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-}-{-# OPTIONS_GHC -O0 #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.List.Internal--- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for '[]',--- including a singletons version of a few of the definitions in @Data.List@.------ All of the functions defined in this module are specialized for lists,--- unlike "Data.Singletons.Prelude.List", which uses 'Foldable' and--- 'Traversable' contexts when available.----------------------------------------------------------------------------------module Data.Singletons.Prelude.List.Internal where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Promote-import Data.Singletons.Single-import Data.Singletons.TypeLits-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Semigroup.Internal (SSemigroup(..), type (<>@#@$))-import Data.Singletons.Prelude.Tuple-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Maybe--$(singletonsOnly [d|- head :: [a] -> a- head (a : _) = a- head [] = error "Data.Singletons.List.head: empty list"-- last :: [a] -> a- last [] = error "Data.Singletons.List.last: empty list"- last [x] = x- last (_:x:xs) = last (x:xs)-- tail :: [a] -> [a]- tail (_ : t) = t- tail [] = error "Data.Singletons.List.tail: empty list"-- init :: [a] -> [a]- init [] = error "Data.Singletons.List.init: empty list"- init (x:xs) = init' x xs- where init' :: a -> [a] -> [a]- init' _ [] = []- init' y (z:zs) = y : init' z zs-- null :: [a] -> Bool- null [] = True- null (_:_) = False-- reverse :: [a] -> [a]- reverse l = rev l []- where- rev :: [a] -> [a] -> [a]- rev [] a = a- rev (x:xs) a = rev xs (x:a)-- intersperse :: a -> [a] -> [a]- intersperse _ [] = []- intersperse sep (x:xs) = x : prependToAll sep xs-- intercalate :: [a] -> [[a]] -> [a]- intercalate xs xss = concat (intersperse xs xss)-- subsequences :: [a] -> [[a]]- subsequences xs = [] : nonEmptySubsequences xs-- nonEmptySubsequences :: [a] -> [[a]]- nonEmptySubsequences [] = []- nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)- where f ys r = ys : (x : ys) : r-- prependToAll :: a -> [a] -> [a]- prependToAll _ [] = []- prependToAll sep (x:xs) = sep : x : prependToAll sep xs-- permutations :: forall a. [a] -> [[a]]- permutations xs0 = xs0 : perms xs0 []- where- perms [] _ = []- perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)- where interleave xs r = let (_,zs) = interleave' id xs r in zs-- -- This type signature isn't present in the reference- -- implementation of permutations in base. However, it is needed- -- here, since (at least in GHC 8.2.1) the singletonized version- -- will fail to typecheck without it. See #13549 for the full story.- interleave' :: ([a] -> b) -> [a] -> [b] -> ([a], [b])- interleave' _ [] r = (ts, r)- interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r- in (y:us, f (t:y:us) : zs)-- foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b- foldl' f z0 xs0 = lgo z0 xs0- where lgo :: b -> [a] -> b- lgo z [] = z- lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs-- foldl1 :: (a -> a -> a) -> [a] -> a- foldl1 f (x:xs) = foldl f x xs- foldl1 _ [] = error "Data.Singletons.List.foldl1: empty list"-- foldl1' :: (a -> a -> a) -> [a] -> a- foldl1' f (x:xs) = foldl' f x xs- foldl1' _ [] = error "Data.Singletons.List.foldl1': empty list"-- foldr1 :: (a -> a -> a) -> [a] -> a- foldr1 _ [x] = x- foldr1 f (x:xs@(_:_)) = f x (foldr1 f xs)- foldr1 _ [] = error "Data.Singletons.List.foldr1: empty list"-- concat :: [[a]] -> [a]- concat = foldr (++) []-- concatMap :: (a -> [b]) -> [a] -> [b]- concatMap f = foldr ((++) . f) []-- and :: [Bool] -> Bool- and [] = True- and (x:xs) = x && and xs-- or :: [Bool] -> Bool- or [] = False- or (x:xs) = x || or xs-- all :: (a -> Bool) -> [a] -> Bool- all _ [] = True- all p (x:xs) = p x && all p xs-- any :: (a -> Bool) -> [a] -> Bool- any _ [] = False- any p (x:xs) = p x || any p xs-- scanl :: (b -> a -> b) -> b -> [a] -> [b]- scanl f q ls = q : (case ls of- [] -> []- x:xs -> scanl f (f q x) xs)- scanl1 :: (a -> a -> a) -> [a] -> [a]- scanl1 f (x:xs) = scanl f x xs- scanl1 _ [] = []-- scanr :: (a -> b -> b) -> b -> [a] -> [b]- scanr _ q0 [] = [q0]- scanr f q0 (x:xs) = case scanr f q0 xs of- [] -> error "Data.Singletons.List.scanr: empty list"- (q:qs) -> f x q : (q:qs)-- scanr1 :: (a -> a -> a) -> [a] -> [a]- scanr1 _ [] = []- scanr1 _ [x] = [x]- scanr1 f (x:xs@(_:_)) = case scanr1 f xs of- [] -> error "Data.Singletons.List.scanr1: empty list"- (q:qs) -> f x q : (q:qs)-- mapAccumL :: (acc -> x -> (acc, y))- -> acc- -> [x]- -> (acc, [y])- mapAccumL _ s [] = (s, [])- mapAccumL f s (x:xs) = (s'',y:ys)- where (s', y ) = f s x- (s'',ys) = mapAccumL f s' xs-- mapAccumR :: (acc -> x -> (acc, y))- -> acc- -> [x]- -> (acc, [y])- mapAccumR _ s [] = (s, [])- mapAccumR f s (x:xs) = (s'', y:ys)- where (s'',y ) = f s' x- (s', ys) = mapAccumR f s xs-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]- unfoldr f b =- case f b of- Just (a,new_b) -> a : unfoldr f new_b- Nothing -> []-- inits :: [a] -> [[a]]- inits xs = [] : case xs of- [] -> []- x : xs' -> map (x :) (inits xs')-- tails :: [a] -> [[a]]- tails xs = xs : case xs of- [] -> []- _ : xs' -> tails xs'-- isPrefixOf :: (Eq a) => [a] -> [a] -> Bool- isPrefixOf [] [] = True- isPrefixOf [] (_:_) = True- isPrefixOf (_:_) [] = False- isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys-- isSuffixOf :: (Eq a) => [a] -> [a] -> Bool- isSuffixOf x y = reverse x `isPrefixOf` reverse y-- isInfixOf :: (Eq a) => [a] -> [a] -> Bool- isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)-- elem :: (Eq a) => a -> [a] -> Bool- elem _ [] = False- elem x (y:ys) = x==y || elem x ys- infix 4 `elem`-- notElem :: (Eq a) => a -> [a] -> Bool- notElem _ [] = True- notElem x (y:ys) = x /= y && notElem x ys- infix 4 `notElem`-- zip :: [a] -> [b] -> [(a,b)]- zip (x:xs) (y:ys) = (x,y) : zip xs ys- zip [] [] = []- zip (_:_) [] = []- zip [] (_:_) = []-- zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]- zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs- zip3 [] [] [] = []- zip3 [] [] (_:_) = []- zip3 [] (_:_) [] = []- zip3 [] (_:_) (_:_) = []- zip3 (_:_) [] [] = []- zip3 (_:_) [] (_:_) = []- zip3 (_:_) (_:_) [] = []-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]- zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys- zipWith _ [] [] = []- zipWith _ (_:_) [] = []- zipWith _ [] (_:_) = []-- zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]- zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs- zipWith3 _ [] [] [] = []- zipWith3 _ [] [] (_:_) = []- zipWith3 _ [] (_:_) [] = []- zipWith3 _ [] (_:_) (_:_) = []- zipWith3 _ (_:_) [] [] = []- zipWith3 _ (_:_) [] (_:_) = []- zipWith3 _ (_:_) (_:_) [] = []-- unzip :: [(a,b)] -> ([a],[b])- unzip xs = foldr (\(a,b) (as,bs) -> (a:as,b:bs)) ([],[]) xs-- -- Lazy patterns removed from unzip- unzip3 :: [(a,b,c)] -> ([a],[b],[c])- unzip3 xs = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs))- ([],[],[]) xs-- unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])- unzip4 xs = foldr (\(a,b,c,d) (as,bs,cs,ds) ->- (a:as,b:bs,c:cs,d:ds))- ([],[],[],[]) xs-- unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])- unzip5 xs = foldr (\(a,b,c,d,e) (as,bs,cs,ds,es) ->- (a:as,b:bs,c:cs,d:ds,e:es))- ([],[],[],[],[]) xs-- unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])- unzip6 xs = foldr (\(a,b,c,d,e,f) (as,bs,cs,ds,es,fs) ->- (a:as,b:bs,c:cs,d:ds,e:es,f:fs))- ([],[],[],[],[],[]) xs-- unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])- unzip7 xs = foldr (\(a,b,c,d,e,f,g) (as,bs,cs,ds,es,fs,gs) ->- (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))- ([],[],[],[],[],[],[]) xs---- We can't promote any of these functions because at the type level--- String literals are no longer considered to be lists of Chars, so--- there is mismatch between term-level and type-level semantics--- lines :: String -> [String]--- lines "" = []--- lines s = cons (case break (== '\n') s of--- (l, s') -> (l, case s' of--- [] -> []--- _:s'' -> lines s''))--- where--- cons ~(h, t) = h : t------ words :: String -> [String]--- words s = case dropWhile isSpace s of--- "" -> []--- s' -> w : words s''--- where (w, s'') =--- break isSpace s'-- unlines :: [Symbol] -> Symbol- unlines [] = ""- unlines (l:ls) = l <> "\n" <> unlines ls-- unwords :: [Symbol] -> Symbol- unwords [] = ""- unwords (w:ws) = w <> go ws- where- go [] = ""- go (v:vs) = " " <> (v <> go vs)-- delete :: (Eq a) => a -> [a] -> [a]- delete = deleteBy (==)-- (\\) :: (Eq a) => [a] -> [a] -> [a]- (\\) = foldl (flip delete)- infix 5 \\ -- This comment is necessary so CPP doesn't treat the- -- trailing backslash as a line splice. Urgh.-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]- deleteBy _ _ [] = []- deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys-- deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]- deleteFirstsBy eq = foldl (flip (deleteBy eq))-- sortBy :: (a -> a -> Ordering) -> [a] -> [a]- sortBy cmp = foldr (insertBy cmp) []-- insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]- insertBy _ x [] = [x]- insertBy cmp x ys@(y:ys')- = case cmp x y of- GT -> y : insertBy cmp x ys'- LT -> x : ys- EQ -> x : ys-- maximumBy :: (a -> a -> Ordering) -> [a] -> a- maximumBy _ [] = error "Data.Singletons.List.maximumBy: empty list"- maximumBy cmp xs@(_:_) = foldl1 maxBy xs- where- maxBy x y = case cmp x y of- GT -> x- EQ -> y- LT -> y-- minimumBy :: (a -> a -> Ordering) -> [a] -> a- minimumBy _ [] = error "Data.Singletons.List.minimumBy: empty list"- minimumBy cmp xs@(_:_) = foldl1 minBy xs- where- minBy x y = case cmp x y of- GT -> y- EQ -> x- LT -> x-- filter :: (a -> Bool) -> [a] -> [a]- filter _p [] = []- filter p (x:xs) = if p x then x : filter p xs else filter p xs-- find :: (a -> Bool) -> [a] -> Maybe a- find p = listToMaybe . filter p---- These three rely on findIndices, which does not promote.--- Since we have our own implementation of findIndices these are perfectly valid- elemIndex :: Eq a => a -> [a] -> Maybe Nat- elemIndex x = findIndex (x==)-- elemIndices :: Eq a => a -> [a] -> [Nat]- elemIndices x = findIndices (x==)-- findIndex :: (a -> Bool) -> [a] -> Maybe Nat- findIndex p = listToMaybe . findIndices p---- Uses infinite lists and and Ints--- findIndices :: (a -> Bool) -> [a] -> [Int]--- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]-- findIndices :: (a -> Bool) -> [a] -> [Nat]- findIndices p xs = map snd (filter (\(x,_) -> p x)- (zip xs (buildList 0 xs)))- where buildList :: Nat -> [b] -> [Nat]- buildList _ [] = []- buildList a (_:rest) = a : buildList (a+1) rest-- intersect :: (Eq a) => [a] -> [a] -> [a]- intersect = intersectBy (==)-- intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]- intersectBy _ [] [] = []- intersectBy _ [] (_:_) = []- intersectBy _ (_:_) [] = []- intersectBy eq xs@(_:_) ys@(_:_) = [x | x <- xs, any (eq x) ys]-- takeWhile :: (a -> Bool) -> [a] -> [a]- takeWhile _ [] = []- takeWhile p (x:xs) = if p x then x : takeWhile p xs else []-- dropWhile :: (a -> Bool) -> [a] -> [a]- dropWhile _ [] = []- dropWhile p xs@(x:xs') = if p x then dropWhile p xs' else xs-- dropWhileEnd :: (a -> Bool) -> [a] -> [a]- dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []-- span :: (a -> Bool) -> [a] -> ([a],[a])- span _ xs@[] = (xs, xs)- span p xs@(x:xs') = if p x then let (ys,zs) = span p xs' in (x:ys,zs)- else ([], xs)-- break :: (a -> Bool) -> [a] -> ([a],[a])- break _ xs@[] = (xs, xs)- break p xs@(x:xs') = if p x then ([],xs)- else let (ys,zs) = break p xs' in (x:ys,zs)---- Can't be promoted because of limitations of Int promotion--- Below is a re-implementation using Nat--- take :: Int -> [a] -> [a]--- take n _ | n <= 0 = []--- take _ [] = []--- take n (x:xs) = x : take (n-1) xs---- drop :: Int -> [a] -> [a]--- drop n xs | n <= 0 = xs--- drop _ [] = []--- drop n (_:xs) = drop (n-1) xs---- splitAt :: Int -> [a] -> ([a],[a])--- splitAt n xs = (take n xs, drop n xs)-- take :: Nat -> [a] -> [a]- take _ [] = []- take n (x:xs) = if n == 0 then [] else x : take (n-1) xs-- drop :: Nat -> [a] -> [a]- drop _ [] = []- drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs-- splitAt :: Nat -> [a] -> ([a],[a])- splitAt n xs = (take n xs, drop n xs)-- group :: Eq a => [a] -> [[a]]- group xs = groupBy (==) xs-- maximum :: (Ord a) => [a] -> a- maximum [] = error "Data.Singletons.List.maximum: empty list"- maximum xs@(_:_) = foldl1 max xs-- minimum :: (Ord a) => [a] -> a- minimum [] = error "Data.Singletons.List.minimum: empty list"- minimum xs@(_:_) = foldl1 min xs-- insert :: Ord a => a -> [a] -> [a]- insert e ls = insertBy (compare) e ls-- sort :: (Ord a) => [a] -> [a]- sort = sortBy compare-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]- groupBy _ [] = []- groupBy eq (x:xs) = (x:ys) : groupBy eq zs- where (ys,zs) = span (eq x) xs-- lookup :: (Eq a) => a -> [(a,b)] -> Maybe b- lookup _key [] = Nothing- lookup key ((x,y):xys) = if key == x then Just y else lookup key xys-- partition :: (a -> Bool) -> [a] -> ([a],[a])- partition p xs = foldr (select p) ([],[]) xs-- -- Lazy pattern removed from select- select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])- select p x (ts,fs) = if p x then (x:ts,fs) else (ts, x:fs)---- Can't be promoted because of limitations of Int promotion--- Below is a re-implementation using Nat--- sum :: (Num a) => [a] -> a--- sum l = sum' l 0--- where--- sum' [] a = a--- sum' (x:xs) a = sum' xs (a+x)------ product :: (Num a) => [a] -> a--- product l = prod l 1--- where--- prod [] a = a--- prod (x:xs) a = prod xs (a*x)-- sum :: forall a. Num a => [a] -> a- sum l = sum' l 0- where- sum' :: [a] -> a -> a- sum' [] a = a- sum' (x:xs) a = sum' xs (a+x)-- product :: forall a. Num a => [a] -> a- product l = prod l 1- where- prod :: [a] -> a -> a- prod [] a = a- prod (x:xs) a = prod xs (a*x)----- Can't be promoted because of limitations of Int promotion--- Below is a re-implementation using Nat--- length :: [a] -> Int--- length l = lenAcc l 0#------ lenAcc :: [a] -> Int# -> Int--- lenAcc [] a# = I# a#--- lenAcc (_:xs) a# = lenAcc xs (a# +# 1#)------ incLen :: a -> (Int# -> Int) -> Int# -> Int--- incLen _ g x = g (x +# 1#)-- length :: [a] -> Nat- length [] = 0- length (_:xs) = 1 + length xs---- Functions working on infinite lists don't promote because they create--- infinite types. replicate also uses integers, but luckily it can be rewritten--- iterate :: (a -> a) -> a -> [a]--- iterate f x = x : iterate f (f x)------ repeat :: a -> [a]--- repeat x = xs where xs = x : xs------ replicate :: Int -> a -> [a]--- replicate n x = take n (repeat x)------ cycle :: [a] -> [a]--- cycle [] = error "Data.Singletons.List.cycle: empty list"--- cycle xs = xs' where xs' = xs ++ xs'-- replicate :: Nat -> a -> [a]- replicate n x = if n == 0 then [] else x : replicate (n-1) x---- Uses partial pattern-matching in a list comprehension--- (see https://github.com/goldfirere/singletons/issues/340)--- transpose :: [[a]] -> [[a]]--- transpose [] = []--- transpose ([] : xss) = transpose xss--- transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])-- transpose :: [[a]] -> [[a]]- transpose [] = []- transpose ([] : xss) = transpose xss- transpose ((x:xs) : xss) = (x : (map head xss)) : transpose (xs : (map tail xss))---- Can't be promoted because of limitations of Int promotion.--- Below is a re-implementation using Nat--- (!!) :: [a] -> Int -> a--- xs !! n | n < 0 = error "Data.Singletons.List.!!: negative index"--- [] !! _ = error "Data.Singletons.List.!!: index too large"--- (x:_) !! 0 = x--- (_:xs) !! n = xs !! (n-1)-- (!!) :: [a] -> Nat -> a- [] !! _ = error "Data.Singletons.List.!!: index too large"- (x:xs) !! n = if n == 0 then x else xs !! (n-1)- infixl 9 !!-- nub :: forall a. (Eq a) => [a] -> [a]- nub l = nub' l []- where- nub' :: [a] -> [a] -> [a]- nub' [] _ = []- nub' (x:xs) ls = if x `elem` ls then nub' xs ls else x : nub' xs (x:ls)-- nubBy :: (a -> a -> Bool) -> [a] -> [a]- nubBy eq l = nubBy' l []- where- nubBy' [] _ = []- nubBy' (y:ys) xs = if elem_by eq y xs then nubBy' ys xs else y : nubBy' ys (y:xs)-- elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool- elem_by _ _ [] = False- elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs-- unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]- unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs-- union :: (Eq a) => [a] -> [a] -> [a]- union = unionBy (==)-- genericLength :: (Num i) => [a] -> i- genericLength [] = 0- genericLength (_:xs) = 1 + genericLength xs-- |])---- Workaround for #326-infix 5 \\ -- This comment is necessary so CPP doesn't treat the-infixl 9 !!---- The following functions are supported for promotion only.-$(promoteOnly [d|-- -- Overlapping patterns don't singletonize- stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]- stripPrefix [] ys = Just ys- stripPrefix (x:xs) (y:ys)- | x == y = stripPrefix xs ys- stripPrefix _ _ = Nothing-- -- To singletonize these we would need to rewrite all patterns- -- as non-overlapping. This means 2^7 equations for zipWith7.-- zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]- zip4 = zipWith4 (,,,)-- zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]- zip5 = zipWith5 (,,,,)-- zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->- [(a,b,c,d,e,f)]- zip6 = zipWith6 (,,,,,)-- zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->- [g] -> [(a,b,c,d,e,f,g)]- zip7 = zipWith7 (,,,,,,)-- zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]- zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)- = z a b c d : zipWith4 z as bs cs ds- zipWith4 _ _ _ _ _ = []-- zipWith5 :: (a->b->c->d->e->f) ->- [a]->[b]->[c]->[d]->[e]->[f]- zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)- = z a b c d e : zipWith5 z as bs cs ds es- zipWith5 _ _ _ _ _ _ = []-- zipWith6 :: (a->b->c->d->e->f->g) ->- [a]->[b]->[c]->[d]->[e]->[f]->[g]- zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)- = z a b c d e f : zipWith6 z as bs cs ds es fs- zipWith6 _ _ _ _ _ _ _ = []-- zipWith7 :: (a->b->c->d->e->f->g->h) ->- [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]- zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)- = z a b c d e f g : zipWith7 z as bs cs ds es fs gs- zipWith7 _ _ _ _ _ _ _ _ = []---- These functions use Integral or Num typeclass instead of Int.------ genericLength, genericTake, genericDrop, genericSplitAt, genericIndex--- genericReplicate------ We provide aliases below to improve compatibility-- genericTake :: (Integral i) => i -> [a] -> [a]- genericTake = take-- genericDrop :: (Integral i) => i -> [a] -> [a]- genericDrop = drop-- genericSplitAt :: (Integral i) => i -> [a] -> ([a], [a])- genericSplitAt = splitAt-- genericIndex :: (Integral i) => [a] -> i -> a- genericIndex = (!!)-- genericReplicate :: (Integral i) => i -> a -> [a]- genericReplicate = replicate- |])
− src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs
@@ -1,169 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.List.Internal.Disambiguation--- Copyright : (C) 2016 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Renames a bunch of List functions because singletons can't support qualified--- names. :(----------------------------------------------------------------------------------{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies,- UndecidableInstances, GADTs, DataKinds, PolyKinds #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-}--module Data.Singletons.Prelude.List.Internal.Disambiguation where--import Data.Singletons.Single-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.List.Internal-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Eq-import Data.List-import GHC.TypeLits---- singletons doesn't support qualified names :(-$(singletons [d|- listlast :: [a] -> a- listlast = last-- listinit :: [a] -> [a]- listinit = init-- listsort :: Ord a => [a] -> [a]- listsort = sort-- listinits :: [a] -> [[a]]- listinits = inits-- listtails :: [a] -> [[a]]- listtails = tails-- listinsert :: Ord a => a -> [a] -> [a]- listinsert = insert-- listscanl :: (b -> a -> b) -> b -> [a] -> [b]- listscanl = scanl-- listscanr :: (a -> b -> b) -> b -> [a] -> [b]- listscanr = scanr-- listscanr1 :: (a -> a -> a) -> [a] -> [a]- listscanr1 = scanr1-- listintersperse :: a -> [a] -> [a]- listintersperse = intersperse-- listreverse :: [a] -> [a]- listreverse = reverse-- listtakeWhile :: (a -> Bool) -> [a] -> [a]- listtakeWhile = takeWhile-- listdropWhile :: (a -> Bool) -> [a] -> [a]- listdropWhile = dropWhile-- listspan :: (a -> Bool) -> [a] -> ([a], [a])- listspan = span-- listfilter :: (a -> Bool) -> [a] -> [a]- listfilter = filter-- listpartition :: (a -> Bool) -> [a] -> ([a], [a])- listpartition = partition-- listsortBy :: (a -> a -> Ordering) -> [a] -> [a]- listsortBy = sortBy-- listisPrefixOf :: Eq a => [a] -> [a] -> Bool- listisPrefixOf = isPrefixOf-- listzip :: [a] -> [b] -> [(a, b)]- listzip = zip-- listzipWith :: (a -> b -> c) -> [a] -> [b] -> [c]- listzipWith = zipWith-- listnubBy :: (a -> a -> Bool) -> [a] -> [a]- listnubBy = nubBy-- listtranspose :: [[a]] -> [[a]]- listtranspose = transpose-- listunzip :: [(a,b)] -> ([a],[b])- listunzip = unzip-- listmap :: (a -> b) -> [a] -> [b]- listmap = map-- listelem :: Eq a => a -> [a] -> Bool- listelem = elem-- listfoldl :: (b -> a -> b) -> b -> [a] -> b- listfoldl = foldl-- listfoldl' :: (b -> a -> b) -> b -> [a] -> b- listfoldl' = foldl'-- listfoldl1 :: (a -> a -> a) -> [a] -> a- listfoldl1 = foldl1-- listfoldr :: (a -> b -> b) -> b -> [a] -> b- listfoldr = foldr-- listfoldr1 :: (a -> a -> a) -> [a] -> a- listfoldr1 = foldr1-- listmaximum :: Ord a => [a] -> a- listmaximum = maximum-- listminimum :: Ord a => [a] -> a- listminimum = minimum-- listnull :: [a] -> Bool- listnull = null-- listproduct :: Num a => [a] -> a- listproduct = product-- listsum :: Num a => [a] -> a- listsum = sum- |])--$(singletonsOnly [d|- listtake :: Nat -> [a] -> [a]- listtake = take-- listdrop :: Nat -> [a] -> [a]- listdrop = drop-- listsplitAt :: Nat -> [a] -> ([a], [a])- listsplitAt = splitAt-- listindex :: [a] -> Nat -> a- listindex = (!!)-- listlength :: [a] -> Nat- listlength = length- |])--listtake :: Nat -> [a] -> [a]-listtake = undefined--listdrop :: Nat -> [a] -> [a]-listdrop = undefined--listsplitAt :: Nat -> [a] -> ([a], [a])-listsplitAt = undefined--listindex :: [a] -> Nat -> a-listindex = undefined--listlength :: [a] -> Nat-listlength = undefined
− src/Data/Singletons/Prelude/List/NonEmpty.hs
@@ -1,558 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators,- TypeFamilies, GADTs, UndecidableInstances, InstanceSigs,- DataKinds, PolyKinds #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.List.NonEmpty--- Copyright : (C) 2016 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for 'NonEmpty',--- including a singletons version of all the definitions in @Data.List.NonEmpty@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.List.NonEmpty@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.List.NonEmpty (- -- * The 'NonEmpty' singleton-- Sing((:%|)),-- -- | Though Haddock doesn't show it, the 'Sing' instance above declares- -- constructor- --- -- > (:%|) :: Sing h -> Sing t -> Sing (h :| t)-- SNonEmpty,- -- | 'SNonEmpty' is a kind-restricted synonym for 'Sing':- -- @type SNonEmpty (a :: NonEmpty) = Sing a@-- -- * Non-empty stream transformations- Map, sMap,- Intersperse, sIntersperse,- Scanl, sScanl,- Scanr, sScanr,- Scanl1, sScanl1,- Scanr1, sScanr1,- Transpose, sTranspose,- SortBy, sSortBy,- SortWith, sSortWith,- Length, sLength,- Head, sHead,- Tail, sTail,- Last, sLast,- Init, sInit,- type (<|), (%<|),- Cons, sCons,- Uncons, sUncons,- Unfoldr, sUnfoldr,- Sort, sSort,- Reverse, sReverse,- Inits, sInits,- Tails, sTails,- Unfold, sUnfold,- Insert, sInsert,- Take, sTake,- Drop, sDrop,- SplitAt, sSplitAt,- TakeWhile, sTakeWhile,- DropWhile, sDropWhile,- Span, sSpan,- Break, sBreak,- Filter, sFilter,- Partition, sPartition,- Group, sGroup,- GroupBy, sGroupBy,- GroupWith, sGroupWith,- GroupAllWith, sGroupAllWith,- Group1, sGroup1,- GroupBy1, sGroupBy1,- GroupWith1, sGroupWith1,- GroupAllWith1, sGroupAllWith1,- IsPrefixOf, sIsPrefixOf,- Nub, sNub,- NubBy, sNubBy,- type (!!), (%!!),- Zip, sZip,- ZipWith, sZipWith,- Unzip, sUnzip,- FromList, sFromList,- ToList, sToList,- NonEmpty_, sNonEmpty_,- Xor, sXor,-- -- * Defunctionalization symbols- (:|@#@$), (:|@#@$$), (:|@#@$$$),- MapSym0, MapSym1, MapSym2,- IntersperseSym0, IntersperseSym1, IntersperseSym2,- ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,- ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,- Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,- Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,- TransposeSym0, TransposeSym1,- SortBySym0, SortBySym1, SortBySym2,- SortWithSym0, SortWithSym1, SortWithSym2,- LengthSym0, LengthSym1,- HeadSym0, HeadSym1,- TailSym0, TailSym1,- LastSym0, LastSym1,- InitSym0, InitSym1,- type (<|@#@$), type (<|@#@$$), type (<|@#@$$$),- ConsSym0, ConsSym1, ConsSym2,- UnconsSym0, UnconsSym1,- UnfoldrSym0, UnfoldrSym1, UnfoldrSym2,- SortSym0, SortSym1,- ReverseSym0, ReverseSym1,- InitsSym0, InitsSym1,- TailsSym0, TailsSym1,- UnfoldSym0, UnfoldSym1,- InsertSym0, InsertSym1, InsertSym2,- TakeSym0, TakeSym1, TakeSym2,- DropSym0, DropSym1, DropSym2,- SplitAtSym0, SplitAtSym1, SplitAtSym2,- TakeWhileSym0, TakeWhileSym1, TakeWhileSym2,- DropWhileSym0, DropWhileSym1, DropWhileSym2,- SpanSym0, SpanSym1, SpanSym2,- BreakSym0, BreakSym1, BreakSym2,- FilterSym0, FilterSym1, FilterSym2,- PartitionSym0, PartitionSym1, PartitionSym2,- GroupSym0, GroupSym1,- GroupBySym0, GroupBySym1, GroupBySym2,- GroupWithSym0, GroupWithSym1, GroupWithSym2,- GroupAllWithSym0, GroupAllWithSym1, GroupAllWithSym2,- Group1Sym0, Group1Sym1,- GroupBy1Sym0, GroupBy1Sym1, GroupBy1Sym2,- GroupWith1Sym0, GroupWith1Sym1, GroupWith1Sym2,- GroupAllWith1Sym0, GroupAllWith1Sym1, GroupAllWith1Sym2,- IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2,- NubSym0, NubSym1,- NubBySym0, NubBySym1, NubBySym2,- type (!!@#@$), type (!!@#@$$), type (!!@#@$$$),- ZipSym0, ZipSym1, ZipSym2,- ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,- UnzipSym0, UnzipSym1,- FromListSym0, FromListSym1,- ToListSym0, ToListSym1,- NonEmpty_Sym0, NonEmpty_Sym1,- XorSym0, XorSym1- ) where--import Control.Monad.Zip-import Data.List.NonEmpty-import Data.Singletons.Prelude.List.Internal.Disambiguation-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Base hiding ( MapSym0, MapSym1, MapSym2, Map, sMap )-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Monad.Zip-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Function-import Data.Function-import Data.Ord-import Data.Singletons.TypeLits-import Data.Singletons.Single--$(singletonsOnly [d|- {-- -- | @since 4.9.0.0- instance Exts.IsList (NonEmpty a) where- type Item (NonEmpty a) = a- fromList = fromList- toList = toList-- -- | @since 4.9.0.0- instance MonadFix NonEmpty where- mfix f = case fix (f . head) of- ~(x :| _) -> x :| mfix (tail . f)- -}-- instance MonadZip NonEmpty where- mzip = zip- mzipWith = zipWith- munzip = unzip-- -- needed to implement other functions- fmap :: (a -> b) -> NonEmpty a -> NonEmpty b- fmap f (x :| xs) = f x :| listmap f xs-- -- -| Number of elements in 'NonEmpty' list.- length :: NonEmpty a -> Nat- length (_ :| xs) = 1 + listlength xs-- -- -| Compute n-ary logic exclusive OR operation on 'NonEmpty' list.- xor :: NonEmpty Bool -> Bool- xor (x :| xs) = foldr xor' x xs- where xor' True y = not y- xor' False y = y-- -- -| 'unfold' produces a new stream by repeatedly applying the unfolding- -- function to the seed value to produce an element of type @b@ and a new- -- seed value. When the unfolding function returns 'Nothing' instead of- -- a new seed value, the stream ends.- unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b- unfold f a = case f a of- (b, Nothing) -> b :| []- (b, Just c) -> b <| unfold f c-- -- -| 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream,- -- producing 'Nothing' if the input is empty.- nonEmpty_ :: [a] -> Maybe (NonEmpty a)- nonEmpty_ [] = Nothing- nonEmpty_ (a:as) = Just (a :| as)-- -- -| 'uncons' produces the first element of the stream, and a stream of the- -- remaining elements, if any.- uncons :: NonEmpty a -> (a, Maybe (NonEmpty a))- uncons (a :| as) = (a, nonEmpty_ as)-- -- -| The 'unfoldr' function is analogous to "Data.List"'s- -- 'Data.List.unfoldr' operation.- unfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b- unfoldr f a = case f a of- (b, mc) -> b :| maybe_ [] go mc- where- go c = case f c of- (d, me) -> d : maybe_ [] go me-- {-- -- | @since 4.9.0.0- instance Functor NonEmpty where- fmap f ~(a :| as) = f a :| fmap f as- b <$ ~(_ :| as) = b :| (b <$ as)-- -- | @since 4.9.0.0- instance Applicative NonEmpty where- pure a = a :| []- (<*>) = ap-- -- | @since 4.9.0.0- instance Monad NonEmpty where- ~(a :| as) >>= f = b :| (bs ++ bs')- where b :| bs = f a- bs' = as >>= toList . f-- -- | @since 4.9.0.0- instance Traversable NonEmpty where- traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as-- -- | @since 4.9.0.0- instance Foldable NonEmpty where- foldr f z ~(a :| as) = f a (foldr f z as)- foldl f z ~(a :| as) = foldl f (f z a) as- foldl1 f ~(a :| as) = foldl f a as- foldMap f ~(a :| as) = f a `mappend` foldMap f as- fold ~(m :| ms) = m `mappend` fold ms- -}-- -- -| Extract the first element of the stream.- head :: NonEmpty a -> a- head (a :| _) = a-- -- -| Extract the possibly-empty tail of the stream.- tail :: NonEmpty a -> [a]- tail (_ :| as) = as-- -- -| Extract the last element of the stream.- last :: NonEmpty a -> a- last (a :| as) = listlast (a : as)-- -- -| Extract everything except the last element of the stream.- init :: NonEmpty a -> [a]- init (a :| as) = listinit (a : as)-- -- -| Prepend an element to the stream.- (<|) :: a -> NonEmpty a -> NonEmpty a- a <| (b :| bs) = a :| b : bs-- -- -| Synonym for '<|'.- cons :: a -> NonEmpty a -> NonEmpty a- cons = (<|)-- -- -| Sort a stream.- sort :: Ord a => NonEmpty a -> NonEmpty a- sort = lift listsort-- -- -| Converts a normal list to a 'NonEmpty' stream.- --- -- Raises an error if given an empty list.- fromList :: [a] -> NonEmpty a- fromList (a:as) = a :| as- fromList [] = error "NonEmpty.fromList: empty list"-- -- -| Convert a stream to a normal list efficiently.- toList :: NonEmpty a -> [a]- toList (a :| as) = a : as-- -- -| Lift list operations to work on a 'NonEmpty' stream.- --- -- /Beware/: If the provided function returns an empty list,- -- this will raise an error.- lift :: ([a] -> [b]) -> NonEmpty a -> NonEmpty b- lift f = fromList . f . toList-- -- -| Map a function over a 'NonEmpty' stream.- map :: (a -> b) -> NonEmpty a -> NonEmpty b- map f (a :| as) = f a :| listmap f as-- -- -| The 'inits' function takes a stream @xs@ and returns all the- -- finite prefixes of @xs@.- inits :: [a] -> NonEmpty [a]- inits = fromList . listinits-- -- -| The 'tails' function takes a stream @xs@ and returns all the- -- suffixes of @xs@.- tails :: [a] -> NonEmpty [a]- tails = fromList . listtails-- -- -| @'insert' x xs@ inserts @x@ into the last position in @xs@ where it- -- is still less than or equal to the next element. In particular, if the- -- list is sorted beforehand, the result will also be sorted.- insert :: Ord a => a -> [a] -> NonEmpty a- insert a = fromList . listinsert a-- {-- -- | @'some1' x@ sequences @x@ one or more times.- some1 :: Alternative f => f a -> f (NonEmpty a)- some1 x = (:|) <$> x <*> many x- -}-- -- -| 'scanl' is similar to 'foldl', but returns a stream of successive- -- reduced values from the left:- --- -- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...]- --- -- Note that- --- -- > last (scanl f z xs) == foldl f z xs.- scanl :: (b -> a -> b) -> b -> [a] -> NonEmpty b- scanl f z = fromList . listscanl f z-- -- -| 'scanr' is the right-to-left dual of 'scanl'.- -- Note that- --- -- > head (scanr f z xs) == foldr f z xs.- scanr :: (a -> b -> b) -> b -> [a] -> NonEmpty b- scanr f z = fromList . listscanr f z-- -- -| 'scanl1' is a variant of 'scanl' that has no starting value argument:- --- -- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...]- scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a- scanl1 f (a :| as) = fromList (listscanl f a as)-- -- -| 'scanr1' is a variant of 'scanr' that has no starting value argument.- scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a- scanr1 f (a :| as) = fromList (listscanr1 f (a:as))-- -- -| 'intersperse x xs' alternates elements of the list with copies of @x@.- --- -- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3]- intersperse :: a -> NonEmpty a -> NonEmpty a- intersperse a (b :| bs) = b :| case bs of- [] -> []- _:_ -> a : listintersperse a bs-- {-- -- | @'iterate' f x@ produces the infinite sequence- -- of repeated applications of @f@ to @x@.- --- -- > iterate f x = x :| [f x, f (f x), ..]- iterate :: (a -> a) -> a -> NonEmpty a- iterate f a = a :| listiterate f (f a)-- -- | @'cycle' xs@ returns the infinite repetition of @xs@:- --- -- > cycle (1 :| [2,3]) = 1 :| [2,3,1,2,3,...]- cycle :: NonEmpty a -> NonEmpty a- cycle = fromList . listcycle . toList- -}-- -- -| 'reverse' a finite NonEmpty stream.- reverse :: NonEmpty a -> NonEmpty a- reverse = lift listreverse-- {-- -- | @'repeat' x@ returns a constant stream, where all elements are- -- equal to @x@.- repeat :: a -> NonEmpty a- repeat a = a :| listrepeat a- -}-- -- -| @'take' n xs@ returns the first @n@ elements of @xs@.- take :: Nat -> NonEmpty a -> [a]- take n = listtake n . toList-- -- -| @'drop' n xs@ drops the first @n@ elements off the front of- -- the sequence @xs@.- drop :: Nat -> NonEmpty a -> [a]- drop n = listdrop n . toList-- -- -| @'splitAt' n xs@ returns a pair consisting of the prefix of @xs@- -- of length @n@ and the remaining stream immediately following this prefix.- --- -- > 'splitAt' n xs == ('take' n xs, 'drop' n xs)- -- > xs == ys ++ zs where (ys, zs) = 'splitAt' n xs- splitAt :: Nat -> NonEmpty a -> ([a],[a])- splitAt n = listsplitAt n . toList-- -- -| @'takeWhile' p xs@ returns the longest prefix of the stream- -- @xs@ for which the predicate @p@ holds.- takeWhile :: (a -> Bool) -> NonEmpty a -> [a]- takeWhile p = listtakeWhile p . toList-- -- -| @'dropWhile' p xs@ returns the suffix remaining after- -- @'takeWhile' p xs@.- dropWhile :: (a -> Bool) -> NonEmpty a -> [a]- dropWhile p = listdropWhile p . toList-- -- -| @'span' p xs@ returns the longest prefix of @xs@ that satisfies- -- @p@, together with the remainder of the stream.- --- -- > 'span' p xs == ('takeWhile' p xs, 'dropWhile' p xs)- -- > xs == ys ++ zs where (ys, zs) = 'span' p xs- span :: (a -> Bool) -> NonEmpty a -> ([a], [a])- span p = listspan p . toList-- -- -| The @'break' p@ function is equivalent to @'span' (not . p)@.- break :: (a -> Bool) -> NonEmpty a -> ([a], [a])- break p = span (not . p)-- -- -| @'filter' p xs@ removes any elements from @xs@ that do not satisfy @p@.- filter :: (a -> Bool) -> NonEmpty a -> [a]- filter p = listfilter p . toList-- -- -| The 'partition' function takes a predicate @p@ and a stream- -- @xs@, and returns a pair of lists. The first list corresponds to the- -- elements of @xs@ for which @p@ holds; the second corresponds to the- -- elements of @xs@ for which @p@ does not hold.- --- -- > 'partition' p xs = ('filter' p xs, 'filter' (not . p) xs)- partition :: (a -> Bool) -> NonEmpty a -> ([a], [a])- partition p = listpartition p . toList-- -- -| The 'group' function takes a stream and returns a list of- -- streams such that flattening the resulting list is equal to the- -- argument. Moreover, each stream in the resulting list- -- contains only equal elements. For example, in list notation:- --- -- > 'group' $ 'cycle' "Mississippi"- -- > = "M" : "i" : "ss" : "i" : "ss" : "i" : "pp" : "i" : "M" : "i" : ...- group :: Eq a => [a] -> [NonEmpty a]- group = groupBy (==)-- -- -| 'groupBy' operates like 'group', but uses the provided equality- -- predicate instead of `==`.- groupBy :: (a -> a -> Bool) -> [a] -> [NonEmpty a]- groupBy eq0 = go eq0- where- go _ [] = []- go eq (x : xs) = (x :| ys) : groupBy eq zs- where (ys, zs) = listspan (eq x) xs-- -- -| 'groupWith' operates like 'group', but uses the provided projection when- -- comparing for equality- groupWith :: Eq b => (a -> b) -> [a] -> [NonEmpty a]- groupWith f = groupBy ((==) `on` f)-- -- -| 'groupAllWith' operates like 'groupWith', but sorts the list- -- first so that each equivalence class has, at most, one list in the- -- output- groupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a]- groupAllWith f = groupWith f . listsortBy (compare `on` f)-- -- -| 'group1' operates like 'group', but uses the knowledge that its- -- input is non-empty to produce guaranteed non-empty output.- group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)- group1 = groupBy1 (==)-- -- -| 'groupBy1' is to 'group1' as 'groupBy' is to 'group'.- groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)- groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs- where (ys, zs) = listspan (eq x) xs-- -- -| 'groupWith1' is to 'group1' as 'groupWith' is to 'group'- groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)- groupWith1 f = groupBy1 ((==) `on` f)-- -- -| 'groupAllWith1' is to 'groupWith1' as 'groupAllWith' is to 'groupWith'- groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)- groupAllWith1 f = groupWith1 f . sortWith f-- -- -| The 'isPrefix' function returns @True@ if the first argument is- -- a prefix of the second.- isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool- isPrefixOf [] _ = True- isPrefixOf (y:ys) (x :| xs) = (y == x) && listisPrefixOf ys xs-- -- -| @xs !! n@ returns the element of the stream @xs@ at index- -- @n@. Note that the head of the stream has index 0.- --- -- /Beware/: a negative or out-of-bounds index will cause an error.- (!!) :: NonEmpty a -> Nat -> a- (!!) (x :| xs) n- | n == 0 = x- | n > 0 = xs `listindex` (n - 1)- | otherwise = error "NonEmpty.!! negative argument"-- -- -| The 'zip' function takes two streams and returns a stream of- -- corresponding pairs.- zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)- zip (x :| xs) (y :| ys) = (x, y) :| listzip xs ys-- -- -| The 'zipWith' function generalizes 'zip'. Rather than tupling- -- the elements, the elements are combined using the function- -- passed as the first argument.- zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c- zipWith f (x :| xs) (y :| ys) = f x y :| listzipWith f xs ys-- -- -| The 'unzip' function is the inverse of the 'zip' function.- unzip :: NonEmpty (a,b) -> (NonEmpty a, NonEmpty b)- unzip ((a,b) :| asbs) = (a :| as, b :| bs)- where- (as, bs) = listunzip asbs-- -- -| The 'nub' function removes duplicate elements from a list. In- -- particular, it keeps only the first occurence of each element.- -- (The name 'nub' means \'essence\'.)- -- It is a special case of 'nubBy', which allows the programmer to- -- supply their own inequality test.- nub :: Eq a => NonEmpty a -> NonEmpty a- nub = nubBy (==)-- -- -| The 'nubBy' function behaves just like 'nub', except it uses a- -- user-supplied equality predicate instead of the overloaded '=='- -- function.- nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a- nubBy eq (a :| as) = a :| listnubBy eq (listfilter (\b -> not (eq a b)) as)-- -- -| 'transpose' for 'NonEmpty', behaves the same as 'Data.List.transpose'- -- The rows/columns need not be the same length, in which case- -- > transpose . transpose /= id- transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)- transpose = fmap fromList- . fromList . listtranspose . toList- . fmap toList-- -- -| 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy'- sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a- sortBy f = lift (listsortBy f)-- -- -| 'sortWith' for 'NonEmpty', behaves the same as:- --- -- > sortBy . comparing- sortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a- sortWith = sortBy . comparing-- |])
− src/Data/Singletons/Prelude/Maybe.hs
@@ -1,129 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies,- DataKinds, PolyKinds, UndecidableInstances, GADTs, RankNTypes #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Maybe--- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for 'Maybe',--- including a singletons version of all the definitions in @Data.Maybe@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Maybe@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Maybe (- -- The 'Maybe' singleton-- Sing(SNothing, SJust),- -- | Though Haddock doesn't show it, the 'Sing' instance above declares- -- constructors- --- -- > SNothing :: Sing Nothing- -- > SJust :: Sing a -> Sing (Just a)-- SMaybe,- -- | 'SBool' is a kind-restricted synonym for 'Sing': @type SMaybe (a :: Maybe k) = Sing a@-- -- * Singletons from @Data.Maybe@- maybe_, Maybe_, sMaybe_,- -- | The preceding two definitions are derived from the function 'maybe' in- -- @Data.Maybe@. The extra underscore is to avoid name clashes with the type- -- 'Maybe'.-- IsJust, sIsJust, IsNothing, sIsNothing,- FromJust, sFromJust, FromMaybe, sFromMaybe, ListToMaybe, sListToMaybe,- MaybeToList, sMaybeToList, CatMaybes, sCatMaybes, MapMaybe, sMapMaybe,-- -- * Defunctionalization symbols- NothingSym0, JustSym0, JustSym1,-- Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3,- IsJustSym0, IsJustSym1, IsNothingSym0, IsNothingSym1,- FromJustSym0, FromJustSym1, FromMaybeSym0, FromMaybeSym1, FromMaybeSym2,- ListToMaybeSym0, ListToMaybeSym1, MaybeToListSym0, MaybeToListSym1,- CatMaybesSym0, CatMaybesSym1, MapMaybeSym0, MapMaybeSym1, MapMaybeSym2- ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Singletons.TypeLits--$(singletons [d|- -- Renamed to avoid name clash- -- -| The 'maybe' function takes a default value, a function, and a 'Maybe'- -- value. If the 'Maybe' value is 'Nothing', the function returns the- -- default value. Otherwise, it applies the function to the value inside- -- the 'Just' and returns the result.- maybe_ :: b -> (a -> b) -> Maybe a -> b- maybe_ n _ Nothing = n- maybe_ _ f (Just x) = f x- |])--$(singletonsOnly [d|- -- -| The 'isJust' function returns 'True' iff its argument is of the- -- form @Just _@.- isJust :: Maybe a -> Bool- isJust Nothing = False- isJust (Just _) = True-- -- -| The 'isNothing' function returns 'True' iff its argument is 'Nothing'.- isNothing :: Maybe a -> Bool- isNothing Nothing = True- isNothing (Just _) = False-- -- -| The 'fromJust' function extracts the element out of a 'Just' and- -- throws an error if its argument is 'Nothing'.- fromJust :: Maybe a -> a- fromJust Nothing = error "Maybe.fromJust: Nothing" -- yuck- fromJust (Just x) = x-- -- -| The 'fromMaybe' function takes a default value and and 'Maybe'- -- value. If the 'Maybe' is 'Nothing', it returns the default values;- -- otherwise, it returns the value contained in the 'Maybe'.- fromMaybe :: a -> Maybe a -> a- fromMaybe d x = case x of {Nothing -> d;Just v -> v}-- -- -| The 'maybeToList' function returns an empty list when given- -- 'Nothing' or a singleton list when not given 'Nothing'.- maybeToList :: Maybe a -> [a]- maybeToList Nothing = []- maybeToList (Just x) = [x]-- -- -| The 'listToMaybe' function returns 'Nothing' on an empty list- -- or @'Just' a@ where @a@ is the first element of the list.- listToMaybe :: [a] -> Maybe a- listToMaybe [] = Nothing- listToMaybe (a:_) = Just a-- -- Modified to avoid list comprehensions- -- -| The 'catMaybes' function takes a list of 'Maybe's and returns- -- a list of all the 'Just' values.- catMaybes :: [Maybe a] -> [a]- catMaybes [] = []- catMaybes (Just x : xs) = x : catMaybes xs- catMaybes (Nothing : xs) = catMaybes xs-- -- -| The 'mapMaybe' function is a version of 'map' which can throw- -- out elements. In particular, the functional argument returns- -- something of type @'Maybe' b@. If this is 'Nothing', no element- -- is added on to the result list. If it just @'Just' b@, then @b@ is- -- included in the result list.- mapMaybe :: (a -> Maybe b) -> [a] -> [b]- mapMaybe _ [] = []- mapMaybe f (x:xs) =- let rs = mapMaybe f xs in- case f x of- Nothing -> rs- Just r -> r:rs- |])
− src/Data/Singletons/Prelude/Monad.hs
@@ -1,293 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Monad--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'Monad' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Monad (- PFunctor(Fmap), SFunctor(sFmap),- PMonad(..), SMonad(..), PMonadPlus(..), SMonadPlus(..),-- MapM, sMapM, MapM_, sMapM_, ForM, sForM,- Sequence, sSequence, Sequence_, sSequence_,- type (=<<), (%=<<), type (>=>), (%>=>), type (<=<), (%<=<),- Void, sVoid,-- Join, sJoin,- Msum, sMsum,- Mfilter, sMfilter, FilterM, sFilterM,- MapAndUnzipM, sMapAndUnzipM, ZipWithM, sZipWithM,- ZipWithM_, sZipWithM_, FoldlM, sFoldlM,- ReplicateM, sReplicateM, ReplicateM_, sReplicateM_,-- Guard, sGuard, When, sWhen, Unless, sUnless,-- LiftM, sLiftM, LiftM2, sLiftM2, LiftM3, sLiftM3,- LiftM4, sLiftM4, LiftM5, sLiftM5, Ap, sAp,-- type (<$!>), (%<$!>),-- -- * Defunctionalization symbols- FmapSym0, FmapSym1, FmapSym2,- type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$),- type (>>@#@$), type (>>@#@$$), type (>>@#@$$$),- ReturnSym0, ReturnSym1, FailSym0, FailSym1,- MzeroSym0, MplusSym0, MplusSym1, MplusSym2,-- MapMSym0, MapMSym1, MapMSym2,- MapM_Sym0, MapM_Sym1, MapM_Sym2,- ForMSym0, ForMSym1, ForMSym2,- SequenceSym0, SequenceSym1,- Sequence_Sym0, Sequence_Sym1,- type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$),- type (>=>@#@$), type (>=>@#@$$), type (>=>@#@$$$),- type (<=<@#@$), type (<=<@#@$$), type (<=<@#@$$$),- VoidSym0, VoidSym1,-- JoinSym0, JoinSym1,- MsumSym0, MsumSym1,- MfilterSym0, MfilterSym1, MfilterSym2,- FilterMSym0, FilterMSym1, FilterMSym2,- MapAndUnzipMSym0, MapAndUnzipMSym1, MapAndUnzipMSym2,- ZipWithMSym0, ZipWithMSym1, ZipWithMSym2, ZipWithMSym3,- ZipWithM_Sym0, ZipWithM_Sym1, ZipWithM_Sym2, ZipWithM_Sym3,- FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3,- ReplicateMSym0, ReplicateMSym1, ReplicateMSym2,- ReplicateM_Sym0, ReplicateM_Sym1, ReplicateM_Sym2,-- GuardSym0, GuardSym1,- WhenSym0, WhenSym1, WhenSym2,- UnlessSym0, UnlessSym1, UnlessSym2,-- LiftMSym0, LiftMSym1, LiftMSym2,- LiftM2Sym0, LiftM2Sym1, LiftM2Sym2, LiftM2Sym3,- LiftM3Sym0, LiftM3Sym1, LiftM3Sym2, LiftM3Sym3, LiftM3Sym4,- LiftM4Sym0, LiftM4Sym1, LiftM4Sym2, LiftM4Sym3, LiftM4Sym4, LiftM4Sym5,- LiftM5Sym0, LiftM5Sym1, LiftM5Sym2, LiftM5Sym3, LiftM5Sym4, LiftM5Sym5, LiftM5Sym6,- ApSym0, ApSym1, ApSym2,-- type (<$!>@#@$), type (<$!>@#@$$), type (<$!>@#@$$$),- ) where--import Control.Applicative-import Control.Monad-import Data.Ord (Down(..))-import Data.Singletons.Prelude.Applicative ()-import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr)-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Functor-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.List (UnzipSym0, sUnzip, ZipWithSym0, sZipWith)-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Traversable-import Data.Singletons.Single-import GHC.TypeNats--$(singletonsOnly [d|- -- ------------------------------------------------------------------------------ -- Functions mandated by the Prelude-- -- -| This generalizes the list-based 'filter' function.-- filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]- filterM p = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x)) (pure [])-- infixr 1 <=<, >=>-- -- -| Left-to-right Kleisli composition of monads.- (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)- f >=> g = \x -> f x >>= g-- -- -| Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped.- --- -- Note how this operator resembles function composition @('.')@:- --- -- > (.) :: (b -> c) -> (a -> b) -> a -> c- -- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c- (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)- (<=<) = flip (>=>)-- {-- Relies on infinite lists-- -- -| @'forever' act@ repeats the action infinitely.- forever :: (Applicative f) => f a -> f b- forever a = let a' = a *> a' in a'- -- Use explicit sharing here, as it prevents a space leak regardless of- -- optimizations.- -}-- -- ------------------------------------------------------------------------------ -- Other monad functions-- -- -| The 'mapAndUnzipM' function maps its first argument over a list, returning- -- the result as a pair of lists. This function is mainly used with complicated- -- data structures or a state-transforming monad.- mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c])- mapAndUnzipM f xs = unzip <$> traverse f xs-- -- -| The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors.- zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]- zipWithM f xs ys = sequenceA (zipWith f xs ys)-- -- -| 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.- zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m ()- zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys)-- {- -| The 'foldM' function is analogous to 'foldl', except that its result is- encapsulated in a monad. Note that 'foldM' works from left-to-right over- the list arguments. This could be an issue where @('>>')@ and the `folded- function' are not commutative.--- > foldM f a1 [x1, x2, ..., xm]-- ==-- > do- > a2 <- f a1 x1- > a3 <- f a2 x2- > ...- > f am xm-- If right-to-left evaluation is required, the input list should be reversed.-- Note: 'foldM' is the same as 'foldlM'- -}-- foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b- foldM = foldlM-- -- -| Like 'foldM', but discards the result.- foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()- foldM_ f a xs = foldlM f a xs >> return ()-- {-- Note [Worker/wrapper transform on replicateM/replicateM_]- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-- The implementations of replicateM and replicateM_ both leverage the- worker/wrapper transform. The simpler implementation of replicateM_, as an- example, would be:-- replicateM_ 0 _ = pure ()- replicateM_ n f = f *> replicateM_ (n - 1) f-- However, the self-recursive nature of this implementation inhibits inlining,- which means we never get to specialise to the action (`f` in the code above).- By contrast, the implementation below with a local loop makes it possible to- inline the entire definition (as happens for foldr, for example) thereby- specialising for the particular action.-- For further information, see this Trac comment, which includes side-by-side- Core: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6- -}-- -- -| @'replicateM' n act@ performs the action @n@ times,- -- gathering the results.- replicateM :: (Applicative m) => Nat -> m a -> m [a]- replicateM cnt0 f =- loop cnt0- where- loop cnt- | cnt <= 0 = pure []- | otherwise = liftA2 (:) f (loop (cnt - 1))-- -- -| Like 'replicateM', but discards the result.- replicateM_ :: (Applicative m) => Nat -> m a -> m ()- replicateM_ cnt0 f =- loop cnt0- where- loop cnt- | cnt <= 0 = pure ()- | otherwise = f *> loop (cnt - 1)--- -- -| The reverse of 'when'.- unless :: (Applicative f) => Bool -> f () -> f ()- unless p s = if p then pure () else s-- infixl 4 <$!>-- -- -| Strict version of 'Data.Functor.<$>'.- --- -- @since 4.8.0.0- (<$!>) :: Monad m => (a -> b) -> m a -> m b- f <$!> m = do- x <- m- let z = f x- z `seq` return z--- -- ------------------------------------------------------------------------------ -- Other MonadPlus functions-- -- -| Direct 'MonadPlus' equivalent of 'filter'- -- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@- -- applicable to any 'MonadPlus', for example- -- @mfilter odd (Just 1) == Just 1@- -- @mfilter odd (Just 2) == Nothing@-- mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a- mfilter p ma = do- a <- ma- if p a then return a else mzero-- {- -$naming-- The functions in this library use the following naming conventions:-- * A postfix \'@M@\' always stands for a function in the Kleisli category:- The monad type constructor @m@ is added to function results- (modulo currying) and nowhere else. So, for example,-- > filter :: (a -> Bool) -> [a] -> [a]- > filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]-- * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.- Thus, for example:-- > sequence :: Monad m => [m a] -> m [a]- > sequence_ :: Monad m => [m a] -> m ()-- * A prefix \'@m@\' generalizes an existing function to a monadic form.- Thus, for example:-- > sum :: Num a => [a] -> a- > msum :: MonadPlus m => [m a] -> m a-- -}-- instance Monoid a => Monad ((,) a) where- (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b)-- instance Monad Down where- Down a >>= k = k a- |])---- Workaround for #326-infixr 1 <=<, >=>-infixl 4 <$!>
− src/Data/Singletons/Prelude/Monad/Internal.hs
@@ -1,519 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Monad.Internal--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of:------ * Functor--- * Applicative--- * Alternative--- * Monad--- * MonadPlus------ As well as auxiliary definitions.------ This module exists to break up import cycles.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Monad.Internal where--import Control.Applicative-import Control.Monad-import Data.Kind-import Data.List.NonEmpty (NonEmpty(..))-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Singletons.TypeLits.Internal--{--Note [How to get the right kinds when promoting Functor and friends]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-To avoid running afoul of a CUSK validity check (see Note [CUSKification]),-classes with type parameters that lack explicit kind signatures will be-defaulted to be of kind Type. This is not what you want for Functor, however,-since its argument is of kind (Type -> Type), so we must explicitly use this-kind when declaring the Functor class (and other classes in this module).--}--$(singletonsOnly [d|- infixl 4 <$-- {- -| The 'Functor' class is used for types that can be mapped over.- Instances of 'Functor' should satisfy the following laws:-- > fmap id == id- > fmap (f . g) == fmap f . fmap g-- The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'- satisfy these laws.- -}-- class Functor (f :: Type -> Type) where- fmap :: (a -> b) -> f a -> f b-- -- -| Replace all locations in the input with the same value.- -- The default definition is @'fmap' . 'const'@, but this may be- -- overridden with a more efficient version.- (<$) :: a -> f b -> f a- (<$) = fmap . const-- infixl 4 <*>, <*, *>, <**>-- -- -| A functor with application, providing operations to- --- -- -* embed pure expressions ('pure'), and- --- -- -* sequence computations and combine their results ('<*>' and 'liftA2').- --- -- A minimal complete definition must include implementations of 'pure'- -- and of either '<*>' or 'liftA2'. If it defines both, then they must behave- -- the same as their default definitions:- --- -- @('<*>') = 'liftA2' 'id'@- --- -- @'liftA2' f x y = f '<$>' x '<*>' y@- --- -- Further, any definition must satisfy the following:- --- -- [/identity/]- --- -- @'pure' 'id' '<*>' v = v@- --- -- [/composition/]- --- -- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@- --- -- [/homomorphism/]- --- -- @'pure' f '<*>' 'pure' x = 'pure' (f x)@- --- -- [/interchange/]- --- -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@- --- --- -- The other methods have the following default definitions, which may- -- be overridden with equivalent specialized implementations:- --- -- * @u '*>' v = ('id' '<$' u) '<*>' v@- --- -- * @u '<*' v = 'liftA2' 'const' u v@- --- -- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy- --- -- * @'fmap' f x = 'pure' f '<*>' x@- --- --- -- It may be useful to note that supposing- --- -- @forall x y. p (q x y) = f x . g y@- --- -- it follows from the above that- --- -- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@- --- --- -- If @f@ is also a 'Monad', it should satisfy- --- -- * @'pure' = 'return'@- --- -- * @('<*>') = 'ap'@- --- -- * @('*>') = ('>>')@- --- -- (which implies that 'pure' and '<*>' satisfy the applicative functor laws).-- class Functor f => Applicative (f :: Type -> Type) where- -- {-# MINIMAL pure, ((<*>) | liftA2) #-}- -- -| Lift a value.- pure :: a -> f a-- -- -| Sequential application.- --- -- A few functors support an implementation of '<*>' that is more- -- efficient than the default one.- (<*>) :: f (a -> b) -> f a -> f b- (<*>) = liftA2 id-- -- -| Lift a binary function to actions.- --- -- Some functors support an implementation of 'liftA2' that is more- -- efficient than the default one. In particular, if 'fmap' is an- -- expensive operation, it is likely better to use 'liftA2' than to- -- 'fmap' over the structure and then use '<*>'.- liftA2 :: (a -> b -> c) -> f a -> f b -> f c- liftA2 f x = (<*>) (fmap f x)-- -- -| Sequence actions, discarding the value of the first argument.- (*>) :: f a -> f b -> f b- a1 *> a2 = (id <$ a1) <*> a2- -- This is essentially the same as liftA2 (flip const), but if the- -- Functor instance has an optimized (<$), it may be better to use- -- that instead. Before liftA2 became a method, this definition- -- was strictly better, but now it depends on the functor. For a- -- functor supporting a sharing-enhancing (<$), this definition- -- may reduce allocation by preventing a1 from ever being fully- -- realized. In an implementation with a boring (<$) but an optimizing- -- liftA2, it would likely be better to define (*>) using liftA2.-- -- -| Sequence actions, discarding the value of the second argument.- (<*) :: f a -> f b -> f a- (<*) = liftA2 const-- -- -| A variant of '<*>' with the arguments reversed.- (<**>) :: Applicative f => f a -> f (a -> b) -> f b- (<**>) = liftA2 (\a f -> f a)- -- Don't use $ here, see the note at the top of the page-- -- -| Lift a function to actions.- -- This function may be used as a value for `fmap` in a `Functor` instance.- liftA :: Applicative f => (a -> b) -> f a -> f b- liftA f a = pure f <*> a- -- Caution: since this may be used for `fmap`, we can't use the obvious- -- definition of liftA = fmap.-- -- -| Lift a ternary function to actions.- liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d- liftA3 f a b c = liftA2 f a b <*> c-- infixl 1 >>, >>=- infixr 1 =<<-- -- -| The 'join' function is the conventional monad join operator. It- -- is used to remove one level of monadic structure, projecting its- -- bound argument into the outer level.- --- -- ==== __Examples__- --- -- A common use of 'join' is to run an 'IO' computation returned from- -- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions- -- can't perform 'IO' directly. Recall that- --- -- @- -- 'GHC.Conc.atomically' :: STM a -> IO a- -- @- --- -- is used to run 'GHC.Conc.STM' transactions atomically. So, by- -- specializing the types of 'GHC.Conc.atomically' and 'join' to- --- -- @- -- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b)- -- 'join' :: IO (IO b) -> IO b- -- @- --- -- we can compose them as- --- -- @- -- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b- -- @- --- -- to run an 'GHC.Conc.STM' transaction and the 'IO' action it- -- returns.- join :: (Monad m) => m (m a) -> m a- join x = x >>= id-- {- -| The 'Monad' class defines the basic operations over a /monad/,- a concept from a branch of mathematics known as /category theory/.- From the perspective of a Haskell programmer, however, it is best to- think of a monad as an /abstract datatype/ of actions.- Haskell's @do@ expressions provide a convenient syntax for writing- monadic expressions.-- Instances of 'Monad' should satisfy the following laws:-- * @'return' a '>>=' k = k a@- * @m '>>=' 'return' = m@- * @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@-- Furthermore, the 'Monad' and 'Applicative' operations should relate as follows:-- * @'pure' = 'return'@- * @('<*>') = 'ap'@-- The above laws imply:-- * @'fmap' f xs = xs '>>=' 'return' . f@- * @('>>') = ('*>')@-- and that 'pure' and ('<*>') satisfy the applicative functor laws.-- The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'- defined in the "Prelude" satisfy these laws.- -}- class Applicative m => Monad (m :: Type -> Type) where- -- -| Sequentially compose two actions, passing any value produced- -- by the first as an argument to the second.- (>>=) :: forall a b. m a -> (a -> m b) -> m b-- -- -| Sequentially compose two actions, discarding any value produced- -- by the first, like sequencing operators (such as the semicolon)- -- in imperative languages.- (>>) :: forall a b. m a -> m b -> m b- m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad]-- -- -| Inject a value into the monadic type.- return :: a -> m a- return = pure-- -- -| Fail with a message. This operation is not part of the- -- mathematical definition of a monad, but is invoked on pattern-match- -- failure in a @do@ expression.- --- -- As part of the MonadFail proposal (MFP), this function is moved- -- to its own class 'MonadFail' (see "Control.Monad.Fail" for more- -- details). The definition here will be removed in a future- -- release.- fail :: Symbol -> m a- fail s = error s-- {- Note [Recursive bindings for Applicative/Monad]- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-- The original Applicative/Monad proposal stated that after- implementation, the designated implementation of (>>) would become-- (>>) :: forall a b. m a -> m b -> m b- (>>) = (*>)-- by default. You might be inclined to change this to reflect the stated- proposal, but you really shouldn't! Why? Because people tend to define- such instances the /other/ way around: in particular, it is perfectly- legitimate to define an instance of Applicative (*>) in terms of (>>),- which would lead to an infinite loop for the default implementation of- Monad! And people do this in the wild.-- This turned into a nasty bug that was tricky to track down, and rather- than eliminate it everywhere upstream, it's easier to just retain the- original default.-- -}-- -- -| Same as '>>=', but with the arguments interchanged.- (=<<) :: Monad m => (a -> m b) -> m a -> m b- f =<< x = x >>= f-- -- -| Conditional execution of 'Applicative' expressions. For example,- --- -- > when debug (putStrLn "Debugging")- --- -- will output the string @Debugging@ if the Boolean value @debug@- -- is 'True', and otherwise do nothing.- when :: (Applicative f) => Bool -> f () -> f ()- when p s = if p then s else pure ()-- -- -| Promote a function to a monad.- liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r- liftM f m1 = do { x1 <- m1; return (f x1) }-- -- -| Promote a function to a monad, scanning the monadic arguments from- -- left to right. For example,- --- -- > liftM2 (+) [0,1] [0,2] = [0,2,1,3]- -- > liftM2 (+) (Just 1) Nothing = Nothing- --- liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r- liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) }- -- Caution: since this may be used for `liftA2`, we can't use the obvious- -- definition of liftM2 = liftA2.-- -- -| Promote a function to a monad, scanning the monadic arguments from- -- left to right (cf. 'liftM2').- liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r- liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }-- -- -| Promote a function to a monad, scanning the monadic arguments from- -- left to right (cf. 'liftM2').- liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r- liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }-- -- -| Promote a function to a monad, scanning the monadic arguments from- -- left to right (cf. 'liftM2').- liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r- liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }-- {- -| In many situations, the 'liftM' operations can be replaced by uses of- 'ap', which promotes function application.-- > return f `ap` x1 `ap` ... `ap` xn-- is equivalent to-- > liftMn f x1 x2 ... xn-- -}-- ap :: (Monad m) => m (a -> b) -> m a -> m b- ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) }- -- Since many Applicative instances define (<*>) = ap, we- -- cannot define ap = (<*>)-- -- ------------------------------------------------------------------------------ -- The Alternative class definition-- infixl 3 <|>-- -- -| A monoid on applicative functors.- --- -- If defined, 'some' and 'many' should be the least solutions- -- of the equations:- --- -- -* @'some' v = (:) '<$>' v '<*>' 'many' v@- --- -- -* @'many' v = 'some' v '<|>' 'pure' []@- class Applicative f => Alternative (f :: Type -> Type) where- -- -| The identity of '<|>'- empty :: f a- -- -| An associative binary operation- (<|>) :: f a -> f a -> f a-- {-- some and many rely on infinite lists-- -- -| One or more.- some :: f a -> f [a]- some v = some_v- where- many_v = some_v <|> pure []- some_v = liftA2 (:) v many_v-- -- -| Zero or more.- many :: f a -> f [a]- many v = many_v- where- many_v = some_v <|> pure []- some_v = liftA2 (:) v many_v- -}-- -- -| @'guard' b@ is @'pure' ()@ if @b@ is 'True',- -- and 'empty' if @b@ is 'False'.- guard :: (Alternative f) => Bool -> f ()- guard True = pure ()- guard False = empty-- -- ------------------------------------------------------------------------------ -- The MonadPlus class definition-- -- -| Monads that also support choice and failure.- class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where- -- -| The identity of 'mplus'. It should also satisfy the equations- --- -- > mzero >>= f = mzero- -- > v >> mzero = mzero- --- -- The default definition is- --- -- @- -- mzero = 'empty'- -- @- mzero :: m a- mzero = empty-- -- -| An associative operation. The default definition is- --- -- @- -- mplus = ('<|>')- -- @- mplus :: m a -> m a -> m a- mplus = (<|>)- |])---- Workaround for #326-infixl 4 <$-infixl 4 <*>, <*, *>, <**>-infixl 1 >>, >>=-infixr 1 =<<-infixl 3 <|>--$(singletonsOnly [d|- -------------------------------------------------------------------------------- -- Instances-- deriving instance Functor Maybe- deriving instance Functor NonEmpty- deriving instance Functor []- deriving instance Functor (Either a)-- instance Applicative Maybe where- pure = Just-- Just f <*> m = fmap f m- Nothing <*> _m = Nothing-- liftA2 f (Just x) (Just y) = Just (f x y)- liftA2 _ Just{} Nothing = Nothing- liftA2 _ Nothing Just{} = Nothing- liftA2 _ Nothing Nothing = Nothing-- Just _m1 *> m2 = m2- Nothing *> _m2 = Nothing-- instance Applicative NonEmpty where- pure a = a :| []- (<*>) = ap- liftA2 = liftM2-- instance Applicative [] where- pure x = [x]- (<*>) = ap- liftA2 = liftM2- (*>) = (>>)-- instance Applicative (Either e) where- pure = Right- Left e <*> _ = Left e- Right f <*> r = fmap f r-- instance Monad Maybe where- (Just x) >>= k = k x- Nothing >>= _ = Nothing-- (>>) = (*>)-- fail _ = Nothing-- instance Monad NonEmpty where- (a :| as) >>= f = b :| (bs ++ bs')- where b :| bs = f a- bs' = as >>= toList . f- toList (c :| cs) = c : cs-- instance Monad [] where- xs >>= f = foldr ((++) . f) [] xs- fail _ = []-- instance Monad (Either e) where- Left l >>= _ = Left l- Right r >>= k = k r-- instance Alternative Maybe where- empty = Nothing- Nothing <|> r = r- l@(Just{}) <|> _ = l-- instance Alternative [] where- empty = []- (<|>) = (++)-- instance MonadPlus Maybe- instance MonadPlus []- |])
− src/Data/Singletons/Prelude/Monad/Zip.hs
@@ -1,106 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Monad.Zip--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'MonadZip' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Monad.Zip (- PMonadZip(..), SMonadZip(..),-- -- * Defunctionalization symbols- MzipSym0, MzipSym1, MzipSym2,- MzipWithSym0, MzipWithSym1, MzipWithSym2, MzipWithSym3,- MunzipSym0, MunzipSym1,- ) where--import Control.Monad.Zip-import Data.Functor.Identity-import Data.Kind-import Data.Monoid-import Data.Singletons.Prelude.Identity-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.List- ( ZipSym0, ZipWithSym0, UnzipSym0- , sZip, sZipWith, sUnzip )-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid ()-import Data.Singletons.Prelude.Tuple-import Data.Singletons.Single--$(singletonsOnly [d|- -- -| `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`- --- -- Instances should satisfy the laws:- --- -- -* Naturality :- --- -- > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)- --- -- -* Information Preservation:- --- -- > liftM (const ()) ma = liftM (const ()) mb- -- > ==>- -- > munzip (mzip ma mb) = (ma, mb)- --- class Monad m => MonadZip (m :: Type -> Type) where- -- {-# MINIMAL mzip | mzipWith #-}-- mzip :: m a -> m b -> m (a,b)- mzip = mzipWith (,)-- mzipWith :: (a -> b -> c) -> m a -> m b -> m c- mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)-- munzip :: m (a,b) -> (m a, m b)- munzip mab = (liftM fst mab, liftM snd mab)- -- munzip is a member of the class because sometimes- -- you can implement it more efficiently than the- -- above default code. See Trac #4370 comment by giorgidze-- instance MonadZip [] where- mzip = zip- mzipWith = zipWith- munzip = unzip-- instance MonadZip Identity where- mzipWith = liftM2- munzip (Identity (a, b)) = (Identity a, Identity b)-- instance MonadZip Dual where- -- Cannot use coerce, it's unsafe- mzipWith = liftM2-- instance MonadZip Sum where- mzipWith = liftM2-- instance MonadZip Product where- mzipWith = liftM2-- instance MonadZip Maybe where- mzipWith = liftM2-- instance MonadZip First where- mzipWith = liftM2-- instance MonadZip Last where- mzipWith = liftM2- |])
− src/Data/Singletons/Prelude/Monoid.hs
@@ -1,212 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Monoid--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted version of 'Monoid', 'PMonoid', and the--- singleton version, 'SMonoid'.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Monoid (- PMonoid(..), SMonoid(..),-- Sing(SDual, sGetDual, SAll, sGetAll, SAny, sGetAny, SSum, sGetSum,- SProduct, sGetProduct, SFirst, sGetFirst, SLast, sGetLast),- GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast,-- SDual, SAll, SAny, SSum, SProduct, SFirst, SLast,-- -- ** Defunctionalization symbols- MemptySym0,- MappendSym0, MappendSym1, MappendSym2,- MconcatSym0, MconcatSym1,- DualSym0, DualSym1, GetDualSym0, GetDualSym1,- AllSym0, AllSym1, GetAllSym0, GetAllSym1,- AnySym0, AnySym1, GetAnySym0, GetAnySym1,- SumSym0, SumSym1, GetSumSym0, GetSumSym1,- ProductSym0, ProductSym1, GetProductSym0, GetProductSym1,- FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1,- LastSym0, LastSym1, GetLastSym0, GetLastSym1- ) where--import Data.Monoid (First(..), Last(..))-import Data.Ord (Down(..))-import Data.Semigroup hiding (First(..), Last(..))-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Semigroup.Internal hiding- (Sing(SFirst, SLast), SFirst, SLast,- FirstSym0, FirstSym1, FirstSym0KindInference,- LastSym0, LastSym1, LastSym0KindInference,- GetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference,- GetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference)-import Data.Singletons.Prelude.Show-import Data.Singletons.Single-import Data.Singletons.Util--import GHC.TypeLits (Symbol)--$(singletonsOnly [d|- -- -| The class of monoids (types with an associative binary operation that- -- has an identity). Instances should satisfy the following laws:- --- -- * @x '<>' 'mempty' = x@- --- -- * @'mempty' '<>' x = x@- --- -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)- --- -- * @'mconcat' = 'foldr' '(<>)' 'mempty'@- --- -- The method names refer to the monoid of lists under concatenation,- -- but there are many other instances.- --- -- Some types can be viewed as a monoid in more than one way,- -- e.g. both addition and multiplication on numbers.- -- In such cases we often define @newtype@s and make those instances- -- of 'Monoid', e.g. 'Sum' and 'Product'.- class Semigroup a => Monoid a where- -- -| Identity of 'mappend'- mempty :: a-- -- -| An associative operation- --- -- __NOTE__: This method is redundant and has the default- -- implementation @'mappend' = '(<>)'@.- mappend :: a -> a -> a- mappend = (<>)-- -- -| Fold a list using the monoid.- --- -- For most types, the default definition for 'mconcat' will be- -- used, but the function is included in the class definition so- -- that an optimized version can be provided for specific types.- mconcat :: [a] -> a- mconcat = foldr mappend mempty-- instance Monoid [a] where- mempty = []- -- mconcat xss = [x | xs <- xss, x <- xs]-- instance Monoid b => Monoid (a -> b) where- mempty _ = mempty-- instance Monoid () where- -- Should it be strict?- mempty = ()- mconcat _ = ()-- instance (Monoid a, Monoid b) => Monoid (a,b) where- mempty = (mempty, mempty)-- instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where- mempty = (mempty, mempty, mempty)-- instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where- mempty = (mempty, mempty, mempty, mempty)-- instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>- Monoid (a,b,c,d,e) where- mempty = (mempty, mempty, mempty, mempty, mempty)-- -- lexicographical ordering- instance Monoid Ordering where- mempty = EQ-- -- -| Lift a semigroup into 'Maybe' forming a 'Monoid' according to- -- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be- -- turned into a monoid simply by adjoining an element @e@ not in @S@- -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\"- instance Semigroup a => Monoid (Maybe a) where- mempty = Nothing-- instance Monoid Symbol where- mempty = ""- |])--$(genSingletons monoidBasicTypes)-$(showSingInstances monoidBasicTypes)-$(singEqInstances monoidBasicTypes)-$(singDecideInstances monoidBasicTypes)-$(singOrdInstances monoidBasicTypes)-$(singShowInstances monoidBasicTypes)--$(singletonsOnly [d|- instance Monoid a => Monoid (Dual a) where- mempty = Dual mempty-- instance Monoid All where- mempty = All True-- instance Monoid Any where- mempty = Any False-- instance Num a => Monoid (Sum a) where- mempty = Sum 0-- instance Num a => Monoid (Product a) where- mempty = Product 1-- -- deriving newtype instance Monoid a => Monoid (Down a)- instance Monoid a => Monoid (Down a) where- mempty = Down mempty-- -- deriving newtype instance Applicative First- instance Applicative First where- pure = First . pure- First f <*> First x = First (f <*> x)-- deriving instance Functor First-- -- deriving newtype instance Monad First- instance Monad First where- First a >>= k = First (a >>= \x -> case k x of First y -> y)-- instance Semigroup (First a) where- First Nothing <> b = b- a@(First Just{}) <> _ = a-- instance Monoid (First a) where- mempty = First Nothing-- -- deriving newtype instance Applicative Last- instance Applicative Last where- pure = Last . pure- Last f <*> Last x = Last (f <*> x)-- deriving instance Functor Last-- -- deriving newtype instance Monad Last- instance Monad Last where- Last a >>= k = Last (a >>= \x -> case k x of Last y -> y)-- instance Semigroup (Last a) where- a <> Last Nothing = a- _ <> b@(Last Just {}) = b-- instance Monoid (Last a) where- mempty = Last Nothing- |])
− src/Data/Singletons/Prelude/Num.hs
@@ -1,145 +0,0 @@-{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies,- TypeOperators, GADTs, ScopedTypeVariables, UndecidableInstances,- DefaultSignatures, FlexibleContexts, InstanceSigs, NoStarIsType- #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Num--- Copyright : (C) 2014 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines and exports promoted and singleton versions of definitions from--- GHC.Num.------ Be warned that some of the associated type families in the 'PNum' class--- (@(+)@, @(-)@, and @(*)@) clash with their counterparts for 'Nat' in the--- "GHC.TypeLits" module.-------------------------------------------------------------------------------module Data.Singletons.Prelude.Num (- PNum(..), SNum(..), Subtract, sSubtract,-- -- ** Defunctionalization symbols- type (+@#@$), type (+@#@$$), type (+@#@$$$),- type (-@#@$), type (-@#@$$), type (-@#@$$$),- type (*@#@$), type (*@#@$$), type (*@#@$$$),- NegateSym0, NegateSym1,- AbsSym0, AbsSym1,- SignumSym0, SignumSym1,- FromIntegerSym0, FromIntegerSym1,- SubtractSym0, SubtractSym1, SubtractSym2- ) where--import Data.Ord (Down(..))-import Data.Singletons.Single-import Data.Singletons.Internal-import Data.Singletons.Prelude.Ord-import Data.Singletons.TypeLits.Internal-import Data.Singletons.Decide-import qualified GHC.TypeNats as TN-import GHC.TypeNats (Nat, SomeNat(..), someNatVal)-import Unsafe.Coerce--$(singletonsOnly [d|- -- Basic numeric class.- --- -- Minimal complete definition: all except 'negate' or @(-)@- class Num a where- (+), (-), (*) :: a -> a -> a- infixl 6 +- infixl 6 -- infixl 7 *- -- Unary negation.- negate :: a -> a- -- Absolute value.- abs :: a -> a- -- Sign of a number.- -- The functions 'abs' and 'signum' should satisfy the law:- --- -- > abs x * signum x == x- --- -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero)- -- or @1@ (positive).- signum :: a -> a- -- Conversion from a 'Nat'.- fromInteger :: Nat -> a-- x - y = x + negate y-- negate x = 0 - x-- -- deriving newtype instance Num a => Num (Down a)- instance Num a => Num (Down a) where- Down a + Down b = Down (a + b)- Down a - Down b = Down (a - b)- Down a * Down b = Down (a * b)- negate (Down a) = Down (negate a)- abs (Down a) = Down (abs a)- signum (Down a) = Down (signum a)- fromInteger n = Down (fromInteger n)- |])---- Workaround for #326-infixl 6 +-infixl 6 --infixl 7 *---- PNum instance-type family SignumNat (a :: Nat) :: Nat where- SignumNat 0 = 0- SignumNat x = 1--instance PNum Nat where- type a + b = a TN.+ b- type a - b = a TN.- b- type a * b = a TN.* b- type Negate (a :: Nat) = Error "Cannot negate a natural number"- type Abs (a :: Nat) = a- type Signum a = SignumNat a- type FromInteger a = a---- SNum instance-instance SNum Nat where- sa %+ sb =- let a = fromSing sa- b = fromSing sb- ex = someNatVal (a + b)- in- case ex of- SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab)-- sa %- sb =- let a = fromSing sa- b = fromSing sb- ex = someNatVal (a - b)- in- case ex of- SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab)-- sa %* sb =- let a = fromSing sa- b = fromSing sb- ex = someNatVal (a * b)- in- case ex of- SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab)-- sNegate _ = error "Cannot call sNegate on a natural number singleton."-- sAbs x = x-- sSignum sx =- case sx %~ (sing :: Sing 0) of- Proved Refl -> sing :: Sing 0- Disproved _ -> unsafeCoerce (sing :: Sing 1)-- sFromInteger x = x--$(singletonsOnly [d|- subtract :: Num a => a -> a -> a- subtract x y = y - x- |])
− src/Data/Singletons/Prelude/Ord.hs
@@ -1,115 +0,0 @@-{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables,- TypeFamilies, TypeOperators, GADTs, UndecidableInstances,- FlexibleContexts, DefaultSignatures, InstanceSigs,- StandaloneDeriving, FlexibleInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Ord--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted version of Ord, 'POrd', and the singleton version,--- 'SOrd'.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Ord (- POrd(..), SOrd(..),-- Comparing, sComparing,-- -- | 'thenCmp' returns its second argument if its first is 'EQ'; otherwise,- -- it returns its first argument.- thenCmp, ThenCmp, sThenCmp,-- Sing(SLT, SEQ, SGT, SDown),-- SOrdering, SDown,-- -- ** Defunctionalization symbols- ThenCmpSym0, ThenCmpSym1, ThenCmpSym2,- LTSym0, EQSym0, GTSym0,- CompareSym0, CompareSym1, CompareSym2,- type (<@#@$), type (<@#@$$), type (<@#@$$$),- type (<=@#@$), type (<=@#@$$), type (<=@#@$$$),- type (>@#@$), type (>@#@$$), type (>@#@$$$),- type (>=@#@$), type (>=@#@$$), type (>=@#@$$$),- MaxSym0, MaxSym1, MaxSym2,- MinSym0, MinSym1, MinSym2,- ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3,- DownSym0, DownSym1- ) where--import Data.Ord (Down(..))-import Data.Singletons.Single-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Instances-import Data.Singletons.Util--$(singletonsOnly [d|- class (Eq a) => Ord a where- compare :: a -> a -> Ordering- (<), (<=), (>), (>=) :: a -> a -> Bool- infix 4 <=- infix 4 <- infix 4 >- infix 4 >=- max, min :: a -> a -> a-- compare x y = if x == y then EQ- -- NB: must be '<=' not '<' to validate the- -- above claim about the minimal things that- -- can be defined for an instance of Ord:- else if x <= y then LT- else GT-- x < y = case compare x y of { LT -> True; EQ -> False; GT -> False }- x <= y = case compare x y of { LT -> True; EQ -> True; GT -> False }- x > y = case compare x y of { LT -> False; EQ -> False; GT -> True }- x >= y = case compare x y of { LT -> False; EQ -> True; GT -> True }-- -- These two default methods use '<=' rather than 'compare'- -- because the latter is often more expensive- max x y = if x <= y then y else x- min x y = if x <= y then x else y- -- Not handled by TH: {-# MINIMAL compare | (<=) #-}-- -- -|- -- > comparing p x y = compare (p x) (p y)- --- -- Useful combinator for use in conjunction with the @xxxBy@ family- -- of functions from "Data.List", for example:- --- -- > ... sortBy (comparing fst) ...- comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering- comparing p x y = compare (p x) (p y)- |])---- Workaround for #326-infix 4 <=-infix 4 <-infix 4 >-infix 4 >=--$(genSingletons [''Down])--$(singletonsOnly [d|- deriving instance Eq a => Eq (Down a)-- instance Ord a => Ord (Down a) where- compare (Down x) (Down y) = y `compare` x- |])--$(singletons [d|- thenCmp :: Ordering -> Ordering -> Ordering- thenCmp EQ x = x- thenCmp LT _ = LT- thenCmp GT _ = GT- |])--$(singOrdInstances basicTypes)
− src/Data/Singletons/Prelude/Semigroup.hs
@@ -1,307 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Semigroup--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted version of 'Semigroup', 'PSemigroup', and the--- singleton version, 'SSemigroup'.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Semigroup (- PSemigroup(..), SSemigroup(..),-- Sing(SMin, sGetMin, SMax, sGetMax,- SFirst, sGetFirst, SLast, sGetLast,- SWrapMonoid, sUnwrapMonoid, SDual, sGetDual,- SAll, sGetAll, SAny, sGetAny,- SSum, sGetSum, SProduct, sGetProduct,- SOption, sGetOption, SArg),- GetMin, GetMax, GetFirst, GetLast, GetDual,- GetAll, GetAny, GetSum, GetProduct, GetOption,-- SMin, SMax, SFirst, SLast, SWrappedMonoid, SDual,- SAll, SAny, SSum, SProduct, SOption, SArg,-- option_, sOption_, Option_,-- -- ** Defunctionalization symbols- type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),- SconcatSym0, SconcatSym1,- MinSym0, MinSym1, GetMinSym0, GetMinSym1,- MaxSym0, MaxSym1, GetMaxSym0, GetMaxSym1,- FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1,- LastSym0, LastSym1, GetLastSym0, GetLastSym1,- WrapMonoidSym0, WrapMonoidSym1, UnwrapMonoidSym0, UnwrapMonoidSym1,- DualSym0, DualSym1, GetDualSym0, GetDualSym1,- AllSym0, AllSym1, GetAllSym0, GetAllSym1,- AnySym0, AnySym1, GetAnySym0, GetAnySym1,- SumSym0, SumSym1, GetSumSym0, GetSumSym1,- ProductSym0, ProductSym1, GetProductSym0, GetProductSym1,- OptionSym0, OptionSym1, GetOptionSym0, GetOptionSym1,- ArgSym0, ArgSym1, ArgSym2- ) where--import Control.Applicative-import Control.Monad-import qualified Data.Semigroup as Semi (Min(..), Max(..))-import Data.Semigroup (First(..), Last(..), WrappedMonoid(..), Option(..), Arg(..))-import Data.Singletons.Prelude.Base hiding- (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Foldable hiding- ( All, AllSym0, AllSym1- , Any, AnySym0, AnySym1- , Product, ProductSym0, ProductSym1- , Sum, SumSym0, SumSym1 )-import Data.Singletons.Prelude.Functor-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid hiding- (Sing(SFirst, SLast), SFirst, sGetFirst, SLast, sGetLast,- FirstSym0, FirstSym1, LastSym0, LastSym1,- GetFirst, GetFirstSym0, GetFirstSym1,- GetLast, GetLastSym0, GetLastSym1)-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord hiding- (MinSym0, MinSym1, MaxSym0, MaxSym1)-import Data.Singletons.Prelude.Semigroup.Internal-import Data.Singletons.Prelude.Show-import Data.Singletons.Prelude.Traversable-import Data.Singletons.Single-import Data.Singletons.Util--$(genSingletons [''Arg])-$(showSingInstances $ ''Option : semigroupBasicTypes)-$(singShowInstances $ ''Option : semigroupBasicTypes)--$(singletonsOnly [d|- instance Applicative Semi.Min where- pure = Semi.Min- a <* _ = a- _ *> a = a- Semi.Min f <*> Semi.Min x = Semi.Min (f x)- liftA2 f (Semi.Min a) (Semi.Min b) = Semi.Min (f a b)-- instance Enum a => Enum (Semi.Min a) where- succ (Semi.Min a) = Semi.Min (succ a)- pred (Semi.Min a) = Semi.Min (pred a)- toEnum = Semi.Min . toEnum- fromEnum (Semi.Min a) = fromEnum a- enumFromTo (Semi.Min a) (Semi.Min b) = Semi.Min `map` enumFromTo a b- enumFromThenTo (Semi.Min a) (Semi.Min b) (Semi.Min c) = Semi.Min `map` enumFromThenTo a b c-- deriving instance Functor Semi.Min-- instance Monad Semi.Min where- (>>) = (*>)- Semi.Min a >>= f = f a-- instance Ord a => Semigroup (Semi.Min a) where- Semi.Min a <> Semi.Min b = Semi.Min (a `min_` b)-- instance (Ord a, Bounded a) => Monoid (Semi.Min a) where- mempty = maxBound-- instance Num a => Num (Semi.Min a) where- (Semi.Min a) + (Semi.Min b) = Semi.Min (a + b)- (Semi.Min a) * (Semi.Min b) = Semi.Min (a * b)- (Semi.Min a) - (Semi.Min b) = Semi.Min (a - b)- negate (Semi.Min a) = Semi.Min (negate a)- abs (Semi.Min a) = Semi.Min (abs a)- signum (Semi.Min a) = Semi.Min (signum a)- fromInteger = Semi.Min . fromInteger-- deriving instance Foldable Semi.Min- deriving instance Traversable Semi.Min-- instance Applicative Semi.Max where- pure = Semi.Max- a <* _ = a- _ *> a = a- Semi.Max f <*> Semi.Max x = Semi.Max (f x)- liftA2 f (Semi.Max a) (Semi.Max b) = Semi.Max (f a b)-- instance Enum a => Enum (Semi.Max a) where- succ (Semi.Max a) = Semi.Max (succ a)- pred (Semi.Max a) = Semi.Max (pred a)- toEnum = Semi.Max . toEnum- fromEnum (Semi.Max a) = fromEnum a- enumFromTo (Semi.Max a) (Semi.Max b) = Semi.Max `map` enumFromTo a b- enumFromThenTo (Semi.Max a) (Semi.Max b) (Semi.Max c) = Semi.Max `map` enumFromThenTo a b c-- deriving instance Functor Semi.Max-- instance Monad Semi.Max where- (>>) = (*>)- Semi.Max a >>= f = f a-- instance Ord a => Semigroup (Semi.Max a) where- Semi.Max a <> Semi.Max b = Semi.Max (a `max_` b)-- instance (Ord a, Bounded a) => Monoid (Semi.Max a) where- mempty = minBound-- instance Num a => Num (Semi.Max a) where- (Semi.Max a) + (Semi.Max b) = Semi.Max (a + b)- (Semi.Max a) * (Semi.Max b) = Semi.Max (a * b)- (Semi.Max a) - (Semi.Max b) = Semi.Max (a - b)- negate (Semi.Max a) = Semi.Max (negate a)- abs (Semi.Max a) = Semi.Max (abs a)- signum (Semi.Max a) = Semi.Max (signum a)- fromInteger = Semi.Max . fromInteger-- deriving instance Foldable Semi.Max- deriving instance Traversable Semi.Max-- instance Eq a => Eq (Arg a b) where- Arg a _ == Arg b _ = a == b-- deriving instance Functor (Arg a)-- instance Ord a => Ord (Arg a b) where- Arg a _ `compare` Arg b _ = compare a b- min x@(Arg a _) y@(Arg b _)- | a <= b = x- | otherwise = y- max x@(Arg a _) y@(Arg b _)- | a >= b = x- | otherwise = y-- deriving instance (Show a, Show b) => Show (Arg a b)- deriving instance Foldable (Arg a)- deriving instance Traversable (Arg a)-- instance Applicative First where- pure x = First x- a <* _ = a- _ *> a = a- First f <*> First x = First (f x)- liftA2 f (First a) (First b) = First (f a b)-- instance Enum a => Enum (First a) where- succ (First a) = First (succ a)- pred (First a) = First (pred a)- toEnum = First . toEnum- fromEnum (First a) = fromEnum a- enumFromTo (First a) (First b) = First `map` enumFromTo a b- enumFromThenTo (First a) (First b) (First c) = First `map` enumFromThenTo a b c-- deriving instance Functor First-- instance Monad First where- (>>) = (*>)- First a >>= f = f a-- instance Semigroup (First a) where- a <> _ = a-- deriving instance Foldable First- deriving instance Traversable First-- instance Applicative Last where- pure x = Last x- a <* _ = a- _ *> a = a- Last f <*> Last x = Last (f x)- liftA2 f (Last a) (Last b) = Last (f a b)-- instance Enum a => Enum (Last a) where- succ (Last a) = Last (succ a)- pred (Last a) = Last (pred a)- toEnum = Last . toEnum- fromEnum (Last a) = fromEnum a- enumFromTo (Last a) (Last b) = Last `map` enumFromTo a b- enumFromThenTo (Last a) (Last b) (Last c) = Last `map` enumFromThenTo a b c-- deriving instance Functor Last-- instance Monad Last where- (>>) = (*>)- Last a >>= f = f a-- instance Semigroup (Last a) where- _ <> b = b-- deriving instance Foldable Last- deriving instance Traversable Last-- instance Monoid m => Semigroup (WrappedMonoid m) where- WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b)-- instance Monoid m => Monoid (WrappedMonoid m) where- mempty = WrapMonoid mempty-- instance Enum a => Enum (WrappedMonoid a) where- succ (WrapMonoid a) = WrapMonoid (succ a)- pred (WrapMonoid a) = WrapMonoid (pred a)- toEnum = WrapMonoid . toEnum- fromEnum (WrapMonoid a) = fromEnum a- enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid `map` enumFromTo a b- enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) =- WrapMonoid `map` enumFromThenTo a b c-- instance Alternative Option where- empty = Option Nothing- Option Nothing <|> b = b- a@(Option Just{}) <|> _ = a-- instance Applicative Option where- pure a = Option (Just a)- Option a <*> Option b = Option (a <*> b)- liftA2 f (Option x) (Option y) = Option (liftA2 f x y)-- Option Nothing *> _ = Option Nothing- Option Just{} *> b = b-- deriving instance Functor Option-- instance Monad Option where- Option (Just a) >>= k = k a- Option Nothing >>= _ = Option Nothing- (>>) = (*>)-- instance MonadPlus Option-- -- deriving newtype instance Semigroup a => Semigroup (Option a)- instance Semigroup a => Semigroup (Option a) where- Option a <> Option b = Option (a <> b)-- instance Semigroup a => Monoid (Option a) where- mempty = Option Nothing-- instance Foldable Option where- foldMap f (Option (Just m)) = f m- foldMap _ (Option Nothing) = mempty-- instance Traversable Option where- traverse f (Option (Just a)) = Option . Just <$> f a- traverse _ (Option Nothing) = pure (Option Nothing)- |])--$(singletons [d|- -- Renamed to avoid name clash- -- -| Fold an 'Option' case-wise, just like 'maybe'.- option_ :: b -> (a -> b) -> Option a -> b- option_ n j (Option m) = maybe_ n j m- |])
− src/Data/Singletons/Prelude/Semigroup/Internal.hs
@@ -1,280 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Semigroup.Internal--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted version of 'Semigroup', 'PSemigroup'; the--- singleton version, 'SSemigroup'; and some @newtype@ wrappers, all--- of which are reexported from the "Data.Semigroup" module or--- imported directly by some other modules.------ This module exists to avoid import cycles with--- "Data.Singletons.Prelude.Monoid".----------------------------------------------------------------------------------module Data.Singletons.Prelude.Semigroup.Internal where--import Data.List.NonEmpty (NonEmpty(..))-import Data.Ord (Down(..))-import Data.Proxy-import Data.Semigroup (Dual(..), All(..), Any(..), Sum(..), Product(..), Option(..))-import Data.Singletons.Internal-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Ord hiding (MinSym0, MinSym1, MaxSym0, MaxSym1)-import Data.Singletons.Promote-import Data.Singletons.Single-import Data.Singletons.TypeLits.Internal-import Data.Singletons.Util-import qualified Data.Text as T-import Data.Void (Void)--import GHC.TypeLits (AppendSymbol, SomeSymbol(..), someSymbolVal, Symbol)--import Unsafe.Coerce--$(singletonsOnly [d|- -- -| The class of semigroups (types with an associative binary operation).- --- -- Instances should satisfy the associativity law:- --- -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@- class Semigroup a where- -- -| An associative operation.- (<>) :: a -> a -> a- infixr 6 <>-- -- -| Reduce a non-empty list with @\<\>@- --- -- The default definition should be sufficient, but this can be- -- overridden for efficiency.- --- sconcat :: NonEmpty a -> a- sconcat (a :| as) = go a as where- go b (c:cs) = b <> go c cs- go b [] = b-- {-- Can't single 'stimes', since there's no singled 'Integral' class.-- -- -| Repeat a value @n@ times.- --- -- Given that this works on a 'Semigroup' it is allowed to fail if- -- you request 0 or fewer repetitions, and the default definition- -- will do so.- --- -- By making this a member of the class, idempotent semigroups- -- and monoids can upgrade this to execute in /O(1)/ by- -- picking @stimes = 'stimesIdempotent'@ or @stimes =- -- 'stimesIdempotentMonoid'@ respectively.- stimes :: Integral b => b -> a -> a- stimes = stimesDefault- -}--- instance Semigroup [a] where- (<>) = (++)-- instance Semigroup (NonEmpty a) where- (a :| as) <> (b :| bs) = a :| (as ++ b : bs)-- instance Semigroup b => Semigroup (a -> b) where- f <> g = \x -> f x <> g x-- instance Semigroup () where- _ <> _ = ()- sconcat _ = ()-- instance (Semigroup a, Semigroup b) => Semigroup (a, b) where- (a,b) <> (a',b') = (a<>a',b<>b')-- instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where- (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')-- instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)- => Semigroup (a, b, c, d) where- (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')-- instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)- => Semigroup (a, b, c, d, e) where- (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')-- instance Semigroup Ordering where- LT <> _ = LT- EQ <> y = y- GT <> _ = GT-- instance Semigroup a => Semigroup (Maybe a) where- Nothing <> b = b- a <> Nothing = a- Just a <> Just b = Just (a <> b)-- instance Semigroup (Either a b) where- Left _ <> b = b- -- a <> _ = a- a@Right{} <> _ = a-- instance Semigroup Void where- a <> _ = a-- -- deriving newtype instance Semigroup a => Semigroup (Down a)- instance Semigroup a => Semigroup (Down a) where- Down a <> Down b = Down (a <> b)- |])---- Workaround for #326-infixr 6 <>--$(genSingletons $ ''Option : semigroupBasicTypes)-$(singBoundedInstances semigroupBasicTypes)-$(singEqInstances $ ''Option : semigroupBasicTypes)-$(singDecideInstances $ ''Option : semigroupBasicTypes)-$(singOrdInstances $ ''Option : semigroupBasicTypes)--$(singletonsOnly [d|- instance Applicative Dual where- pure = Dual- Dual f <*> Dual x = Dual (f x)-- deriving instance Functor Dual-- instance Monad Dual where- Dual a >>= k = k a-- instance Semigroup a => Semigroup (Dual a) where- Dual a <> Dual b = Dual (b <> a)-- instance Semigroup All where- All a <> All b = All (a && b)-- instance Semigroup Any where- Any a <> Any b = Any (a || b)-- instance Applicative Sum where- pure = Sum- Sum f <*> Sum x = Sum (f x)-- deriving instance Functor Sum-- instance Monad Sum where- Sum a >>= k = k a-- instance Num a => Semigroup (Sum a) where- Sum a <> Sum b = Sum (a + b)-- -- deriving newtype instance Num a => Num (Sum a)- instance Num a => Num (Sum a) where- Sum a + Sum b = Sum (a + b)- Sum a - Sum b = Sum (a - b)- Sum a * Sum b = Sum (a * b)- negate (Sum a) = Sum (negate a)- abs (Sum a) = Sum (abs a)- signum (Sum a) = Sum (signum a)- fromInteger n = Sum (fromInteger n)-- instance Applicative Product where- pure = Product- Product f <*> Product x = Product (f x)-- deriving instance Functor Product-- instance Monad Product where- Product a >>= k = k a-- instance Num a => Semigroup (Product a) where- Product a <> Product b = Product (a * b)-- -- deriving newtype instance Num a => Num (Product a)- instance Num a => Num (Product a) where- Product a + Product b = Product (a + b)- Product a - Product b = Product (a - b)- Product a * Product b = Product (a * b)- negate (Product a) = Product (negate a)- abs (Product a) = Product (abs a)- signum (Product a) = Product (signum a)- fromInteger n = Product (fromInteger n)- |])--instance PSemigroup Symbol where- type a <> b = AppendSymbol a b--instance SSemigroup Symbol where- sa %<> sb =- let a = fromSing sa- b = fromSing sb- ex = someSymbolVal $ T.unpack $ a <> b- in case ex of- SomeSymbol (_ :: Proxy ab) -> unsafeCoerce (SSym :: Sing ab)---- We need these in Data.Singletons.Prelude.Semigroup, as we need to promote--- code that simultaneously uses the Min/Max constructors and the min/max--- functions, which have clashing defunctionalization symbol names. Our--- workaround is to simply define synonyms for min/max and use those instead.-min_, max_ :: Ord a => a -> a -> a-min_ = min-max_ = max--type Min_ x y = Min x y-type Max_ x y = Max x y-$(genDefunSymbols [''Min_, ''Max_])--sMin_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Min_` y)-sMin_ = sMin--sMax_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Max_` y)-sMax_ = sMax---- We need these in Data.Singletons.Prelude.Foldable.-all_ :: Bool -> All-all_ = All--any_ :: Bool -> Any-any_ = Any--sum_ :: a -> Sum a-sum_ = Sum--product_ :: a -> Product a-product_ = Product--type All_ a = 'All a-type Any_ a = 'Any a-type Sum_ a = 'Sum a-type Product_ a = 'Product a-$(genDefunSymbols [''All_, ''Any_, ''Sum_, ''Product_])--sAll_ :: forall (x :: Bool). Sing x -> Sing (All_ x)-sAll_ = SAll--sAny_ :: forall (x :: Bool). Sing x -> Sing (Any_ x)-sAny_ = SAny--sSum_ :: forall a (x :: a). Sing x -> Sing (Sum_ x)-sSum_ = SSum--sProduct_ :: forall a (x :: a). Sing x -> Sing (Product_ x)-sProduct_ = SProduct
− src/Data/Singletons/Prelude/Show.hs
@@ -1,194 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Show--- Copyright : (C) 2017 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the SShow singleton version of the Show type class.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Show (- PShow(..), SShow(..), SymbolS, SChar, show_,- Shows, sShows,- ShowListWith, sShowListWith,- ShowChar, sShowChar,- ShowString, sShowString,- ShowParen, sShowParen,- ShowSpace, sShowSpace,- ShowCommaSpace, sShowCommaSpace,- AppPrec, sAppPrec,- AppPrec1, sAppPrec1,-- -- * Defunctionalization symbols- ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,- Show_Sym0, Show_Sym1,- ShowListSym0, ShowListSym1, ShowListSym2,- ShowsSym0, ShowsSym1, ShowsSym2,- ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3,- ShowCharSym0, ShowCharSym1, ShowCharSym2,- ShowStringSym0, ShowStringSym1, ShowStringSym2,- ShowParenSym0, ShowParenSym1, ShowParenSym2,- ShowSpaceSym0, ShowSpaceSym1,- ShowCommaSpaceSym0, ShowCommaSpaceSym1,- AppPrecSym0, AppPrec1Sym0- ) where--import Data.List.NonEmpty (NonEmpty)-import Data.Ord (Down)-import Data.Proxy-import Data.Singletons.Internal-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.List.Internal-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Semigroup.Internal-import Data.Singletons.Promote-import Data.Singletons.Single-import Data.Singletons.TypeLits-import qualified Data.Text as T-import Data.Void--import GHC.TypeLits--import qualified Prelude as P-import Prelude hiding (Show(..))--import Unsafe.Coerce (unsafeCoerce)---- | The @shows@ functions return a function that prepends the--- output 'Symbol' to an existing 'Symbol'. This allows constant-time--- concatenation of results using function composition.-type SymbolS = Symbol -> Symbol---- | GHC currently has no notion of type-level 'Char's, so we fake them with--- single-character 'Symbol's.-type SChar = Symbol--$(singletonsOnly [d|- class Show a where- showsPrec :: Nat -> a -> SymbolS- show_ :: a -> Symbol- showList :: [a] -> SymbolS-- showsPrec _ x s = show_ x <> s- show_ x = shows x ""- showList ls s = showListWith shows ls s-- shows :: Show a => a -> SymbolS- shows s = showsPrec 0 s-- showListWith :: (a -> SymbolS) -> [a] -> SymbolS- showListWith _ [] s = "[]" <> s- showListWith showx (x:xs) s = "[" <> showx x (showl xs)- where- showl [] = "]" <> s- showl (y:ys) = "," <> showx y (showl ys)-- showChar :: SChar -> SymbolS- showChar = (<>)-- showString :: Symbol -> SymbolS- showString = (<>)-- showParen :: Bool -> SymbolS -> SymbolS- showParen b p = if b then showChar "(" . p . showChar ")" else p-- showSpace :: SymbolS- showSpace = \xs -> " " <> xs-- showCommaSpace :: SymbolS- showCommaSpace = showString ", "-- appPrec, appPrec1 :: Nat- appPrec = 10- appPrec1 = 11-- instance Show a => Show [a] where- showsPrec _ = showList-- -- -| This is not an ideal Show instance for Symbol, since the Show instance- -- for String escapes special characters. Unfortunately, GHC lacks the ability- -- to case on individual characters in a Symbol (at least, not without GHC- -- plugins), so this is the best we can do for the time being.- instance Show Symbol where- showsPrec _ = showString-- show_tuple :: [SymbolS] -> SymbolS- show_tuple ss = showChar "("- . foldr1 (\s r -> s . showChar "," . r) ss- . showChar ")"-- instance (Show a, Show b) => Show (a,b) where- showsPrec _ (a,b) s = show_tuple [shows a, shows b] s-- instance (Show a, Show b, Show c) => Show (a, b, c) where- showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s-- instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where- showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s-- instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where- showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s-- instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where- showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s-- instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)- => Show (a,b,c,d,e,f,g) where- showsPrec _ (a,b,c,d,e,f,g) s- = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s-- deriving instance Show a => Show (Down a)- |])--$(promoteOnly [d|- showsNat :: Nat -> SymbolS- showsNat 0 = showChar "0"- showsNat 1 = showChar "1"- showsNat 2 = showChar "2"- showsNat 3 = showChar "3"- showsNat 4 = showChar "4"- showsNat 5 = showChar "5"- showsNat 6 = showChar "6"- showsNat 7 = showChar "7"- showsNat 8 = showChar "8"- showsNat 9 = showChar "9"- showsNat n = showsNat (n `div` 10) . showsNat (n `mod` 10)- |])--instance PShow Nat where- type ShowsPrec _ n x = ShowsNat n x--instance SShow Nat where- sShowsPrec _ sn sx =- let n = fromSing sn- x = fromSing sx- ex = someSymbolVal (P.show n ++ T.unpack x)- in- case ex of- SomeSymbol (_ :: Proxy s) -> unsafeCoerce (SSym :: Sing s)---- | 'P.show', but with an extra underscore so that its promoted counterpart--- ('Show_') will not clash with the 'Show' class.-show_ :: P.Show a => a -> String-show_ = P.show--$(singShowInstances [ ''(), ''Maybe, ''Either, ''NonEmpty, ''Bool,- ''Ordering, ''Void ])
− src/Data/Singletons/Prelude/Traversable.hs
@@ -1,286 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Traversable--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines the promoted and singled versions of the 'Traversable' type class.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Traversable (- PTraversable(..), STraversable(..),- For, sFor,- ForM, sForM,- MapAccumL, sMapAccumL,- MapAccumR, sMapAccumR,- FmapDefault, sFmapDefault,- FoldMapDefault, sFoldMapDefault,-- -- * Defunctionalization symbols- TraverseSym0, TraverseSym1, TraverseSym2,- SequenceASym0, SequenceASym1,- MapMSym0, MapMSym1, MapMSym2,- SequenceSym0, SequenceSym1,-- ForSym0, ForSym1, ForSym2,- ForMSym0, ForMSym1, ForMSym2,- MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3,- MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3,- FmapDefaultSym0, FmapDefaultSym1, FmapDefaultSym2,- FoldMapDefaultSym0, FoldMapDefaultSym1, FoldMapDefaultSym2- ) where--import Control.Applicative-import Data.Functor.Identity-import Data.Kind-import Data.List.NonEmpty (NonEmpty(..))-import Data.Monoid-import Data.Singletons.Internal-import Data.Singletons.Prelude.Base hiding (Const, ConstSym0)-import Data.Singletons.Prelude.Const-import Data.Singletons.Prelude.Foldable (PFoldable, SFoldable)-import Data.Singletons.Prelude.Functor-import Data.Singletons.Prelude.Identity-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Monad.Internal-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Single--newtype StateL s a = StateL (s ~> (s, a))-data instance Sing :: forall s a. StateL s a -> Type where- SStateL :: Sing x -> Sing ('StateL x)-data StateLSym0 :: forall s a. (s ~> (s, a)) ~> StateL s a-type instance Apply StateLSym0 x = 'StateL x--newtype StateR s a = StateR (s ~> (s, a))-data instance Sing :: forall s a. StateR s a -> Type where- SStateR :: Sing x -> Sing ('StateR x)-data StateRSym0 :: forall s a. (s ~> (s, a)) ~> StateR s a-type instance Apply StateRSym0 x = 'StateR x--$(singletonsOnly [d|- -- -| Functors representing data structures that can be traversed from- -- left to right.- --- -- A definition of 'traverse' must satisfy the following laws:- --- -- [/naturality/]- -- @t . 'traverse' f = 'traverse' (t . f)@- -- for every applicative transformation @t@- --- -- [/identity/]- -- @'traverse' Identity = Identity@- --- -- [/composition/]- -- @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@- --- -- A definition of 'sequenceA' must satisfy the following laws:- --- -- [/naturality/]- -- @t . 'sequenceA' = 'sequenceA' . 'fmap' t@- -- for every applicative transformation @t@- --- -- [/identity/]- -- @'sequenceA' . 'fmap' Identity = Identity@- --- -- [/composition/]- -- @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@- --- -- where an /applicative transformation/ is a function- --- -- @t :: (Applicative f, Applicative g) => f a -> g a@- --- -- preserving the 'Applicative' operations, i.e.- --- -- * @t ('pure' x) = 'pure' x@- --- -- * @t (x '<*>' y) = t x '<*>' t y@- --- -- and the identity functor @Identity@ and composition of functors @Compose@- -- are defined as- --- -- > newtype Identity a = Identity a- -- >- -- > instance Functor Identity where- -- > fmap f (Identity x) = Identity (f x)- -- >- -- > instance Applicative Identity where- -- > pure x = Identity x- -- > Identity f <*> Identity x = Identity (f x)- -- >- -- > newtype Compose f g a = Compose (f (g a))- -- >- -- > instance (Functor f, Functor g) => Functor (Compose f g) where- -- > fmap f (Compose x) = Compose (fmap (fmap f) x)- -- >- -- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where- -- > pure x = Compose (pure (pure x))- -- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)- --- -- (The naturality law is implied by parametricity.)- --- -- Instances are similar to 'Functor', e.g. given a data type- --- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)- --- -- a suitable instance would be- --- -- > instance Traversable Tree where- -- > traverse f Empty = pure Empty- -- > traverse f (Leaf x) = Leaf <$> f x- -- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r- --- -- This is suitable even for abstract types, as the laws for '<*>'- -- imply a form of associativity.- --- -- The superclass instances should satisfy the following:- --- -- * In the 'Functor' instance, 'fmap' should be equivalent to traversal- -- with the identity applicative functor ('fmapDefault').- --- -- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be- -- equivalent to traversal with a constant applicative functor- -- ('foldMapDefault').- --- class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where- -- {-# MINIMAL traverse | sequenceA #-}-- -- -| Map each element of a structure to an action, evaluate these actions- -- from left to right, and collect the results. For a version that ignores- -- the results see 'Data.Foldable.traverse_'.- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)- traverse f = sequenceA . fmap f-- -- -| Evaluate each action in the structure from left to right, and- -- and collect the results. For a version that ignores the results- -- see 'Data.Foldable.sequenceA_'.- sequenceA :: Applicative f => t (f a) -> f (t a)- sequenceA = traverse id-- -- -| Map each element of a structure to a monadic action, evaluate- -- these actions from left to right, and collect the results. For- -- a version that ignores the results see 'Data.Foldable.mapM_'.- mapM :: Monad m => (a -> m b) -> t a -> m (t b)- mapM = traverse-- -- -| Evaluate each monadic action in the structure from left to- -- right, and collect the results. For a version that ignores the- -- results see 'Data.Foldable.sequence_'.- sequence :: Monad m => t (m a) -> m (t a)- sequence = sequenceA- |])--$(singletonsOnly [d|- -- instances for Prelude types-- deriving instance Traversable Maybe- deriving instance Traversable []- deriving instance Traversable NonEmpty- deriving instance Traversable (Either a)- deriving instance Traversable ((,) a)- deriving instance Traversable (Const m)- deriving instance Traversable Dual- deriving instance Traversable Sum- deriving instance Traversable Product- deriving instance Traversable First- deriving instance Traversable Last- deriving instance Traversable Identity-- -- general functions-- -- -| 'for' is 'traverse' with its arguments flipped. For a version- -- that ignores the results see 'Data.Foldable.for_'.- for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)- for = flip traverse-- -- -| 'forM' is 'mapM' with its arguments flipped. For a version that- -- ignores the results see 'Data.Foldable.forM_'.- forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)- forM = flip mapM-- instance Functor (StateL s) where- fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)-- instance Applicative (StateL s) where- pure x = StateL (\ s -> (s, x))- StateL kf <*> StateL kv = StateL $ \ s ->- let (s', f) = kf s- (s'', v) = kv s'- in (s'', f v)- liftA2 f (StateL kx) (StateL ky) = StateL $ \s ->- let (s', x) = kx s- (s'', y) = ky s'- in (s'', f x y)-- instance Functor (StateR s) where- fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)-- instance Applicative (StateR s) where- pure x = StateR (\ s -> (s, x))- StateR kf <*> StateR kv = StateR $ \ s ->- let (s', v) = kv s- (s'', f) = kf s'- in (s'', f v)- liftA2 f (StateR kx) (StateR ky) = StateR $ \ s ->- let (s', y) = ky s- (s'', x) = kx s'- in (s'', f x y)-- -- -|The 'mapAccumL' function behaves like a combination of 'fmap'- -- and 'foldl'; it applies a function to each element of a structure,- -- passing an accumulating parameter from left to right, and returning- -- a final value of this accumulator together with the new structure.- mapAccumL :: forall t a b c. Traversable t- => (a -> b -> (a, c)) -> a -> t b -> (a, t c)- mapAccumL f s t = case traverse (StateL . flip f) t of- StateL g -> g s-- -- -|The 'mapAccumR' function behaves like a combination of 'fmap'- -- and 'foldr'; it applies a function to each element of a structure,- -- passing an accumulating parameter from right to left, and returning- -- a final value of this accumulator together with the new structure.- mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)- mapAccumR f s t = case traverse (StateR . flip f) t of- StateR g -> g s-- -- -| This function may be used as a value for `fmap` in a `Functor`- -- instance, provided that 'traverse' is defined. (Using- -- `fmapDefault` with a `Traversable` instance defined only by- -- 'sequenceA' will result in infinite recursion.)- --- -- @- -- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f)- -- @- fmapDefault :: forall t a b . Traversable t- => (a -> b) -> t a -> t b- fmapDefault f x = case traverse (Identity . f) x of Identity y -> y-- -- -| This function may be used as a value for `Data.Foldable.foldMap`- -- in a `Foldable` instance.- --- -- @- -- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f)- -- @- foldMapDefault :: forall t m a . (Traversable t, Monoid m)- => (a -> m) -> t a -> m- foldMapDefault f x = case traverse (mkConst . f) x of Const y -> y- where- mkConst :: m -> Const m ()- mkConst = Const- |])
− src/Data/Singletons/Prelude/Tuple.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, PolyKinds,- RankNTypes, TypeFamilies, GADTs, UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.Tuple--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for tuples,--- including a singletons version of all the definitions in @Data.Tuple@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Tuple@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Singletons.Prelude.Tuple (- -- * Singleton definitions- -- | See 'Data.Singletons.Prelude.Sing' for more info.-- Sing(STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7),- STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7,-- -- * Singletons from @Data.Tuple@- Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry, Swap, sSwap,-- -- * Defunctionalization symbols- Tuple0Sym0,- Tuple2Sym0, Tuple2Sym1, Tuple2Sym2,- Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3,- Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4,- Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5,- Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6,- Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7,-- FstSym0, FstSym1, SndSym0, SndSym1,- CurrySym0, CurrySym1, CurrySym2, CurrySym3,- UncurrySym0, UncurrySym1, UncurrySym2,- SwapSym0, SwapSym1- ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Single--$(singletonsOnly [d|- -- -| Extract the first component of a pair.- fst :: (a,b) -> a- fst (x,_) = x-- -- -| Extract the second component of a pair.- snd :: (a,b) -> b- snd (_,y) = y-- -- -| 'curry' converts an uncurried function to a curried function.- curry :: ((a, b) -> c) -> a -> b -> c- curry f x y = f (x, y)-- -- -| 'uncurry' converts a curried function to a function on pairs.- uncurry :: (a -> b -> c) -> ((a, b) -> c)- uncurry f p = f (fst p) (snd p)-- -- -| Swap the components of a pair.- swap :: (a,b) -> (b,a)- swap (a,b) = (b,a)- |])
− src/Data/Singletons/Prelude/Void.hs
@@ -1,55 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Prelude.Void--- Copyright : (C) 2017 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines functions and datatypes relating to the singleton for 'Void',--- including a singleton version of all the definitions in @Data.Void@.------ Because many of these definitions are produced by Template Haskell,--- it is not possible to create proper Haddock documentation. Please look--- up the corresponding operation in @Data.Void@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.---------------------------------------------------------------------------------module Data.Singletons.Prelude.Void (- -- * The 'Void' singleton- Sing,- -- | Just as 'Void' has no constructors, the 'Sing' instance above also has- -- no constructors.-- SVoid,- -- | 'SVoid' is a kind-restricted synonym for 'Sing':- -- @type SVoid (a :: Void) = Sing a@-- -- * Singletons from @Data.Void@- Absurd, sAbsurd,-- -- * Defunctionalization symbols- AbsurdSym0, AbsurdSym1- ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Void--$(singletonsOnly [d|- -- -| Since 'Void' values logically don't exist, this witnesses the- -- logical reasoning tool of \"ex falso quodlibet\".- absurd :: Void -> a- absurd a = case a of {}- |])
− src/Data/Singletons/Promote.hs
@@ -1,840 +0,0 @@-{- Data/Singletons/Promote.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--This file contains functions to promote term-level constructs to the-type level. It is an internal module to the singletons package.--}--{-# LANGUAGE TemplateHaskell, MultiWayIf, LambdaCase, TupleSections #-}--module Data.Singletons.Promote where--import Language.Haskell.TH hiding ( Q, cxt )-import Language.Haskell.TH.Syntax ( Quasi(..) )-import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Promote.Monad-import Data.Singletons.Promote.Eq-import Data.Singletons.Promote.Defun-import Data.Singletons.Promote.Type-import Data.Singletons.Deriving.Ord-import Data.Singletons.Deriving.Bounded-import Data.Singletons.Deriving.Enum-import Data.Singletons.Deriving.Show-import Data.Singletons.Deriving.Util-import Data.Singletons.Partition-import Data.Singletons.Util-import Data.Singletons.Syntax-import Prelude hiding (exp)-import Control.Applicative (Alternative(..))-import Control.Arrow (second)-import Control.Monad-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Trans.Maybe-import Control.Monad.Writer-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-import qualified Data.Set as Set-import Data.Set ( Set )-import Data.Maybe-import qualified GHC.LanguageExtensions.Type as LangExt---- | Generate promoted definitions from a type that is already defined.--- This is generally only useful with classes.-genPromotions :: DsMonad q => [Name] -> q [Dec]-genPromotions names = do- checkForRep names- infos <- mapM reifyWithLocals names- dinfos <- mapM dsInfo infos- ddecs <- promoteM_ [] $ mapM_ promoteInfo dinfos- return $ decsToTH ddecs---- | Promote every declaration given to the type level, retaining the originals.-promote :: DsMonad q => q [Dec] -> q [Dec]-promote qdec = do- decls <- qdec- ddecls <- withLocalDeclarations decls $ dsDecs decls- promDecls <- promoteM_ decls $ promoteDecs ddecls- return $ decls ++ decsToTH promDecls---- | Promote each declaration, discarding the originals. Note that a promoted--- datatype uses the same definition as an original datatype, so this will--- not work with datatypes. Classes, instances, and functions are all fine.-promoteOnly :: DsMonad q => q [Dec] -> q [Dec]-promoteOnly qdec = do- decls <- qdec- ddecls <- dsDecs decls- promDecls <- promoteM_ decls $ promoteDecs ddecls- return $ decsToTH promDecls---- | Generate defunctionalization symbols for existing type families.------ 'genDefunSymbols' has reasonable support for type families that use--- dependent quantification. For instance, this:------ @--- type family MyProxy k (a :: k) :: Type where--- MyProxy k (a :: k) = Proxy a------ $('genDefunSymbols' [''MyProxy])--- @------ Will generate the following defunctionalization symbols:------ @--- data MyProxySym0 :: Type ~> k ~> Type--- data MyProxySym1 (k :: Type) :: k ~> Type--- @------ Note that @MyProxySym0@ is a bit more general than it ought to be, since--- there is no dependency between the first kind (@Type@) and the second kind--- (@k@). But this would require the ability to write something like:------ @--- data MyProxySym0 :: forall (k :: Type) ~> k ~> Type--- @------ Which currently isn't possible. So for the time being, the kind of--- @MyProxySym0@ will be slightly more general, which means that under rare--- circumstances, you may have to provide extra type signatures if you write--- code which exploits the dependency in @MyProxy@'s kind.-genDefunSymbols :: DsMonad q => [Name] -> q [Dec]-genDefunSymbols names = do- checkForRep names- infos <- mapM (dsInfo <=< reifyWithLocals) names- decs <- promoteMDecs [] $ concatMapM defunInfo infos- return $ decsToTH decs---- | Produce instances for @(==)@ (type-level equality) from the given types-promoteEqInstances :: DsMonad q => [Name] -> q [Dec]-promoteEqInstances = concatMapM promoteEqInstance---- | Produce instances for 'POrd' from the given types-promoteOrdInstances :: DsMonad q => [Name] -> q [Dec]-promoteOrdInstances = concatMapM promoteOrdInstance---- | Produce an instance for 'POrd' from the given type-promoteOrdInstance :: DsMonad q => Name -> q [Dec]-promoteOrdInstance = promoteInstance mkOrdInstance "Ord"---- | Produce instances for 'PBounded' from the given types-promoteBoundedInstances :: DsMonad q => [Name] -> q [Dec]-promoteBoundedInstances = concatMapM promoteBoundedInstance---- | Produce an instance for 'PBounded' from the given type-promoteBoundedInstance :: DsMonad q => Name -> q [Dec]-promoteBoundedInstance = promoteInstance mkBoundedInstance "Bounded"---- | Produce instances for 'PEnum' from the given types-promoteEnumInstances :: DsMonad q => [Name] -> q [Dec]-promoteEnumInstances = concatMapM promoteEnumInstance---- | Produce an instance for 'PEnum' from the given type-promoteEnumInstance :: DsMonad q => Name -> q [Dec]-promoteEnumInstance = promoteInstance mkEnumInstance "Enum"---- | Produce instances for 'PShow' from the given types-promoteShowInstances :: DsMonad q => [Name] -> q [Dec]-promoteShowInstances = concatMapM promoteShowInstance---- | Produce an instance for 'PShow' from the given type-promoteShowInstance :: DsMonad q => Name -> q [Dec]-promoteShowInstance = promoteInstance mkShowInstance "Show"---- | Produce an instance for @(==)@ (type-level equality) from the given type-promoteEqInstance :: DsMonad q => Name -> q [Dec]-promoteEqInstance name = do- (tvbs, cons) <- getDataD "I cannot make an instance of (==) for it." name- tvbs' <- mapM dsTvb tvbs- let data_ty = foldTypeTvbs (DConT name) tvbs'- cons' <- concatMapM (dsCon tvbs' data_ty) cons- kind <- promoteType (foldTypeTvbs (DConT name) tvbs')- inst_decs <- mkEqTypeInstance kind cons'- return $ decsToTH inst_decs--promoteInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec]-promoteInstance mk_inst class_name name = do- (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ class_name- ++ " for it.") name- tvbs' <- mapM dsTvb tvbs- let data_ty = foldTypeTvbs (DConT name) tvbs'- cons' <- concatMapM (dsCon tvbs' data_ty) cons- let data_decl = DataDecl name tvbs' cons'- raw_inst <- mk_inst Nothing data_ty data_decl- decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst- return $ decsToTH decs--promoteInfo :: DInfo -> PrM ()-promoteInfo (DTyConI dec _instances) = promoteDecs [dec]-promoteInfo (DPrimTyConI _name _numArgs _unlifted) =- fail "Promotion of primitive type constructors not supported"-promoteInfo (DVarI _name _ty _mdec) =- fail "Promotion of individual values not supported"-promoteInfo (DTyVarI _name _ty) =- fail "Promotion of individual type variables not supported"-promoteInfo (DPatSynI {}) =- fail "Promotion of pattern synonyms not supported"---- Note [Promoting declarations in two stages]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ It is necessary to know the types of things when promoting. So,--- we promote in two stages: first, we build a LetDecEnv, which allows--- for easy lookup. Then, we go through the actual elements of the LetDecEnv,--- performing the promotion.------ Why do we need the types? For kind annotations on the type family. We also--- need to have both the types and the actual function definition at the same--- time, because the function definition tells us how many patterns are--- matched. Note that an eta-contracted function needs to return a TyFun,--- not a proper type-level function.------ Consider this example:------ foo :: Nat -> Bool -> Bool--- foo Zero = id--- foo _ = not------ Here the first parameter to foo is non-uniform, because it is--- inspected in a pattern and can be different in each defining--- equation of foo. The second parameter to foo, specified in the type--- signature as Bool, is a uniform parameter - it is not inspected and--- each defining equation of foo uses it the same way. The foo--- function will be promoted to a type familty Foo like this:------ type family Foo (n :: Nat) :: Bool ~> Bool where--- Foo Zero = Id--- Foo a = Not------ To generate type signature for Foo type family we must first learn--- what is the actual number of patterns used in defining cequations--- of foo. In this case there is only one so we declare Foo to take--- one argument and have return type of Bool -> Bool.---- Promote a list of top-level declarations.-promoteDecs :: [DDec] -> PrM ()-promoteDecs raw_decls = do- decls <- expand raw_decls -- expand type synonyms- checkForRepInDecls decls- PDecs { pd_let_decs = let_decs- , pd_class_decs = classes- , pd_instance_decs = insts- , pd_data_decs = datas- , pd_ty_syn_decs = ty_syns- , pd_open_type_family_decs = o_tyfams- , pd_closed_type_family_decs = c_tyfams- , pd_derived_eq_decs = derived_eq_decs } <- partitionDecs decls-- defunTypeDecls ty_syns c_tyfams o_tyfams- -- promoteLetDecs returns LetBinds, which we don't need at top level- _ <- promoteLetDecs noPrefix let_decs- mapM_ promoteClassDec classes- let orig_meth_sigs = foldMap (lde_types . cd_lde) classes- mapM_ (promoteInstanceDec orig_meth_sigs) insts- mapM_ promoteDerivedEqDec derived_eq_decs- promoteDataDecs datas--promoteDataDecs :: [DataDecl] -> PrM ()-promoteDataDecs data_decs = do- rec_selectors <- concatMapM extract_rec_selectors data_decs- _ <- promoteLetDecs noPrefix rec_selectors- mapM_ promoteDataDec data_decs- where- extract_rec_selectors :: DataDecl -> PrM [DLetDec]- extract_rec_selectors (DataDecl data_name tvbs cons) =- let arg_ty = foldTypeTvbs (DConT data_name) tvbs- in- getRecordSelectors arg_ty cons---- curious about ALetDecEnv? See the LetDecEnv module for an explanation.-promoteLetDecs :: (String, String) -- (alpha, symb) prefixes to use- -> [DLetDec] -> PrM ([LetBind], ALetDecEnv)- -- See Note [Promoting declarations in two stages]-promoteLetDecs prefixes decls = do- let_dec_env <- buildLetDecEnv decls- all_locals <- allLocals- let binds = [ (name, foldType (DConT sym) (map DVarT all_locals))- | name <- Map.keys $ lde_defns let_dec_env- , let proName = promoteValNameLhsPrefix prefixes name- sym = promoteTySym proName (length all_locals) ]- (decs, let_dec_env') <- letBind binds $ promoteLetDecEnv prefixes let_dec_env- emitDecs decs- return (binds, let_dec_env' { lde_proms = Map.fromList binds })---- Promotion of data types to kinds is automatic (see "Giving Haskell a--- Promotion" paper for more details). Here we "plug into" the promotion--- mechanism to add some extra stuff to the promotion:------ * if data type derives Eq we generate a type family that implements the--- equality test for the data type.------ * for each data constructor with arity greater than 0 we generate type level--- symbols for use with Apply type family. In this way promoted data--- constructors and promoted functions can be used in a uniform way at the--- type level in the same way they can be used uniformly at the type level.------ * for each nullary data constructor we generate a type synonym-promoteDataDec :: DataDecl -> PrM ()-promoteDataDec (DataDecl _name _tvbs ctors) = do- ctorSyms <- buildDefunSymsDataD ctors- emitDecs ctorSyms---- Note [CUSKification]--- ~~~~~~~~~~~~~~~~~~~~--- GHC #12928 means that sometimes, this TH code will produce a declaration--- that has a kind signature even when we want kind inference to work. There--- seems to be no way to avoid this, so we embrace it:------ * If a class type variable has no explicit kind, we make no effort to--- guess it and default to *. This is OK because before GHC 8.0, we were--- limited by KProxy anyway.------ * If a class type variable has an explicit kind, it is preserved.------ This way, we always get proper CUSKs where we need them.--promoteClassDec :: UClassDecl- -> PrM AClassDecl-promoteClassDec decl@(ClassDecl { cd_cxt = cxt- , cd_name = cls_name- , cd_tvbs = tvbs'- , cd_fds = fundeps- , cd_lde = lde@LetDecEnv- { lde_defns = defaults- , lde_types = meth_sigs- , lde_infix = infix_decls } }) = do- let- -- a workaround for GHC Trac #12928; see Note [CUSKification]- tvbs = map cuskify tvbs'- let pClsName = promoteClassName cls_name- pCxt <- mapM promote_superclass_pred cxt- forallBind cls_kvs_to_bind $ do- sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs)- let defaults_list = Map.toList defaults- defaults_names = map fst defaults_list- (default_decs, ann_rhss, prom_rhss)- <- mapAndUnzip3M (promoteMethod Map.empty Nothing meth_sigs) defaults_list-- let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl)- $ Map.toList infix_decls-- -- no need to do anything to the fundeps. They work as is!- emitDecs [DClassD pCxt pClsName tvbs fundeps- (sig_decs ++ default_decs ++ infix_decls')]- let defaults_list' = zip defaults_names ann_rhss- proms = zip defaults_names prom_rhss- cls_kvs_to_bind' = cls_kvs_to_bind <$ meth_sigs- return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list'- , lde_proms = Map.fromList proms- , lde_bound_kvs = cls_kvs_to_bind' } })- where- cls_kvb_names, cls_tvb_names, cls_kvs_to_bind :: Set Name- cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) tvbs'- cls_tvb_names = Set.fromList $ map extractTvbName tvbs'- cls_kvs_to_bind = cls_kvb_names `Set.union` cls_tvb_names-- promote_sig :: Name -> DType -> PrM DDec- promote_sig name ty = do- let proName = promoteValNameLhs name- (argKs, resK) <- promoteUnraveled ty- args <- mapM (const $ qNewName "arg") argKs- let tvbs = zipWith DKindedTV args argKs- emitDecsM $ defunReifyFixity proName tvbs (Just resK)-- return $ DOpenTypeFamilyD (DTypeFamilyHead proName- tvbs- (DKindSig resK)- Nothing)-- promote_superclass_pred :: DPred -> PrM DPred- promote_superclass_pred = go- where- go (DForallPr {}) = fail "Cannot promote quantified constraints"- go (DAppPr pr ty) = DAppPr <$> go pr <*> promoteType ty- go (DSigPr pr _k) = go pr -- just ignore the kind; it can't matter- go (DVarPr name) = fail $ "Cannot promote ConstraintKinds variables like "- ++ show name- go (DConPr name) = return $ DConPr (promoteClassName name)- go DWildCardPr = return DWildCardPr---- returns (unpromoted method name, ALetDecRHS) pairs-promoteInstanceDec :: Map Name DType -> UInstDecl -> PrM AInstDecl-promoteInstanceDec orig_meth_sigs- decl@(InstDecl { id_name = cls_name- , id_arg_tys = inst_tys- , id_sigs = inst_sigs- , id_meths = meths }) = do- cls_tvb_names <- lookup_cls_tvb_names- inst_kis <- mapM promoteType inst_tys- let kvs_to_bind = foldMap fvDType inst_kis- forallBind kvs_to_bind $ do- let subst = Map.fromList $ zip cls_tvb_names inst_kis- (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod inst_sigs (Just subst) orig_meth_sigs) meths- emitDecs [DInstanceD Nothing [] (foldType (DConT pClsName)- inst_kis) meths']- return (decl { id_meths = zip (map fst meths) ann_rhss })- where- pClsName = promoteClassName cls_name-- lookup_cls_tvb_names :: PrM [Name]- lookup_cls_tvb_names = do- let mk_tvb_names = extract_tvb_names (dsReifyTypeNameInfo pClsName)- <|> extract_tvb_names (dsReifyTypeNameInfo cls_name)- -- See Note [Using dsReifyTypeNameInfo when promoting instances]- mb_tvb_names <- runMaybeT mk_tvb_names- case mb_tvb_names of- Just tvb_names -> pure tvb_names- Nothing -> fail $ "Cannot find class declaration annotation for " ++ show cls_name-- extract_tvb_names :: PrM (Maybe DInfo) -> MaybeT PrM [Name]- extract_tvb_names reify_info = do- mb_info <- lift reify_info- case mb_info of- Just (DTyConI (DClassD _ _ tvbs _ _) _)- -> pure $ map extractTvbName tvbs- _ -> empty--{--Note [Using dsReifyTypeNameInfo when promoting instances]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-During the promotion of a class instance, it becomes necessary to reify the-original promoted class's info to learn various things. It's tempting to think-that just calling dsReify on the class name will be sufficient, but it's not.-Consider this class and its promotion:-- class Eq a where- (==) :: a -> a -> Bool-- class PEq a where- type (==) (x :: a) (y :: a) :: Bool--Notice how both of these classes have an identifier named (==), one at the-value level, and one at the type level. Now imagine what happens when you-attempt to promote this Template Haskell declaration:-- [d| f :: Bool- f = () == () |]--When promoting ==, singletons will come up with its promoted equivalent (which also-happens to be ==). However, this promoted name is a raw Name, since it is created-with mkName. This becomes an issue when we call dsReify the raw "==" Name, as-Template Haskell has to arbitrarily choose between reifying the info for the-value-level (==) and the type-level (==), and in this case, it happens to pick the-value-level (==) info. We want the type-level (==) info, however, because we care-about the promoted version of (==).--Fortunately, there's a serviceable workaround. Instead of dsReify, we can use-dsReifyTypeNameInfo, which first calls lookupTypeName (to ensure we can find a Name-that's in the type namespace) and _then_ reifies it.--}--promoteMethod :: Map Name DType -- InstanceSigs for methods- -> Maybe (Map Name DKind)- -- ^ instantiations for class tyvars (Nothing for default decls)- -- See Note [Promoted class method kinds]- -> Map Name DType -- method types- -> (Name, ULetDecRHS)- -> PrM (DDec, ALetDecRHS, DType)- -- returns (type instance, ALetDecRHS, promoted RHS)-promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do- (meth_arg_kis, meth_res_ki) <- lookup_meth_ty- ((_, _, _, eqns), _defuns, ann_rhs)- <- promoteLetDecRHS (Just (meth_arg_kis, meth_res_ki)) Map.empty Map.empty- noPrefix meth_name meth_rhs- meth_arg_tvs <- mapM (const $ qNewName "a") meth_arg_kis- let helperNameBase = case nameBase proName of- first:_ | not (isHsLetter first) -> "TFHelper"- alpha -> alpha-- -- family_args are the type variables in a promoted class's- -- associated type family instance (or default implementation), e.g.,- --- -- class C k where- -- type T (a :: k) (b :: Bool)- -- type T a b = THelper1 a b -- family_args = [a, b]- --- -- instance C Bool where- -- type T a b = THelper2 a b -- family_args = [a, b]- --- -- We could annotate these variables with explicit kinds, but it's not- -- strictly necessary, as kind inference can figure them out just as well.- family_args = map DVarT meth_arg_tvs- helperName <- newUniqueName helperNameBase- let tvbs = zipWith DKindedTV meth_arg_tvs meth_arg_kis- emitDecs [DClosedTypeFamilyD (DTypeFamilyHead- helperName- tvbs- (DKindSig meth_res_ki)- Nothing)- eqns]- emitDecsM (defunctionalize helperName Nothing tvbs (Just meth_res_ki))- return ( DTySynInstD- proName- (DTySynEqn family_args- (foldApply (promoteValRhs helperName) (map DVarT meth_arg_tvs)))- , ann_rhs- , DConT (promoteTySym helperName 0) )- where- proName = promoteValNameLhs meth_name-- lookup_meth_ty :: PrM ([DKind], DKind)- lookup_meth_ty =- case Map.lookup meth_name inst_sigs_map of- Just ty ->- -- We have an InstanceSig. These are easy: no substitution for clas- -- variables is required at all!- promoteUnraveled ty- Nothing -> do- -- We don't have an InstanceSig, so we must compute the kind to use- -- ourselves (possibly substituting for class variables below).- (arg_kis, res_ki) <-- case Map.lookup meth_name orig_sigs_map of- Nothing -> do- mb_info <- dsReifyTypeNameInfo proName- -- See Note [Using dsReifyTypeNameInfo when promoting instances]- case mb_info of- Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _)- -> let arg_kis = map (default_to_star . extractTvbKind) tvbs- res_ki = default_to_star (resultSigToMaybeKind mb_res_ki)- in return (arg_kis, res_ki)- _ -> fail $ "Cannot find type annotation for " ++ show proName- Just ty -> promoteUnraveled ty- let -- If we're dealing with an associated type family instance, substitute- -- in the kind of the instance for better kind information in the RHS- -- helper function. If we're dealing with a default family implementation- -- (m_subst = Nothing), there's no need for a substitution.- -- See Note [Promoted class method kinds]- do_subst = maybe id substKind m_subst- meth_arg_kis' = map do_subst arg_kis- meth_res_ki' = do_subst res_ki- pure (meth_arg_kis', meth_res_ki')-- default_to_star Nothing = DConT typeKindName- default_to_star (Just k) = k--{--Note [Promoted class method kinds]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider this example of a type class (and instance):-- class C a where- m :: a -> Bool -> Bool- m _ x = x-- instance C [a] where- m l _ = null l--The promoted version of these declarations would be:-- class PC a where- type M (x :: a) (y :: Bool) (z :: Bool)- type M x y z = MHelper1 x y z-- instance PC [a] where- type M x y z = MHelper2 x y z-- type family MHelper1 (x :: a) (y :: Bool) (z :: Bool) where ...- type family MHelper2 (x :: [a]) (y :: Bool) (z :: Bool) where ...--Getting the kind signature for MHelper1 (the promoted default implementation of-M) is quite simple, as it corresponds exactly to the kind of M. We might even-choose to make that the kind of MHelper2, but then it would be overly general-(and more difficult to find in -ddump-splices output). For this reason, we-substitute in the kinds of the instance itself to determine the kinds of-promoted method implementations like MHelper2.--}--promoteLetDecEnv :: (String, String) -> ULetDecEnv -> PrM ([DDec], ALetDecEnv)-promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env- , lde_types = type_env- , lde_infix = fix_env }) = do- let infix_decls = catMaybes $ map (uncurry promoteInfixDecl)- $ Map.toList fix_env-- -- promote all the declarations, producing annotated declarations- let (names, rhss) = unzip $ Map.toList value_env- (payloads, defun_decss, ann_rhss)- <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env fix_env prefixes) names rhss-- emitDecs $ concat defun_decss- bound_kvs <- allBoundKindVars- let decs = map payload_to_dec payloads ++ infix_decls-- -- build the ALetDecEnv- let let_dec_env' = LetDecEnv { lde_defns = Map.fromList $ zip names ann_rhss- , lde_types = type_env- , lde_infix = fix_env- , lde_proms = Map.empty -- filled in promoteLetDecs- , lde_bound_kvs = Map.fromList $ map (, bound_kvs) names }-- return (decs, let_dec_env')- where- payload_to_dec (name, tvbs, m_ki, eqns) = DClosedTypeFamilyD- (DTypeFamilyHead name tvbs sig Nothing)- eqns- where- sig = maybe DNoSig DKindSig m_ki--promoteInfixDecl :: Name -> Fixity -> Maybe DDec-promoteInfixDecl name fixity- | nameBase name == nameBase promoted_name- -- If a name and its promoted counterpart are the same (modulo module- -- prefixes), then there's no need to promote a fixity declaration for- -- that name, since the existing fixity declaration will cover both- -- the term- and type-level versions of that name,- --- -- Names that fall into this category include data constructor names- -- and infix names, with the exceptions of (.) and (!).- -- See Note [Special cases for (.) and (!)] in Data.Singletons.Names.- = Nothing- | otherwise- = Just $ DLetDec $ DInfixD fixity promoted_name- where- promoted_name = promoteValNameLhs name---- This function is used both to promote class method defaults and normal--- let bindings. Thus, it can't quite do all the work locally and returns--- an intermediate structure. Perhaps a better design is available.-promoteLetDecRHS :: Maybe ([DKind], DKind) -- the promoted type of the RHS (if known)- -- needed to fix #136- -> Map Name DType -- local type env't- -> Map Name Fixity -- local fixity env't- -> (String, String) -- let-binding prefixes- -> Name -- name of the thing being promoted- -> ULetDecRHS -- body of the thing- -> PrM ( (Name, [DTyVarBndr], Maybe DKind, [DTySynEqn]) -- "type family"- , [DDec] -- defunctionalization- , ALetDecRHS ) -- annotated RHS-promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UValue exp) = do- (res_kind, num_arrows)- <- case m_rhs_ki of- Just (arg_kis, res_ki) -> return ( Just (ravelTyFun (arg_kis ++ [res_ki]))- , length arg_kis )- _ | Just ty <- Map.lookup name type_env- -> do ki <- promoteType ty- return (Just ki, countArgs ty)- | otherwise- -> return (Nothing, 0)- case num_arrows of- 0 -> do- all_locals <- allLocals- let lde_kvs_to_bind = foldMap fvDType res_kind- (exp', ann_exp) <- forallBind lde_kvs_to_bind $ promoteExp exp- let proName = promoteValNameLhsPrefix prefixes name- m_fixity = Map.lookup name fix_env- tvbs = map DPlainTV all_locals- defuns <- defunctionalize proName m_fixity tvbs res_kind- return ( ( proName, tvbs, res_kind- , [DTySynEqn (map DVarT all_locals) exp'] )- , defuns- , AValue (foldType (DConT proName) (map DVarT all_locals))- num_arrows ann_exp )- _ -> do- names <- replicateM num_arrows (newUniqueName "a")- let pats = map DVarPa names- newArgs = map DVarE names- promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name- (UFunction [DClause pats (foldExp exp newArgs)])--promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction clauses) = do- numArgs <- count_args clauses- (m_argKs, m_resK, ty_num_args) <- case m_rhs_ki of- Just (arg_kis, res_ki) -> return (map Just arg_kis, Just res_ki, length arg_kis)- _ | Just ty <- Map.lookup name type_env- -> do- -- promoteType turns arrows into TyFun. So, we unravel first to- -- avoid this behavior. Note the use of ravelTyFun in resultK- -- to make the return kind work out- (argKs, resultK) <- promoteUnraveled ty- -- invariant: countArgs ty == length argKs- return (map Just argKs, Just resultK, length argKs)-- | otherwise- -> return (replicate numArgs Nothing, Nothing, numArgs)- let proName = promoteValNameLhsPrefix prefixes name- m_fixity = Map.lookup name fix_env- all_locals <- allLocals- let local_tvbs = map DPlainTV all_locals- tyvarNames <- mapM (const $ qNewName "a") m_argKs- let args = zipWith inferMaybeKindTV tyvarNames m_argKs- all_args = local_tvbs ++ args- defun_decs <- defunctionalize proName m_fixity all_args m_resK- expClauses <- mapM (etaContractOrExpand ty_num_args numArgs) clauses- let lde_kvs_to_bind = foldMap (foldMap fvDType) m_argKs <> foldMap fvDType m_resK- (eqns, ann_clauses) <- forallBind lde_kvs_to_bind $- mapAndUnzipM promoteClause expClauses- prom_fun <- lookupVarE name- return ( (proName, all_args, m_resK, eqns)- , defun_decs- , AFunction prom_fun ty_num_args ann_clauses )-- where- etaContractOrExpand :: Int -> Int -> DClause -> PrM DClause- etaContractOrExpand ty_num_args clause_num_args (DClause pats exp)- | n >= 0 = do -- Eta-expand- names <- replicateM n (newUniqueName "a")- let newPats = map DVarPa names- newArgs = map DVarE names- return $ DClause (pats ++ newPats) (foldExp exp newArgs)- | otherwise = do -- Eta-contract- let (clausePats, lamPats) = splitAt ty_num_args pats- lamExp <- mkDLamEFromDPats lamPats exp- return $ DClause clausePats lamExp- where- n = ty_num_args - clause_num_args-- count_args (DClause pats _ : _) = return $ length pats- count_args _ = fail $ "Impossible! A function without clauses."--promoteClause :: DClause -> PrM (DTySynEqn, ADClause)-promoteClause (DClause pats exp) = do- -- promoting the patterns creates variable bindings. These are passed- -- to the function promoted the RHS- ((types, pats'), prom_pat_infos) <- evalForPair $ mapAndUnzipM promotePat pats- let PromDPatInfos { prom_dpat_vars = new_vars- , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos- (ty, ann_exp) <- forallBind sig_kvs $- lambdaBind new_vars $- promoteExp exp- all_locals <- allLocals -- these are bound *outside* of this clause- return ( DTySynEqn (map DVarT all_locals ++ types) ty- , ADClause new_vars pats' ann_exp )--promoteMatch :: DMatch -> PrM (DTySynEqn, ADMatch)-promoteMatch (DMatch pat exp) = do- -- promoting the patterns creates variable bindings. These are passed- -- to the function promoted the RHS- ((ty, pat'), prom_pat_infos) <- evalForPair $ promotePat pat- let PromDPatInfos { prom_dpat_vars = new_vars- , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos- (rhs, ann_exp) <- forallBind sig_kvs $- lambdaBind new_vars $- promoteExp exp- all_locals <- allLocals- return $ ( DTySynEqn (map DVarT all_locals ++ [ty]) rhs- , ADMatch new_vars pat' ann_exp)---- promotes a term pattern into a type pattern, accumulating bound variable names-promotePat :: DPat -> QWithAux PromDPatInfos PrM (DType, ADPat)-promotePat (DLitPa lit) = (, ADLitPa lit) <$> promoteLitPat lit-promotePat (DVarPa name) = do- -- term vars can be symbols... type vars can't!- tyName <- mkTyName name- tell $ PromDPatInfos [(name, tyName)] Set.empty- return (DVarT tyName, ADVarPa name)-promotePat (DConPa name pats) = do- (types, pats') <- mapAndUnzipM promotePat pats- let name' = unboxed_tuple_to_tuple name- return (foldType (DConT name') types, ADConPa name pats')- where- unboxed_tuple_to_tuple n- | Just deg <- unboxedTupleNameDegree_maybe n = tupleDataName deg- | otherwise = n-promotePat (DTildePa pat) = do- qReportWarning "Lazy pattern converted into regular pattern in promotion"- second ADTildePa <$> promotePat pat-promotePat (DBangPa pat) = do- qReportWarning "Strict pattern converted into regular pattern in promotion"- second ADBangPa <$> promotePat pat-promotePat (DSigPa pat ty) = do- -- We must maintain the invariant that any promoted pattern signature must- -- not have any wildcards in the underlying pattern.- -- See Note [Singling pattern signatures].- wildless_pat <- removeWilds pat- (promoted, pat') <- promotePat wildless_pat- ki <- promoteType ty- tell $ PromDPatInfos [] (fvDType ki)- return (DSigT promoted ki, ADSigPa promoted pat' ki)-promotePat DWildPa = return (DWildCardT, ADWildPa)--promoteExp :: DExp -> PrM (DType, ADExp)-promoteExp (DVarE name) = fmap (, ADVarE name) $ lookupVarE name-promoteExp (DConE name) = return $ (promoteValRhs name, ADConE name)-promoteExp (DLitE lit) = fmap (, ADLitE lit) $ promoteLitExp lit-promoteExp (DAppE exp1 exp2) = do- (exp1', ann_exp1) <- promoteExp exp1- (exp2', ann_exp2) <- promoteExp exp2- return (apply exp1' exp2', ADAppE ann_exp1 ann_exp2)--- Until we get visible kind applications, this is the best we can do.-promoteExp (DAppTypeE exp _) = do- qReportWarning "Visible type applications are ignored by `singletons`."- promoteExp exp-promoteExp (DLamE names exp) = do- lambdaName <- newUniqueName "Lambda"- tyNames <- mapM mkTyName names- let var_proms = zip names tyNames- (rhs, ann_exp) <- lambdaBind var_proms $ promoteExp exp- tyFamLamTypes <- mapM (const $ qNewName "t") names- all_locals <- allLocals- let all_args = all_locals ++ tyFamLamTypes- tvbs = map DPlainTV all_args- emitDecs [DClosedTypeFamilyD (DTypeFamilyHead- lambdaName- tvbs- DNoSig- Nothing)- [DTySynEqn (map DVarT (all_locals ++ tyNames))- rhs]]- emitDecsM $ defunctionalize lambdaName Nothing tvbs Nothing- let promLambda = foldl apply (DConT (promoteTySym lambdaName 0))- (map DVarT all_locals)- return (promLambda, ADLamE tyNames promLambda names ann_exp)-promoteExp (DCaseE exp matches) = do- caseTFName <- newUniqueName "Case"- all_locals <- allLocals- let prom_case = foldType (DConT caseTFName) (map DVarT all_locals)- (exp', ann_exp) <- promoteExp exp- (eqns, ann_matches) <- mapAndUnzipM promoteMatch matches- tyvarName <- qNewName "t"- let all_args = all_locals ++ [tyvarName]- tvbs = map DPlainTV all_args- emitDecs [DClosedTypeFamilyD (DTypeFamilyHead caseTFName tvbs DNoSig Nothing) eqns]- -- See Note [Annotate case return type] in Single- let applied_case = prom_case `DAppT` exp'- return ( applied_case- , ADCaseE ann_exp ann_matches applied_case )-promoteExp (DLetE decs exp) = do- unique <- qNewUnique- let letPrefixes = uniquePrefixes "Let" "<<<" unique- (binds, ann_env) <- promoteLetDecs letPrefixes decs- (exp', ann_exp) <- letBind binds $ promoteExp exp- return (exp', ADLetE ann_env ann_exp)-promoteExp (DSigE exp ty) = do- (exp', ann_exp) <- promoteExp exp- ty' <- promoteType ty- return (DSigT exp' ty', ADSigE exp' ann_exp ty)-promoteExp e@(DStaticE _) = fail ("Static expressions cannot be promoted: " ++ show e)--promoteLitExp :: Quasi q => Lit -> q DType-promoteLitExp (IntegerL n)- | n >= 0 = return $ (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit n))- | otherwise = return $ (DConT tyNegateName `DAppT`- (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit (-n))))-promoteLitExp (StringL str) = do- let prom_str_lit = DLitT (StrTyLit str)- os_enabled <- qIsExtEnabled LangExt.OverloadedStrings- pure $ if os_enabled- then DConT tyFromStringName `DAppT` prom_str_lit- else prom_str_lit-promoteLitExp lit =- fail ("Only string and natural number literals can be promoted: " ++ show lit)--promoteLitPat :: Monad m => Lit -> m DType-promoteLitPat (IntegerL n)- | n >= 0 = return $ (DLitT (NumTyLit n))- | otherwise =- fail $ "Negative literal patterns are not allowed,\n" ++- "because literal patterns are promoted to natural numbers."-promoteLitPat (StringL str) = return $ DLitT (StrTyLit str)-promoteLitPat lit =- fail ("Only string and natural number literals can be promoted: " ++ show lit)---- See Note [DerivedDecl]-promoteDerivedEqDec :: DerivedEqDecl -> PrM ()-promoteDerivedEqDec (DerivedDecl { ded_type = ty- , ded_decl = DataDecl _ _ cons }) = do- kind <- promoteType ty- inst_decs <- mkEqTypeInstance kind cons- emitDecs inst_decs
− src/Data/Singletons/Promote/Defun.hs
@@ -1,532 +0,0 @@-{- Data/Singletons/Promote/Defun.hs--(c) Richard Eisenberg, Jan Stolarek 2014-rae@cs.brynmawr.edu--This file creates defunctionalization symbols for types during promotion.--}--{-# LANGUAGE TemplateHaskell #-}--module Data.Singletons.Promote.Defun where--import Language.Haskell.TH.Desugar-import Data.Singletons.Promote.Monad-import Data.Singletons.Promote.Type-import Data.Singletons.Names-import Language.Haskell.TH.Syntax-import Data.Singletons.Syntax-import Data.Singletons.Util-import Control.Monad-import qualified Data.Map.Strict as Map-import Data.Map.Strict (Map)-import Data.Maybe-import qualified Data.Set as Set--defunInfo :: DInfo -> PrM [DDec]-defunInfo (DTyConI dec _instances) = buildDefunSyms dec-defunInfo (DPrimTyConI _name _numArgs _unlifted) =- fail $ "Building defunctionalization symbols of primitive " ++- "type constructors not supported"-defunInfo (DVarI _name _ty _mdec) =- fail "Building defunctionalization symbols of values not supported"-defunInfo (DTyVarI _name _ty) =- fail "Building defunctionalization symbols of type variables not supported"-defunInfo (DPatSynI {}) =- fail "Building defunctionalization symbols of pattern synonyms not supported"--defunTypeDecls :: [TySynDecl]- -> [ClosedTypeFamilyDecl]- -> [OpenTypeFamilyDecl]- -> PrM ()-defunTypeDecls ty_syns c_tyfams o_tyfams = do- defun_ty_syns <-- concatMapM (\(TySynDecl name tvbs) -> buildDefunSymsTySynD name tvbs) ty_syns- defun_c_tyfams <-- concatMapM (buildDefunSymsClosedTypeFamilyD . getTypeFamilyDecl) c_tyfams- defun_o_tyfams <-- concatMapM (buildDefunSymsOpenTypeFamilyD . getTypeFamilyDecl) o_tyfams- emitDecs $ defun_ty_syns ++ defun_c_tyfams ++ defun_o_tyfams--buildDefunSyms :: DDec -> PrM [DDec]-buildDefunSyms (DDataD _new_or_data _cxt _tyName _tvbs _k ctors _derivings) =- buildDefunSymsDataD ctors-buildDefunSyms (DClosedTypeFamilyD tf_head _) =- buildDefunSymsClosedTypeFamilyD tf_head-buildDefunSyms (DOpenTypeFamilyD tf_head) =- buildDefunSymsOpenTypeFamilyD tf_head-buildDefunSyms (DTySynD name tvbs _type) =- buildDefunSymsTySynD name tvbs-buildDefunSyms (DClassD _cxt name tvbs _fundeps _members) = do- defunReifyFixity name tvbs (Just (DConT constraintName))-buildDefunSyms _ = fail $ "Defunctionalization symbols can only be built for " ++- "type families and data declarations"--buildDefunSymsClosedTypeFamilyD :: DTypeFamilyHead -> PrM [DDec]-buildDefunSymsClosedTypeFamilyD = buildDefunSymsTypeFamilyHead id id--buildDefunSymsOpenTypeFamilyD :: DTypeFamilyHead -> PrM [DDec]-buildDefunSymsOpenTypeFamilyD = buildDefunSymsTypeFamilyHead cuskify default_to_star- where- default_to_star :: Maybe DKind -> Maybe DKind- default_to_star Nothing = Just $ DConT typeKindName- default_to_star (Just k) = Just k--buildDefunSymsTypeFamilyHead- :: (DTyVarBndr -> DTyVarBndr)- -> (Maybe DKind -> Maybe DKind)- -> DTypeFamilyHead -> PrM [DDec]-buildDefunSymsTypeFamilyHead default_tvb default_kind- (DTypeFamilyHead name tvbs result_sig _) = do- let arg_tvbs = map default_tvb tvbs- res_kind = default_kind (resultSigToMaybeKind result_sig)- defunReifyFixity name arg_tvbs res_kind--buildDefunSymsTySynD :: Name -> [DTyVarBndr] -> PrM [DDec]-buildDefunSymsTySynD name tvbs =- defunReifyFixity name tvbs Nothing--buildDefunSymsDataD :: [DCon] -> PrM [DDec]-buildDefunSymsDataD ctors =- concatMapM promoteCtor ctors- where- promoteCtor :: DCon -> PrM [DDec]- promoteCtor ctor@(DCon _ _ _ _ res_ty) = do- let (name, arg_tys) = extractNameTypes ctor- tvb_names <- replicateM (length arg_tys) $ qNewName "t"- arg_kis <- mapM promoteType arg_tys- let arg_tvbs = zipWith DKindedTV tvb_names arg_kis- res_ki <- promoteType res_ty- defunReifyFixity name arg_tvbs (Just res_ki)---- Generate defunctionalization symbols for a name, using reifyFixityWithLocals--- to determine what the fixity of each symbol should be.--- See Note [Fixity declarations for defunctionalization symbols]-defunReifyFixity :: Name -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec]-defunReifyFixity name tvbs m_res_kind = do- m_fixity <- reifyFixityWithLocals name- defunctionalize name m_fixity tvbs m_res_kind---- Generate data declarations and apply instances--- required for defunctionalization.--- For a type family:------ type family Foo (m :: Nat) (n :: Nat) (l :: Nat) :: Nat------ we generate data declarations that allow us to talk about partial--- application at the type level:------ type FooSym3 a b c = Foo a b c--- data FooSym2 a b f where--- FooSym2KindInference :: SameKind (Apply (FooSym2 a b) arg) (FooSym3 a b arg)--- => FooSym2 a b f--- type instance Apply (FooSym2 a b) c = FooSym3 a b c--- data FooSym1 a f where--- FooSym1KindInference :: SameKind (Apply (FooSym1 a) arg) (FooSym2 a arg)--- => FooSym1 a f--- type instance Apply (FooSym1 a) b = FooSym2 a b--- data FooSym0 f where--- FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg)--- => FooSym0 f--- type instance Apply FooSym0 a = FooSym1 a------ What's up with all the "KindInference" stuff? In some scenarios, we don't--- know the kinds that we should be using in these symbols. But, GHC can figure--- it out using the types of the "KindInference" dummy data constructors. A--- bit of a hack, but it works quite nicely. The only problem is that GHC will--- warn about an unused data constructor. So, we use the data constructor in--- an instance of a dummy class. (See Data.Singletons.SuppressUnusedWarnings--- for the class, which should never be seen by anyone, ever.)------ The defunctionalize function takes Maybe DKinds so that the caller can--- indicate which kinds are known and which need to be inferred.------ See also Note [Defunctionalization and dependent quantification]-defunctionalize :: Name- -> Maybe Fixity -- The name's fixity, if one was declared.- -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec]-defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do- (m_arg_tvbs, m_res_kind) <- eta_expand (noExactTyVars m_arg_tvbs')- (noExactTyVars m_res_kind')-- let -- Implements part (2)(i) from Note [Defunctionalization and dependent quantification]- tvb_to_type_map :: Map Name DType- tvb_to_type_map = Map.fromList $ -- (2)(i)(c)- map (\tvb -> (extractTvbName tvb, dTyVarBndrToDType tvb)) $- toposortTyVarsOf $ -- (2)(i)(b)- map dTyVarBndrToDType m_arg_tvbs- ++ maybeToList m_res_kind -- (2)(i)(a)-- go :: Int -> [DTyVarBndr] -> Maybe DKind- -> ([DTyVarBndr] -> DType) -- given the argument tyvar binders,- -- produce the RHS of the Apply instance- -> PrM [DDec]- go _ [] _ _ = return []- go n (m_arg : m_args) m_result mk_rhs = do- extra_name <- qNewName "arg"- let tyfun_name = extractTvbName m_arg- data_name = promoteTySym name n- next_name = promoteTySym name (n+1)- con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name- m_tyfun = buildTyFunArrow_maybe (extractTvbKind m_arg) m_result- arg_params = -- Implements part (2)(ii) from- -- Note [Defunctionalization and dependent quantification]- map (map_tvb_kind (substType tvb_to_type_map)) $- reverse m_args- tyfun_param = mk_tvb tyfun_name m_tyfun- arg_names = map extractTvbName arg_params- params = arg_params ++ [tyfun_param]- con_eq_ct = DConPr sameKindName `DAppPr` lhs `DAppPr` rhs- where- lhs = foldType (DConT data_name) (map DVarT arg_names) `apply` (DVarT extra_name)- rhs = foldType (DConT next_name) (map DVarT (arg_names ++ [extra_name]))- con_decl = DCon (map dropTvbKind params ++ [DPlainTV extra_name])- [con_eq_ct]- con_name- (DNormalC False [])- (foldTypeTvbs (DConT data_name) params)- data_decl = DDataD Data [] data_name args res_ki [con_decl] []- where- (args, res_ki)- = case m_tyfun of- Nothing -> (params, Nothing)- -- If we cannot infer the return type, don't bother- -- trying to construct an explicit return kind.- Just tyfun ->- let bound_tvs = Set.fromList (map extractTvbName arg_params) `Set.union`- foldMap (foldMap fvDType) (map extractTvbKind arg_params)- not_bound tvb = not (extractTvbName tvb `Set.member` bound_tvs)- tvb_to_type tvb_name = fromMaybe (DVarT tvb_name) $- Map.lookup tvb_name tvb_to_type_map- -- Implements part (2)(iii) from- -- Note [Defunctionalization and dependent quantification]- tyfun_tvbs = filter not_bound $ -- (2)(iii)(d)- toposortTyVarsOf $ -- (2)(iii)(c)- map tvb_to_type $ -- (2)(iii)(b)- Set.toList $ fvDType tyfun -- (2)(iii)(a)- in (arg_params, Just (DForallT tyfun_tvbs [] tyfun))- app_data_ty = foldTypeTvbs (DConT data_name) m_args- app_eqn = DTySynEqn [app_data_ty, DVarT tyfun_name]- (mk_rhs (m_args ++ [DPlainTV tyfun_name]))- app_decl = DTySynInstD applyName app_eqn- suppress = DInstanceD Nothing []- (DConT suppressClassName `DAppT` app_data_ty)- [DLetDec $ DFunD suppressMethodName- [DClause []- ((DVarE 'snd) `DAppE`- mkTupleDExp [DConE con_name,- mkTupleDExp []])]]-- mk_rhs' = foldTypeTvbs (DConT data_name)-- -- See Note [Fixity declarations for defunctionalization symbols]- mk_fix_decl f = DLetDec $ DInfixD f data_name- fixity_decl = maybeToList $ fmap mk_fix_decl m_fixity-- decls <- go (n - 1) m_args m_tyfun mk_rhs'- return $ suppress : data_decl : app_decl : fixity_decl ++ decls-- let num_args = length m_arg_tvbs- sat_name = promoteTySym name num_args- mk_rhs = foldTypeTvbs (DConT name)- sat_dec = DTySynD sat_name m_arg_tvbs (mk_rhs m_arg_tvbs)-- other_decs <- go (num_args - 1) (reverse m_arg_tvbs) m_res_kind mk_rhs- return $ sat_dec : other_decs- where- mk_tvb :: Name -> Maybe DKind -> DTyVarBndr- mk_tvb tvb_name Nothing = DPlainTV tvb_name- mk_tvb tvb_name (Just k) = DKindedTV tvb_name k-- eta_expand :: [DTyVarBndr] -> Maybe DKind -> PrM ([DTyVarBndr], Maybe DKind)- eta_expand m_arg_tvbs Nothing = pure (m_arg_tvbs, Nothing)- eta_expand m_arg_tvbs (Just res_kind) = do- let (_, _, argKs, resultK) = unravel res_kind- tvb_names <- replicateM (length argKs) $ qNewName "e"- let res_kind_arg_tvbs = zipWith DKindedTV tvb_names argKs- pure (m_arg_tvbs ++ res_kind_arg_tvbs, Just resultK)-- map_tvb_kind :: (DKind -> DKind) -> DTyVarBndr -> DTyVarBndr- map_tvb_kind _ tvb@DPlainTV{} = tvb- map_tvb_kind f (DKindedTV n k) = DKindedTV n (f k)--{--Note [Defunctionalization and dependent quantification]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The machinery in this module supports defunctionalizing types that use-dependent quantification, such as in the following example:-- type family Symmetry (a :: Proxy t) (y :: Proxy t)- (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where- Symmetry a y _ = y :~: a--Here is what is involved in making this happen:--1. When defunctionalizing, we must not only know the argument kinds, but rather- the argument *kind variable binders*. This is essential since, for instance,- Symmetry dependently quantifies `a` and `y` and uses them in the kind of- `e`. If we did not track the original kind variable names, then instead of- generating this defunctionalization symbol for Symmetry:-- data SymmetrySym2 (a :: Proxy t) (y :: Proxy t) :: (a :~: y) ~> Type-- We would generate something more general, like this:-- data SymmetrySym2 (abc1 :: Proxy t) (abc2 :: Proxy t) :: (a :~: y) ~> Type-- Alas, there are times where will have no choice but to write a slightly- more general kind than we should. For instance, consider this:-- data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type-- This defunctionalization symbol doesn't capture the dependent quantification- in the first and second argument kinds. But in order to do that properly,- you'd need the ability to write something like:-- data SymmetrySym0 :: forall (a :: Proxy t) ~> forall (y :: Proxy t)- ~> (a :~: y) ~> Type-- It is my (RGS's) belief that it is not possible to achieve something like- this in today's GHC (see #304), so we'll just have to live with SymmetrySym0- being slightly more general than it ought to be. In practice, this is- unlikely to bite unless you're writing code that specifically exploits this- dependency in just the right way.--2. I pulled a fast one earlier by writing:-- data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type-- GHC will actually reject this, because it does not have a CUSK. There are- two glaring problems here:-- (a) The kind of `t` is underdetermined.- (b) `a` and `y` should have kind `Proxy t`, but this is not currently the case.-- Ultimately, the fix is to use explicit kind signatures. A naïve attempt- would be something like this:-- data SymmetrySym0 :: Proxy (t :: (k :: Type)) ~> Proxy (t :: (k :: Type))- ~> ((a :: Proxy (t :: (k :: Type))) :~: (y :: Proxy (t :: (k :: Type))))- ~> Type-- While that works, it adds a nontrivial amount of clutter. Plus, it requires- figuring out (in Template Haskell) which variables have underdetermined- kinds and substituting for them. Blegh. A much cleaner approach is:-- data SymmetrySym0 :: forall (k :: Type) (t :: k) (a :: Proxy t) (y :: Proxy t).- Proxy t ~> Proxy t ~> (a :~: y) ~> Type-- This time, all we have to do is put an explicit `forall` in front, and we- achieve a CUSK without having to muck up the body of return kind. It also- has the benefit of looking much nicer in generated code.-- Let's talk about how to achieve this feat, using SymmetrySym1 as the- guiding example:-- (i) Before we begin defunctionalizing a type, we construct a mapping from- variable names to their corresponding types, complete with kinds.- For instance, in Symmetry, we would have the following map:-- { k :-> DVarT k -- k- , t :-> DSigT (DVarT t) (DVarT k) -- (t :: k)- , a :-> DSigT (DVarT a) (DConT ''Proxy `DAppT` DVarT t) -- (a :: Proxy t)- , y :-> DSigT (DVarT y) (DConT ''Proxy `DAppT` DVarT y) -- (y :: Proxy t)- , e :-> DSigT (DVarT e) (DConT ''(:~:)- `DAppT` DSigT (DVarT a) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k))- `DAppT` DSigT (DVarT y) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k)))- -- (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- }-- Why do this? Because when constructing the `forall` in the return kind- of a defunctionalization symbol, it's convenient to be able to know- the kinds of everything being bound at a glance. It's not always- possible to recover the kinds of every variable (for instance, if- we're just given `Proxy t ~> Proxy t ~> (a :~: y) ~> Type`), so having- this information is handy.-- To construct this map, we:-- (a) Grab the list of type variable binders (this is given as an input- to defunctionalize, as discussed in part (1)) and turn it into a list- of types. Also include the return kind (if there is one) in this- list, as it may also mention type variables with explicit kinds.- (b) Construct a flat list of all type variables mentioned in this list.- This may involve looking in the kinds of type variables binders.- (Note that this part is crucial—the the Singletons/PolyKinds test- will fail to compile without it!)- (c) Take the flat list and insert each variable into the map by- mapping its name to its type (as demonstrated above).-- To continue the Symmetry example:-- (a) We grab the list of type variable binders-- [ (a :: Proxy t)- , (y :: Proxy t)- , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- ]-- from the Symmetry declaration. Including the return kind (Type),- we get:-- [ (a :: Proxy t)- , (y :: Proxy t)- , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- , Type- ]-- (b) We flatten this into a list of well scoped type variables:-- [ k- , (t :: k)- , (a :: Proxy t)- , (y :: Proxy t)- , (e :: (a :: Proxy (t :: k)) :~: (y :~: Proxy (t :: k)))- ]-- (c) From this, we construct the map shown at the beginning of (i).-- (ii) Using the map, we will annotate any kind variables in the LHS of the- declaration with their respective kinds. In this example, the LHS is:-- data SymmetrySym1 (a :: Proxy t) :: ...-- Since `t` maps to simply `(t :: k)` in the map, the LHS becomes:-- data SymmetrySym1 (a :: Proxy (t :: k)) :: ...-- Why do this? Because we need to make it apparent that `k` is bound on- the LHS. If we don't, we might end up trying to quantify `k` in the- return kind (see #353 for an example of what goes wrong if you try to- do this).-- Having to explicitly annotate each occurrence of every kind variable on- the LHS like this is a bit tiresome, especially since we don't have to- do this in the return kind. If GHC had syntax for visible dependent- quantification, we could avoid this step entirely and simply write:-- data SymmetrySym1 :: forall k (t :: k). forall (a :: Proxy t) -> ...-- Until GHC gains this syntax, this is the best alternative.-- (iii) When constructing each defunctionalization symbol, we will end up with- some remaining type variable binders and a return kind. For instance:-- data SymmetrySym1 (a :: Proxy (t :: k))- :: forall ???. Proxy t- ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- ~> Type-- We must fill in the ??? part. Here is how we do so:-- (a) Collect all of the type variables mentioned in the return kind.- (b) Look up each type variable's corresponding type in the map (from- part (i)) to learn as much kind information as possible.- (c) Perform a reverse topological sort on these types to put the- types (and kind) variables in proper dependency order.- (d) Filter out any variables that are already bound by the type- variable binders that precede the return kind.-- After doing these steps, what remains goes in place of ???. Let's- explain this with the example above:-- data SymmetrySym1 (a :: Proxy (t :: k))- :: forall ???. Proxy t- ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- ~> Type-- (a) [t, a, k, y]- (b) [(t :: k), (a :: Proxy t), k, (y :: Proxy t)]- (c) [k, (t :: k), (a :: Proxy t), (y :: Proxy t)]- (d) [(y :: Proxy t)] (`k`, `t` and `a` were already bound)-- Therefore, we end up with:-- data SymmetrySym1 (a :: Proxy (t :: k))- :: forall (y :: Proxy t).- Proxy t- ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k)))- ~> Type--}---- This is a small function with large importance. When generating--- defunctionalization data types, we often need to fill in the blank in the--- sort of code exemplified below:------ @--- data FooSym2 a (b :: x) (c :: TyFun y z) where--- FooSym2KindInference :: _--- @------ Where the kind of @a@ is not known. It's extremely tempting to just--- copy-and-paste the type variable binders from the data type itself to the--- constructor, like so:------ @--- data FooSym2 a (b :: x) (c :: TyFun y z) where--- FooSym2KindInference :: forall a (b :: x) (c :: TyFun y z).--- SameKind (...) (...).--- FooSym2KindInference a b c--- @------ But this ends up being an untenable approach. Because @a@ lacks a kind--- signature, @FooSym2@ does not have a complete, user-specified kind signature--- (or CUSK), so GHC will fail to typecheck @FooSym2KindInference@.------ Thankfully, there's a workaround—just don't give any of the constructor's--- type variable binders any kinds:------ @--- data FooSym2 a (b :: x) (c :: TyFun y z) where--- FooSym2KindInference :: forall a b c--- SameKind (...) (...).--- FooSym2KindInference a b c--- @------ GHC may be moody when it comes to CUSKs, but it's at least understanding--- enough to typecheck this without issue. The 'dropTvbKind' function is--- what removes the kinds used in the kind inference constructor.-dropTvbKind :: DTyVarBndr -> DTyVarBndr-dropTvbKind tvb@(DPlainTV {}) = tvb-dropTvbKind (DKindedTV n _) = DPlainTV n---- Shorthand for building (k1 ~> k2)-buildTyFunArrow :: DKind -> DKind -> DKind-buildTyFunArrow k1 k2 = DConT tyFunArrowName `DAppT` k1 `DAppT` k2--buildTyFunArrow_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind-buildTyFunArrow_maybe m_k1 m_k2 = do- k1 <- m_k1- k2 <- m_k2- return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2---- Build (~>) kind from the list of kinds-ravelTyFun :: [DKind] -> DKind-ravelTyFun [] = error "Internal error: TyFun raveling nil"-ravelTyFun [k] = k-ravelTyFun kinds = go tailK (buildTyFunArrow k2 k1)- where (k1 : k2 : tailK) = reverse kinds- go [] acc = acc- go (k:ks) acc = go ks (buildTyFunArrow k acc)--{--Note [Fixity declarations for defunctionalization symbols]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Just like we promote fixity declarations, we should also generate fixity-declarations for defunctionaliztion symbols. A primary use case is the-following scenario:-- (.) :: (b -> c) -> (a -> b) -> (a -> c)- (f . g) x = f (g x)- infixr 9 .--One often writes (f . g . h) at the value level, but because (.) is promoted-to a type family with three arguments, this doesn't directly translate to the-type level. Instead, one must write this:-- f .@#@$$$ g .@#@$$$ h--But in order to ensure that this associates to the right as expected, one must-generate an `infixr 9 .@#@#$$$` declaration. This is why defunctionalize accepts-a Maybe Fixity argument.--}
− src/Data/Singletons/Promote/Eq.hs
@@ -1,70 +0,0 @@-{- Data/Singletons/Promote/Eq.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--This module defines the functions that generate type-level equality type-family instances.--}--module Data.Singletons.Promote.Eq where--import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Util-import Control.Monad---- produce a closed type family helper and the instance--- for (==) over the given list of ctors-mkEqTypeInstance :: Quasi q => DKind -> [DCon] -> q [DDec]-mkEqTypeInstance kind cons = do- helperName <- newUniqueName "Equals"- aName <- qNewName "a"- bName <- qNewName "b"- true_branches <- mapM mk_branch cons- let null_branch = catch_all_case trueName- false_branch = catch_all_case falseName- branches | null cons = [null_branch]- | otherwise = true_branches ++ [false_branch]- closedFam = DClosedTypeFamilyD (DTypeFamilyHead helperName- -- We opt to give explicit kinds for the tyvars- -- in the helper type family.- -- See Note [Promoted class method kinds]- -- in Data.Singletons.Promote.- [ DKindedTV aName kind- , DKindedTV bName kind ]- (DKindSig boolKi)- Nothing)- branches- eqInst = DTySynInstD tyEqName (DTySynEqn [DVarT aName, DVarT bName]- (foldType (DConT helperName)- [DVarT aName, DVarT bName]))- inst = DInstanceD Nothing [] ((DConT $ promoteClassName eqName) `DAppT`- kind) [eqInst]-- return [closedFam, inst]-- where mk_branch :: Quasi q => DCon -> q DTySynEqn- mk_branch con = do- let (name, numArgs) = extractNameArgs con- lnames <- replicateM numArgs (qNewName "a")- rnames <- replicateM numArgs (qNewName "b")- let lvars = map DVarT lnames- rvars = map DVarT rnames- ltype = foldType (DConT name) lvars- rtype = foldType (DConT name) rvars- results = zipWith (\l r -> foldType (DConT tyEqName) [l, r]) lvars rvars- result = tyAll results- return $ DTySynEqn [ltype, rtype] result-- catch_all_case :: Name -> DTySynEqn- catch_all_case returned_val_name =- DTySynEqn [DSigT DWildCardT kind, DSigT DWildCardT kind]- (promoteValRhs returned_val_name)-- tyAll :: [DType] -> DType -- "all" at the type level- tyAll [] = (promoteValRhs trueName)- tyAll [one] = one- tyAll (h:t) = foldType (DConT $ promoteValNameLhs andName) [h, (tyAll t)]- -- I could use the Apply nonsense here, but there's no reason to
− src/Data/Singletons/Promote/Monad.hs
@@ -1,188 +0,0 @@-{- Data/Singletons/Promote/Monad.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--This file defines the PrM monad and its operations, for use during promotion.--The PrM monad allows reading from a PrEnv environment and writing to a list-of DDec, and is wrapped around a Q.--}--{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving,- FlexibleContexts, TypeFamilies, KindSignatures #-}--module Data.Singletons.Promote.Monad (- PrM, promoteM, promoteM_, promoteMDecs, VarPromotions,- allLocals, emitDecs, emitDecsM,- lambdaBind, LetBind, letBind, lookupVarE, forallBind, allBoundKindVars- ) where--import Control.Monad.Reader-import Control.Monad.Writer-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-import qualified Data.Set as Set-import Data.Set ( Set )-import Language.Haskell.TH.Syntax hiding ( lift )-import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Syntax-import Control.Monad.Fail ( MonadFail )--type LetExpansions = Map Name DType -- from **term-level** name---- environment during promotion-data PrEnv =- PrEnv { pr_lambda_bound :: Map Name Name- , pr_let_bound :: LetExpansions- , pr_forall_bound :: Set Name -- See Note [Explicitly quantifying kinds variables]- , pr_local_decls :: [Dec]- }--emptyPrEnv :: PrEnv-emptyPrEnv = PrEnv { pr_lambda_bound = Map.empty- , pr_let_bound = Map.empty- , pr_forall_bound = Set.empty- , pr_local_decls = [] }---- the promotion monad-newtype PrM a = PrM (ReaderT PrEnv (WriterT [DDec] Q) a)- deriving ( Functor, Applicative, Monad, Quasi- , MonadReader PrEnv, MonadWriter [DDec]- , MonadFail, MonadIO )--instance DsMonad PrM where- localDeclarations = asks pr_local_decls---- return *type-level* names-allLocals :: MonadReader PrEnv m => m [Name]-allLocals = do- lambdas <- asks (Map.toList . pr_lambda_bound)- lets <- asks pr_let_bound- -- filter out shadowed variables!- return [ typeName- | (termName, typeName) <- lambdas- , case Map.lookup termName lets of- Just (DVarT typeName') | typeName' == typeName -> True- _ -> False ]--emitDecs :: MonadWriter [DDec] m => [DDec] -> m ()-emitDecs = tell--emitDecsM :: MonadWriter [DDec] m => m [DDec] -> m ()-emitDecsM action = do- decs <- action- emitDecs decs---- when lambda-binding variables, we still need to add the variables--- to the let-expansion, because of shadowing. ugh.-lambdaBind :: VarPromotions -> PrM a -> PrM a-lambdaBind binds = local add_binds- where add_binds env@(PrEnv { pr_lambda_bound = lambdas- , pr_let_bound = lets }) =- let new_lets = Map.fromList [ (tmN, DVarT tyN) | (tmN, tyN) <- binds ] in- env { pr_lambda_bound = Map.union (Map.fromList binds) lambdas- , pr_let_bound = Map.union new_lets lets }--type LetBind = (Name, DType)-letBind :: [LetBind] -> PrM a -> PrM a-letBind binds = local add_binds- where add_binds env@(PrEnv { pr_let_bound = lets }) =- env { pr_let_bound = Map.union (Map.fromList binds) lets }--lookupVarE :: Name -> PrM DType-lookupVarE n = do- lets <- asks pr_let_bound- case Map.lookup n lets of- Just ty -> return ty- Nothing -> return $ promoteValRhs n---- Add to the set of bound kind variables currently in scope.--- See Note [Explicitly binding kind variables]-forallBind :: Set Name -> PrM a -> PrM a-forallBind kvs1 =- local (\env@(PrEnv { pr_forall_bound = kvs2 }) ->- env { pr_forall_bound = kvs1 `Set.union` kvs2 })---- Look up the set of bound kind variables currently in scope.--- See Note [Explicitly binding kind variables]-allBoundKindVars :: PrM (Set Name)-allBoundKindVars = asks pr_forall_bound--promoteM :: DsMonad q => [Dec] -> PrM a -> q (a, [DDec])-promoteM locals (PrM rdr) = do- other_locals <- localDeclarations- let wr = runReaderT rdr (emptyPrEnv { pr_local_decls = other_locals ++ locals })- q = runWriterT wr- runQ q--promoteM_ :: DsMonad q => [Dec] -> PrM () -> q [DDec]-promoteM_ locals thing = do- ((), decs) <- promoteM locals thing- return decs---- promoteM specialized to [DDec]-promoteMDecs :: DsMonad q => [Dec] -> PrM [DDec] -> q [DDec]-promoteMDecs locals thing = do- (decs1, decs2) <- promoteM locals thing- return $ decs1 ++ decs2--{--Note [Explicitly binding kind variables]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We want to ensure that when we single type signatures for functions, we should-explicitly quantify every kind variable bound by a forall. For example, if we-were to single the identity function:-- identity :: forall a. a -> a- identity x = x--We want the final result to be:-- sIdentity :: forall a (x :: a). Sing x -> Sing (Identity x)- sIdentity sX = sX--Accomplishing this takes a bit of care during promotion. When promoting a-function, we determine what set of kind variables are currently bound at that-point and store them in an ALetDecEnv (as lde_bound_kvs), which in turn is-singled. Then, during singling, we extract every kind variable in a singled-type signature, subtract the lde_bound_kvs, and explicitly bind the variables-that remain.--For a top-level function like identity, lde_bound_kvs is the empty set. But-consider this more complicated example:-- f :: forall a. a -> a- f = g- where- g :: a -> a- g x = x--When singling, we would eventually end up in this spot:-- sF :: forall a (x :: a). Sing a -> Sing (F a)- sF = sG- where- sG :: _- sG x = x--We must make sure /not/ to fill in the following type for _:-- sF :: forall a (x :: a). Sing a -> Sing (F a)- sF = sG- where- sG :: forall a (y :: a). Sing a -> Sing (G a)- sG x = x--This would be incorrect, as the `a` bound by sF /must/ be the same one used in-sG, as per the scoping of the original `f` function. Thus, we ensure that the-bound variables from `f` are put into lde_bound_kvs when promoting `g` so-that we subtract out `a` and are left with the correct result:-- sF :: forall a (x :: a). Sing a -> Sing (F a)- sF = sG- where- sG :: forall (y :: a). Sing a -> Sing (G a)- sG x = x--}
− src/Data/Singletons/Promote/Type.hs
@@ -1,64 +0,0 @@-{- Data/Singletons/Type.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--This file implements promotion of types into kinds.--}--module Data.Singletons.Promote.Type ( promoteType, promoteUnraveled ) where--import Language.Haskell.TH.Desugar-import Data.Singletons.Names-import Data.Singletons.Util-import Language.Haskell.TH---- the only monadic thing we do here is fail. This allows the function--- to be used from the Singletons module-promoteType :: Monad m => DType -> m DKind-promoteType = go []- where- go :: Monad m => [DKind] -> DType -> m DKind- -- We don't need to worry about constraints: they are used to express- -- static guarantees at runtime. But, because we don't need to do- -- anything special to keep static guarantees at compile time, we don't- -- need to promote them.- go [] (DForallT _tvbs _cxt ty) = go [] ty- go [] (DAppT (DAppT DArrowT (DForallT (_:_) _ _)) _) =- fail "Cannot promote types of rank above 1."- go args (DAppT t1 t2) = do- k2 <- go [] t2- go (k2 : args) t1- -- NB: This next case means that promoting something like- -- (((->) a) :: Type -> Type) b- -- will fail because the pattern below won't recognize the- -- arrow to turn it into a TyFun. But I'm not terribly- -- bothered by this, and it would be annoying to fix. Wait- -- for someone to report.- go args (DSigT ty ki) = do- ty' <- go [] ty- -- No need to promote 'ki' - it is already a kind.- return $ foldType (DSigT ty' ki) args- go args (DVarT name) = return $ foldType (DVarT name) args- go [] (DConT name)- | name == typeRepName = return $ DConT typeKindName- | nameBase name == nameBase repName = return $ DConT typeKindName- go args (DConT name)- | Just n <- unboxedTupleNameDegree_maybe name- = return $ foldType (DConT (tupleTypeName n)) args- | otherwise- = return $ foldType (DConT name) args- go [k1, k2] DArrowT = return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2- go _ ty@DLitT{} = pure ty-- go args hd = fail $ "Illegal Haskell construct encountered:\n" ++- "headed by: " ++ show hd ++ "\n" ++- "applied to: " ++ show args--promoteUnraveled :: Monad m => DType -> m ([DKind], DKind)-promoteUnraveled ty = do- arg_kis <- mapM promoteType arg_tys- res_ki <- promoteType res_ty- return (arg_kis, res_ki)- where- (_, _, arg_tys, res_ty) = unravel ty
src/Data/Singletons/ShowSing.hs view
@@ -1,15 +1,24 @@-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.ShowSing@@ -19,26 +28,30 @@ -- Stability : experimental -- Portability : non-portable ----- Defines the class 'ShowSing' type synonym, which is useful for defining--- 'Show' instances for singleton types.+-- Defines the class 'ShowSing' which is useful for defining 'Show' instances+-- for singleton types. Because 'ShowSing' crucially relies on+-- @QuantifiedConstraints@, it is only defined if this library is built with+-- GHC 8.6 or later. -- ---------------------------------------------------------------------------- module Data.Singletons.ShowSing (+#if __GLASGOW_HASKELL__ >= 806 -- * The 'ShowSing' type- ShowSing+ ShowSing,++ -- * Internal utilities+ ShowSing'+#endif ) where -import Data.Singletons.Internal-import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Singletons.TypeLits.Internal-import Data.Singletons.Util-import GHC.Show (appPrec, appPrec1)-import qualified GHC.TypeNats as TN+#if __GLASGOW_HASKELL__ >= 806+import Data.Kind+import Data.Singletons+import Text.Show -- | In addition to the promoted and singled versions of the 'Show' class that--- @singletons@ provides, it is also useful to be able to directly define+-- @singletons-base@ provides, it is also useful to be able to directly define -- 'Show' instances for singleton types themselves. Doing so is almost entirely -- straightforward, as a derived 'Show' instance does 90 percent of the work. -- The last 10 percent—getting the right instance context—is a bit tricky, and@@ -48,37 +61,51 @@ -- an instance with the following shape: -- -- @--- deriving instance ??? => Show (Sing (x :: [k]))+-- instance ??? => 'Show' ('SList' (z :: [k])) where+-- showsPrec p 'SNil' = showString \"SNil\"+-- showsPrec p ('SCons' sx sxs) =+-- showParen (p > 10) $ showString \"SCons \" . showsPrec 11 sx+-- . showSpace . showsPrec 11 sxs -- @ -- -- To figure out what should go in place of @???@, observe that we require the -- type of each field to also be 'Show' instances. In other words, we need--- something like @(Show (Sing (a :: k)))@. But this isn't quite right, as the+-- something like @('Show' ('Sing' (a :: k)))@. But this isn't quite right, as the -- type variable @a@ doesn't appear in the instance head. In fact, this @a@ -- type is really referring to an existentially quantified type variable in the -- 'SCons' constructor, so it doesn't make sense to try and use it like this. -- -- Luckily, the @QuantifiedConstraints@ language extension provides a solution -- to this problem. This lets you write a context of the form--- @(forall a. Show (Sing (a :: k)))@, which demands that there be an instance--- for @Show (Sing (a :: k))@ that is parametric in the use of @a@. Thus, our--- final instance looks like:+-- @(forall a. 'Show' ('Sing' (a :: k)))@, which demands that there be an instance+-- for @'Show' ('Sing' (a :: k))@ that is parametric in the use of @a@.+-- This lets us write something closer to this: -- -- @--- deriving instance (forall a. Show (Sing (a :: k))) => Show (Sing (x :: [k]))+-- instance (forall a. 'Show' ('Sing' (a :: k))) => 'SList' ('Sing' (z :: [k])) where ... -- @ ----- Because that quantified constraint is somewhat lengthy, we provide the--- 'ShowSing' class synonym as a convenient shorthand. Thus, the above instance--- is equivalent to:+-- The 'ShowSing' class is a thin wrapper around+-- @(forall a. 'Show' ('Sing' (a :: k)))@. With 'ShowSing', our final instance+-- declaration becomes this: -- -- @--- deriving instance ShowSing k => Show (Sing (x :: [k]))+-- instance 'ShowSing' k => 'Show' ('SList' (z :: [k])) where ... -- @ ----- When singling a derived 'Show' instance, @singletons@ will also derive+-- In fact, this instance can be derived:+--+-- @+-- deriving instance 'ShowSing' k => 'Show' ('SList' (z :: [k]))+-- @+--+-- (Note that the actual definition of 'ShowSing' is slightly more complicated+-- than what this documentation might suggest. For the full story,+-- refer to the documentation for `ShowSing'`.)+--+-- When singling a derived 'Show' instance, @singletons-th@ will also generate -- a 'Show' instance for the corresponding singleton type using 'ShowSing'.--- In other words, if you give @singletons@ a derived 'Show' instance, then+-- In other words, if you give @singletons-th@ a derived 'Show' instance, then -- you'll receive the following in return: -- -- * A promoted (@PShow@) instance@@ -86,21 +113,129 @@ -- * A 'Show' instance for the singleton type -- -- What a bargain!-class (forall (z :: k). Show (Sing z)) => ShowSing k-instance (forall (z :: k). Show (Sing z)) => ShowSing k +-- One might wonder we we simply don't define ShowSing as+-- @type ShowSing k = (forall (z :: k). ShowSing' z)@ instead of going the+-- extra mile to define it as a class.+-- See Note [Define ShowSing as a class, not a type synonym] for an explanation.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing :: Type -> Constraint+#endif+class (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)+instance (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)++-- | The workhorse that powers 'ShowSing'. The only reason that `ShowSing'`+-- exists is to work around GHC's inability to put type families in the head+-- of a quantified constraint (see+-- <https://gitlab.haskell.org/ghc/ghc/issues/14860 this GHC issue> for more+-- details on this point). In other words, GHC will not let you define+-- 'ShowSing' like so:+--+-- @+-- class (forall (z :: k). 'Show' ('Sing' z)) => 'ShowSing' k+-- @+--+-- By replacing @'Show' ('Sing' z)@ with @ShowSing' z@, we are able to avoid+-- this restriction for the most part.+--+-- The superclass of `ShowSing'` is a bit peculiar:+--+-- @+-- class (forall (sing :: k -> Type). sing ~ 'Sing' => 'Show' (sing z)) => `ShowSing'` (z :: k)+-- @+--+-- One might wonder why this superclass is used instead of this seemingly more+-- direct equivalent:+--+-- @+-- class 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- Actually, these aren't equivalent! The latter's superclass mentions a type+-- family in its head, and this gives GHC's constraint solver trouble when+-- trying to match this superclass against other constraints. (See the+-- discussion beginning at+-- https://gitlab.haskell.org/ghc/ghc/-/issues/16365#note_189057 for more on+-- this point). The former's superclass, on the other hand, does /not/ mention+-- a type family in its head, which allows it to match other constraints more+-- easily. It may sound like a small difference, but it's the only reason that+-- 'ShowSing' is able to work at all without a significant amount of additional+-- workarounds.+--+-- The quantified superclass has one major downside. Although the head of the+-- quantified superclass is more eager to match, which is usually a good thing,+-- it can bite under certain circumstances. Because @'Show' (sing z)@ will+-- match a 'Show' instance for /any/ types @sing :: k -> Type@ and @z :: k@,+-- (where @k@ is a kind variable), it is possible for GHC's constraint solver+-- to get into a situation where multiple instances match @'Show' (sing z)@,+-- and GHC will get confused as a result. Consider this example:+--+-- @+-- -- As in "Data.Singletons"+-- newtype 'WrappedSing' :: forall k. k -> Type where+-- 'WrapSing' :: forall k (a :: k). { 'unwrapSing' :: 'Sing' a } -> 'WrappedSing' a+--+-- instance 'ShowSing' k => 'Show' ('WrappedSing' (a :: k)) where+-- 'showsPrec' _ s = 'showString' "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}'+-- @+--+-- When typechecking the 'Show' instance for 'WrappedSing', GHC must fill in a+-- default definition @'show' = defaultShow@, where+-- @defaultShow :: 'Show' ('WrappedSing' a) => 'WrappedSing' a -> 'String'@.+-- GHC's constraint solver has two possible ways to satisfy the+-- @'Show' ('WrappedSing' a)@ constraint for @defaultShow@:+--+-- 1. The top-level instance declaration for @'Show' ('WrappedSing' (a :: k))@+-- itself, and+--+-- 2. @'Show' (sing (z :: k))@ from the head of the quantified constraint arising+-- from @'ShowSing' k@.+--+-- In practice, GHC will choose (2), as local quantified constraints shadow+-- global constraints. This confuses GHC greatly, causing it to error out with+-- an error akin to @Couldn't match type Sing with WrappedSing@. See+-- https://gitlab.haskell.org/ghc/ghc/-/issues/17934 for a full diagnosis of+-- the issue.+--+-- The bad news is that because of GHC#17934, we have to manually define 'show'+-- (and 'showList') in the 'Show' instance for 'WrappedSing' in order to avoid+-- confusing GHC's constraint solver. In other words, @deriving 'Show'@ is a+-- no-go for 'WrappedSing'. The good news is that situations like 'WrappedSing'+-- are quite rare in the world of @singletons@—most of the time, 'Show'+-- instances for singleton types do /not/ have the shape+-- @'Show' (sing (z :: k))@, where @k@ is a polymorphic kind variable. Rather,+-- most such instances instantiate @k@ to a specific kind (e.g., @Bool@, or+-- @[a]@), which means that they will not overlap the head of the quantified+-- superclass in `ShowSing'` as observed above.+--+-- Note that we define the single instance for `ShowSing'` without the use of a+-- quantified constraint in the instance context:+--+-- @+-- instance 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- We /could/ define this instance with a quantified constraint in the instance+-- context, and it would be equally as expressive. But it doesn't provide any+-- additional functionality that the non-quantified version gives, so we opt+-- for the non-quantified version, which is easier to read.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing' :: k -> Constraint+#endif+class (forall (sing :: k -> Type). sing ~ Sing => Show (sing z))+ => ShowSing' (z :: k)+instance Show (Sing z) => ShowSing' (z :: k)+ {- Note [Define ShowSing as a class, not a type synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In an ideal world, we would simply define ShowSing as an ordinary type synonym,-like this:+In an ideal world, we would simply define ShowSing like this: - type ShowSing k = (forall (z :: k). Show (Sing z) :: Constraint)+ type ShowSing k = (forall (z :: k). ShowSing' z) :: Constraint) -In fact, I used to assume that we lived in an ideal world, so I defined-ShowSing as a type synonym in version 2.5 of this library. However, I realized-some time after 2.5's release that the world is far from ideal, unfortunately,-and that this approach is unfeasible at the time being due to GHC Trac #15888.+In fact, I used to define ShowSing in a manner similar to this in version 2.5+of singletons. However, I realized some time after 2.5's release that the+this encoding is unfeasible at the time being due to GHC Trac #15888. To be more precise, the exact issue involves an infelicity in the way QuantifiedConstraints interacts with recursive type class instances.@@ -130,18 +265,18 @@ To see why this happens, observe what goes on if we expand the occurrences of the ShowSing type synonym in the generated instances: - deriving instance (forall z. Show (Sing (z :: Y a))) => Show (Sing (z :: X a))- deriving instance (forall z. Show (Sing (z :: X a))) => Show (Sing (z :: Y a))+ deriving instance (forall z. ShowSing' (z :: Y a)) => Show (Sing (z :: X a))+ deriving instance (forall z. ShowSing' (z :: X a)) => Show (Sing (z :: Y a)) Due to the way QuantifiedConstraints currently works (as surmised in Trac-#15888), when GHC has a Wanted `Show (Sing X1 :: X Bool)` constraint, it+#15888), when GHC has a Wanted `ShowSing' (X1 :: X Bool)` constraint, it chooses the appropriate instance and emits a Wanted-`forall z. Show (Sing (z :: Y Bool))` constraint (from the instance context).+`forall z. ShowSing' (z :: Y Bool)` constraint (from the instance context). GHC skolemizes the `z` to `z1` and tries to solve a Wanted-`Show (Sing (z1 :: Y Bool))` constraint. GHC chooses the appropriate instance-and emits a Wanted `forall z. Show (Sing (z :: X Bool))` constraint. GHC+`ShowSing' (z1 :: Y Bool)` constraint. GHC chooses the appropriate instance+and emits a Wanted `forall z. ShowSing' (z :: X Bool)` constraint. GHC skolemizes the `z` to `z2` and tries to solve a Wanted-`Show (Sing (z2 :: X Bool))` constraint... we repeat the process and find+`ShowSing' (z2 :: X Bool)` constraint... we repeat the process and find ourselves in an infinite loop that eventually overflows the reduction stack. Eep. @@ -151,7 +286,7 @@ 1. Make derived instances' type inference more clever. If you look closely, you'll notice that the `ShowSing (X a)`/`ShowSing (Y a)` constraints in the generated instances are entirely redundant and could safely be left- off. But determining this would require significantly improving singletons'+ off. But determining this would require significantly improving singletons-th' Template Haskell capabilities for type inference, which is a path that we usually spurn in favor of keeping the generated code dumb but predictable. 2. Define `ShowSing` as a class (with a single instance) instead of a type@@ -164,31 +299,21 @@ -} --------------------------------------------------------------- TypeLits instances+-- (S)WrappedSing instances ------------------------------------------------------------ --- These are a bit special because the singleton constructor does not uniquely--- determine the type being used in the constructor's return type (e.g., all Nats--- have the same singleton constructor, SNat). To compensate for this, we display--- the type being used using visible type application. (Thanks to @cumber on #179--- for suggesting this implementation.)--instance Show (SNat n) where- showsPrec p n@SNat- = showParen (p > appPrec)- ( showString "SNat @"- . showsPrec appPrec1 (TN.natVal n)- )--instance Show (SSymbol s) where- showsPrec p s@SSym- = showParen (p > appPrec)- ( showString "SSym @"- . showsPrec appPrec1 (symbolVal s)- )+-- Note that we cannot derive this Show instance due to+-- https://gitlab.haskell.org/ghc/ghc/-/issues/17934. The Haddocks for+-- ShowSing' contain a lengthier explanation of how GHC#17934 relates to+-- ShowSing.+instance ShowSing k => Show (WrappedSing (a :: k)) where+ showsPrec = showsWrappedSingPrec+ show x = showsWrappedSingPrec 0 x ""+ showList = showListWith (showsWrappedSingPrec 0) ---------------------------------------------------------------- Template Haskell-generated instances-------------------------------------------------------------+showsWrappedSingPrec :: ShowSing k => Int -> WrappedSing (a :: k) -> ShowS+showsWrappedSingPrec p (WrapSing s) = showParen (p >= 11) $+ showString "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}' -$(showSingInstances basicTypes)+deriving instance ShowSing k => Show (SWrappedSing (ws :: WrappedSing (a :: k)))+#endif
src/Data/Singletons/Sigma.hs view
@@ -1,14 +1,30 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#else+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#else+{-# LANGUAGE ImpredicativeTypes #-} -- See Note [Impredicative Σ?]+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Sigma@@ -23,40 +39,115 @@ ---------------------------------------------------------------------------- module Data.Singletons.Sigma- ( Sigma(..), Σ+ ( -- * The 'Sigma' type+ Sigma(..), Σ+ , Sing, SSigma(..), SΣ++ -- * Operations over 'Sigma'+ , fstSigma, FstSigma, sndSigma, SndSigma , projSigma1, projSigma2 , mapSigma, zipSigma+ , currySigma, uncurrySigma - -- * Defunctionalization symbols- , ΣSym0, ΣSym1, ΣSym2+#if __GLASGOW_HASKELL__ >= 806+ -- * Internal utilities+ -- $internalutilities+ , ShowApply, ShowSingApply+ , ShowApply', ShowSingApply'+#endif ) where -import Data.Kind (Type)-import Data.Singletons.Internal-import Data.Singletons.Promote+import Data.Kind+import Data.Singletons+#if __GLASGOW_HASKELL__ >= 806+import Data.Singletons.ShowSing+#endif -- | A dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type Sigma :: forall s -> (s ~> Type) -> Type+#endif data Sigma (s :: Type) :: (s ~> Type) -> Type where (:&:) :: forall s t fst. Sing (fst :: s) -> t @@ fst -> Sigma s t infixr 4 :&: -- | Unicode shorthand for 'Sigma'.-type Σ (s :: Type) (t :: s ~> Type) = Sigma s t+#if __GLASGOW_HASKELL__ >= 810+type Σ :: forall s -> (s ~> Type) -> Type+#endif+type Σ = Sigma +{-+Note [Impredicative Σ?]+~~~~~~~~~~~~~~~~~~~~~~~+The following definition alone:++ type Σ = Sigma++will not typecheck without the use of ImpredicativeTypes. There isn't a+fundamental reason that this should be the case, and the only reason that GHC+currently requires this is due to GHC#13408. Thankfully, giving Σ a standalone+kind signature works around GHC#13408, so we only have to enable+ImpredicativeTypes on pre-8.10 versions of GHC.+-}++-- | The singleton type for 'Sigma'.+#if __GLASGOW_HASKELL__ >= 810+type SSigma :: Sigma s t -> Type+#endif+data SSigma :: forall s t. Sigma s t -> Type where+ (:%&:) :: forall s t (fst :: s) (sfst :: Sing fst) (snd :: t @@ fst).+ Sing ('WrapSing sfst) -> Sing snd -> SSigma (sfst ':&: snd :: Sigma s t)+infixr 4 :%&:+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Sigma s t) =+#else+type instance Sing =+#endif+ SSigma++instance forall s t (fst :: s) (a :: Sing fst) (b :: t @@ fst).+ (SingI fst, SingI b)+ => SingI (a ':&: b :: Sigma s t) where+ sing = sing :%&: sing++-- | Unicode shorthand for 'SSigma'.+#if __GLASGOW_HASKELL__ >= 810+type SΣ :: Sigma s t -> Type+#endif+type SΣ = SSigma+ -- | Project the first element out of a dependent pair.-projSigma1 :: forall s t. SingKind s => Sigma s t -> Demote s-projSigma1 (a :&: _) = fromSing a+fstSigma :: forall s t. SingKind s => Sigma s t -> Demote s+fstSigma (a :&: _) = fromSing a +-- | Project the first element out of a dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type FstSigma :: Sigma s t -> s+#endif+type family FstSigma (sig :: Sigma s t) :: s where+ FstSigma ((_ :: Sing fst) ':&: _) = fst+ -- | Project the second element out of a dependent pair.------ In an ideal setting, the type of 'projSigma2' would be closer to:------ @--- 'projSigma2' :: 'Sing' (sig :: 'Sigma' s t) -> t @@ ProjSigma1 sig--- @------ But promoting 'projSigma1' to a type family is not a simple task. Instead,--- we do the next-best thing, which is to use Church-style elimination.+sndSigma :: forall s t (sig :: Sigma s t).+ SingKind (t @@ FstSigma sig)+ => SSigma sig -> Demote (t @@ FstSigma sig)+sndSigma (_ :%&: b) = fromSing b++-- | Project the second element out of a dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type SndSigma :: forall s t. forall (sig :: Sigma s t) -> t @@ FstSigma sig+#endif+type family SndSigma (sig :: Sigma s t) :: t @@ FstSigma sig where+ SndSigma (_ ':&: b) = b++-- | Project the first element out of a dependent pair using+-- continuation-passing style.+projSigma1 :: (forall (fst :: s). Sing fst -> r) -> Sigma s t -> r+projSigma1 f (a :&: _) = f a++-- | Project the second element out of a dependent pair using+-- continuation-passing style. projSigma2 :: forall s t r. (forall (fst :: s). t @@ fst -> r) -> Sigma s t -> r projSigma2 f ((_ :: Sing (fst :: s)) :&: b) = f @fst b @@ -72,4 +163,86 @@ zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) = (f @@ a @@ b) :&: (g @fstA @fstB p q) -$(genDefunSymbols [''Σ])+-- | Convert an uncurried function on 'Sigma' to a curried one.+--+-- Together, 'currySigma' and 'uncurrySigma' witness an isomorphism such that+-- the following identities hold:+--+-- @+-- id1 :: forall a (b :: a ~> Type) (c :: 'Sigma' a b ~> Type).+-- (forall (p :: Sigma a b). 'SSigma' p -> c @@ p)+-- -> (forall (p :: Sigma a b). 'SSigma' p -> c @@ p)+-- id1 f = 'uncurrySigma' @a @b @c ('currySigma' @a @b @c f)+--+-- id2 :: forall a (b :: a ~> Type) (c :: 'Sigma' a b ~> Type).+-- (forall (x :: a) (sx :: Sing x) (y :: b @@ x). Sing ('WrapSing' sx) -> Sing y -> c @@ (sx :&: y))+-- -> (forall (x :: a) (sx :: Sing x) (y :: b @@ x). Sing ('WrapSing' sx) -> Sing y -> c @@ (sx :&: y))+-- id2 f = 'currySigma' @a @b @c ('uncurrySigma' @a @b @c f)+-- @+currySigma :: forall a (b :: a ~> Type) (c :: Sigma a b ~> Type).+ (forall (p :: Sigma a b). SSigma p -> c @@ p)+ -> (forall (x :: a) (sx :: Sing x) (y :: b @@ x).+ Sing ('WrapSing sx) -> Sing y -> c @@ (sx ':&: y))+currySigma f x y = f (x :%&: y)++-- | Convert a curried function on 'Sigma' to an uncurried one.+--+-- Together, 'currySigma' and 'uncurrySigma' witness an isomorphism.+-- (Refer to the documentation for 'currySigma' for more details.)+uncurrySigma :: forall a (b :: a ~> Type) (c :: Sigma a b ~> Type).+ (forall (x :: a) (sx :: Sing x) (y :: b @@ x).+ Sing ('WrapSing sx) -> Sing y -> c @@ (sx ':&: y))+ -> (forall (p :: Sigma a b). SSigma p -> c @@ p)+uncurrySigma f (x :%&: y) = f x y++#if __GLASGOW_HASKELL__ >= 806+instance (ShowSing s, ShowApply t) => Show (Sigma s t) where+ showsPrec p ((a :: Sing (fst :: s)) :&: b) = showParen (p >= 5) $+ showsPrec 5 a . showString " :&: " . showsPrec 5 b+ :: ShowApply' t fst => ShowS++instance forall s (t :: s ~> Type) (sig :: Sigma s t).+ (ShowSing s, ShowSingApply t)+ => Show (SSigma sig) where+ showsPrec p ((sa :: Sing ('WrapSing (sfst :: Sing fst))) :%&: (sb :: Sing snd)) =+ showParen (p >= 5) $+ showsPrec 5 sa . showString " :&: " . showsPrec 5 sb+ :: ShowSingApply' t fst snd => ShowS++------------------------------------------------------------+-- Internal utilities+------------------------------------------------------------++{- $internal-utilities++See the documentation in "Data.Singletons.ShowSing"—in particular, the+Haddocks for 'ShowSing' and `ShowSing'`—for an explanation for why these+classes exist.++Note that these classes are only defined on GHC 8.6 or later.+-}++#if __GLASGOW_HASKELL__ >= 810+type ShowApply :: (a ~> Type) -> Constraint+#endif+class (forall (x :: a). ShowApply' f x) => ShowApply (f :: a ~> Type)+instance (forall (x :: a). ShowApply' f x) => ShowApply (f :: a ~> Type)++#if __GLASGOW_HASKELL__ >= 810+type ShowApply' :: (a ~> Type) -> a -> Constraint+#endif+class Show (Apply f x) => ShowApply' (f :: a ~> Type) (x :: a)+instance Show (Apply f x) => ShowApply' (f :: a ~> Type) (x :: a)++#if __GLASGOW_HASKELL__ >= 810+type ShowSingApply :: (a ~> Type) -> Constraint+#endif+class (forall (x :: a) (z :: Apply f x). ShowSingApply' f x z) => ShowSingApply (f :: a ~> Type)+instance (forall (x :: a) (z :: Apply f x). ShowSingApply' f x z) => ShowSingApply (f :: a ~> Type)++#if __GLASGOW_HASKELL__ >= 810+type ShowSingApply' :: forall a. forall (f :: a ~> Type) (x :: a) -> Apply f x -> Constraint+#endif+class Show (Sing z) => ShowSingApply' (f :: a ~> Type) (x :: a) (z :: Apply f x)+instance Show (Sing z) => ShowSingApply' (f :: a ~> Type) (x :: a) (z :: Apply f x)+#endif
− src/Data/Singletons/Single.hs
@@ -1,874 +0,0 @@-{- Data/Singletons/Single.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--This file contains functions to refine constructs to work with singleton-types. It is an internal module to the singletons package.--}-{-# LANGUAGE TemplateHaskell, TupleSections, ParallelListComp, CPP #-}--module Data.Singletons.Single where--import Prelude hiding ( exp )-import Language.Haskell.TH hiding ( cxt )-import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..))-import Data.Singletons.Deriving.Infer-import Data.Singletons.Deriving.Ord-import Data.Singletons.Deriving.Bounded-import Data.Singletons.Deriving.Enum-import Data.Singletons.Deriving.Show-import Data.Singletons.Deriving.Util-import Data.Singletons.Util-import Data.Singletons.Promote-import Data.Singletons.Promote.Defun-import Data.Singletons.Promote.Monad ( promoteM )-import Data.Singletons.Promote.Type-import Data.Singletons.Names-import Data.Singletons.Single.Monad-import Data.Singletons.Single.Type-import Data.Singletons.Single.Data-import Data.Singletons.Single.Defun-import Data.Singletons.Single.Fixity-import Data.Singletons.Single.Eq-import Data.Singletons.Syntax-import Data.Singletons.Partition-import Language.Haskell.TH.Desugar-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-import Data.Maybe-import qualified Data.Set as Set-import Data.Set ( Set )-import Control.Monad-import Data.List-import qualified GHC.LanguageExtensions.Type as LangExt--{--How singletons works-~~~~~~~~~~~~~~~~~~~~--Singling, on the surface, doesn't seem all that complicated. Promote the type,-and singletonize all the terms. That's essentially what was done singletons < 1.0.-But, now we want to deal with higher-order singletons. So, things are a little-more complicated.--The way to understand all of this is that *every* variable maps to something-of type (Sing t), for an appropriately-kinded t. This includes functions, which-use the "SLambda" instance of Sing. To apply singleton functions, we use the-applySing function.--That, in and of itself, wouldn't be too hard, but it's really annoying from-the user standpoint. After dutifully singling `map`, a user doesn't want to-have to use two `applySing`s to actually use it. So, any let-bound identifier-is eta-expanded so that the singled type has the same number of arrows as-the original type. (If there is no original type signature, then it has as-many arrows as the original had patterns.) Then, we store a use of one of the-singFunX functions in the SgM environment so that every use of a let-bound-identifier has a proper type (Sing t).--It would be consistent to avoid this eta-expansion for local lets (as opposed-to top-level lets), but that seemed like more bother than it was worth. It-may also be possible to be cleverer about nested eta-expansions and contractions,-but that also seemed not to be worth it. Though I haven't tested it, my hope-is that the eta-expansions and contractions have no runtime effect, especially-because SLambda is a *newtype* instance, not a *data* instance.--Note that to maintain the desired invariant, we must also be careful to eta--contract constructors. This is the point of buildDataLets.--}---- | Generate singleton definitions from a type that is already defined.--- For example, the singletons package itself uses------ > $(genSingletons [''Bool, ''Maybe, ''Either, ''[]])------ to generate singletons for Prelude types.-genSingletons :: DsMonad q => [Name] -> q [Dec]-genSingletons names = do- checkForRep names- ddecs <- concatMapM (singInfo <=< dsInfo <=< reifyWithLocals) names- return $ decsToTH ddecs---- | Make promoted and singleton versions of all declarations given, retaining--- the original declarations.--- See <https://github.com/goldfirere/singletons/blob/master/README.md> for--- further explanation.-singletons :: DsMonad q => q [Dec] -> q [Dec]-singletons qdecs = do- decs <- qdecs- ddecs <- withLocalDeclarations decs $ dsDecs decs- singDecs <- singTopLevelDecs decs ddecs- return (decs ++ decsToTH singDecs)---- | Make promoted and singleton versions of all declarations given, discarding--- the original declarations. Note that a singleton based on a datatype needs--- the original datatype, so this will fail if it sees any datatype declarations.--- Classes, instances, and functions are all fine.-singletonsOnly :: DsMonad q => q [Dec] -> q [Dec]-singletonsOnly = (>>= wrapDesugar singTopLevelDecs)---- | Create instances of 'SEq' and type-level @(==)@ for each type in the list-singEqInstances :: DsMonad q => [Name] -> q [Dec]-singEqInstances = concatMapM singEqInstance---- | Create instance of 'SEq' and type-level @(==)@ for the given type-singEqInstance :: DsMonad q => Name -> q [Dec]-singEqInstance name = do- promotion <- promoteEqInstance name- dec <- singEqualityInstance sEqClassDesc name- return $ dec ++ promotion---- | Create instances of 'SEq' (only -- no instance for @(==)@, which 'SEq' generally--- relies on) for each type in the list-singEqInstancesOnly :: DsMonad q => [Name] -> q [Dec]-singEqInstancesOnly = concatMapM singEqInstanceOnly---- | Create instances of 'SEq' (only -- no instance for @(==)@, which 'SEq' generally--- relies on) for the given type-singEqInstanceOnly :: DsMonad q => Name -> q [Dec]-singEqInstanceOnly name = singEqualityInstance sEqClassDesc name---- | Create instances of 'SDecide' for each type in the list.-singDecideInstances :: DsMonad q => [Name] -> q [Dec]-singDecideInstances = concatMapM singDecideInstance---- | Create instance of 'SDecide' for the given type.-singDecideInstance :: DsMonad q => Name -> q [Dec]-singDecideInstance name = singEqualityInstance sDecideClassDesc name---- generalized function for creating equality instances-singEqualityInstance :: DsMonad q => EqualityClassDesc q -> Name -> q [Dec]-singEqualityInstance desc@(_, _, className, _) name = do- (tvbs, cons) <- getDataD ("I cannot make an instance of " ++- show className ++ " for it.") name- dtvbs <- mapM dsTvb tvbs- let data_ty = foldTypeTvbs (DConT name) dtvbs- dcons <- concatMapM (dsCon dtvbs data_ty) cons- let tyvars = map (DVarT . extractTvbName) dtvbs- kind = foldType (DConT name) tyvars- (scons, _) <- singM [] $ mapM singCtor dcons- eqInstance <- mkEqualityInstance Nothing kind dcons scons desc- return $ decToTH eqInstance---- | Create instances of 'SOrd' for the given types-singOrdInstances :: DsMonad q => [Name] -> q [Dec]-singOrdInstances = concatMapM singOrdInstance---- | Create instance of 'SOrd' for the given type-singOrdInstance :: DsMonad q => Name -> q [Dec]-singOrdInstance = singInstance mkOrdInstance "Ord"---- | Create instances of 'SBounded' for the given types-singBoundedInstances :: DsMonad q => [Name] -> q [Dec]-singBoundedInstances = concatMapM singBoundedInstance---- | Create instance of 'SBounded' for the given type-singBoundedInstance :: DsMonad q => Name -> q [Dec]-singBoundedInstance = singInstance mkBoundedInstance "Bounded"---- | Create instances of 'SEnum' for the given types-singEnumInstances :: DsMonad q => [Name] -> q [Dec]-singEnumInstances = concatMapM singEnumInstance---- | Create instance of 'SEnum' for the given type-singEnumInstance :: DsMonad q => Name -> q [Dec]-singEnumInstance = singInstance mkEnumInstance "Enum"---- | Create instance of 'SShow' for the given type------ (Not to be confused with 'showShowInstance'.)-singShowInstance :: DsMonad q => Name -> q [Dec]-singShowInstance = singInstance mkShowInstance "Show"---- | Create instances of 'SShow' for the given types------ (Not to be confused with 'showSingInstances'.)-singShowInstances :: DsMonad q => [Name] -> q [Dec]-singShowInstances = concatMapM singShowInstance---- | Create instance of 'Show' for the given singleton type------ (Not to be confused with 'singShowInstance'.)-showSingInstance :: DsMonad q => Name -> q [Dec]-showSingInstance name = do- (tvbs, cons) <- getDataD ("I cannot make an instance of Show for it.") name- dtvbs <- mapM dsTvb tvbs- let data_ty = foldTypeTvbs (DConT name) dtvbs- dcons <- concatMapM (dsCon dtvbs data_ty) cons- let tyvars = map (DVarT . extractTvbName) dtvbs- kind = foldType (DConT name) tyvars- data_decl = DataDecl name dtvbs dcons- deriv_show_decl = DerivedDecl { ded_mb_cxt = Nothing- , ded_type = kind- , ded_decl = data_decl }- (show_insts, _) <- singM [] $ singDerivedShowDecs deriv_show_decl- pure $ decsToTH show_insts---- | Create instances of 'Show' for the given singleton types------ (Not to be confused with 'singShowInstances'.)-showSingInstances :: DsMonad q => [Name] -> q [Dec]-showSingInstances = concatMapM showSingInstance--singInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec]-singInstance mk_inst inst_name name = do- (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ inst_name- ++ " for it.") name- dtvbs <- mapM dsTvb tvbs- let data_ty = foldTypeTvbs (DConT name) dtvbs- dcons <- concatMapM (dsCon dtvbs data_ty) cons- let data_decl = DataDecl name dtvbs dcons- raw_inst <- mk_inst Nothing data_ty data_decl- (a_inst, decs) <- promoteM [] $- promoteInstanceDec Map.empty raw_inst- decs' <- singDecsM [] $ (:[]) <$> singInstD a_inst- return $ decsToTH (decs ++ decs')--singInfo :: DsMonad q => DInfo -> q [DDec]-singInfo (DTyConI dec _) =- singTopLevelDecs [] [dec]-singInfo (DPrimTyConI _name _numArgs _unlifted) =- fail "Singling of primitive type constructors not supported"-singInfo (DVarI _name _ty _mdec) =- fail "Singling of value info not supported"-singInfo (DTyVarI _name _ty) =- fail "Singling of type variable info not supported"-singInfo (DPatSynI {}) =- fail "Singling of pattern synonym info not supported"--singTopLevelDecs :: DsMonad q => [Dec] -> [DDec] -> q [DDec]-singTopLevelDecs locals raw_decls = withLocalDeclarations locals $ do- decls <- expand raw_decls -- expand type synonyms- PDecs { pd_let_decs = letDecls- , pd_class_decs = classes- , pd_instance_decs = insts- , pd_data_decs = datas- , pd_ty_syn_decs = ty_syns- , pd_open_type_family_decs = o_tyfams- , pd_closed_type_family_decs = c_tyfams- , pd_derived_eq_decs = derivedEqDecs- , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls-- ((letDecEnv, classes', insts'), promDecls) <- promoteM locals $ do- defunTypeDecls ty_syns c_tyfams o_tyfams- promoteDataDecs datas- (_, letDecEnv) <- promoteLetDecs noPrefix letDecls- classes' <- mapM promoteClassDec classes- let meth_sigs = foldMap (lde_types . cd_lde) classes- insts' <- mapM (promoteInstanceDec meth_sigs) insts- mapM_ promoteDerivedEqDec derivedEqDecs- return (letDecEnv, classes', insts')-- singDecsM locals $ do- let letBinds = concatMap buildDataLets datas- ++ concatMap buildMethLets classes- (newLetDecls, singIDefunDecls, newDecls)- <- bindLets letBinds $- singLetDecEnv letDecEnv $ do- newDataDecls <- concatMapM singDataD datas- newClassDecls <- mapM singClassD classes'- newInstDecls <- mapM singInstD insts'- newDerivedEqDecs <- concatMapM singDerivedEqDecs derivedEqDecs- newDerivedShowDecs <- concatMapM singDerivedShowDecs derivedShowDecs- return $ newDataDecls ++ newClassDecls- ++ newInstDecls- ++ newDerivedEqDecs- ++ newDerivedShowDecs- return $ promDecls ++ (map DLetDec newLetDecls) ++ singIDefunDecls ++ newDecls---- see comment at top of file-buildDataLets :: DataDecl -> [(Name, DExp)]-buildDataLets (DataDecl _name _tvbs cons) =- concatMap con_num_args cons- where- con_num_args :: DCon -> [(Name, DExp)]- con_num_args (DCon _tvbs _cxt name fields _rty) =- (name, wrapSingFun (length (tysOfConFields fields))- (promoteValRhs name) (DConE $ singDataConName name))- : rec_selectors fields-- rec_selectors :: DConFields -> [(Name, DExp)]- rec_selectors (DNormalC {}) = []- rec_selectors (DRecC fields) =- let names = map fstOf3 fields in- [ (name, wrapSingFun 1 (promoteValRhs name) (DVarE $ singValName name))- | name <- names ]---- see comment at top of file-buildMethLets :: UClassDecl -> [(Name, DExp)]-buildMethLets (ClassDecl { cd_lde = LetDecEnv { lde_types = meth_sigs } }) =- map mk_bind (Map.toList meth_sigs)- where- mk_bind (meth_name, meth_ty) =- ( meth_name- , wrapSingFun (countArgs meth_ty) (promoteValRhs meth_name)- (DVarE $ singValName meth_name) )--singClassD :: AClassDecl -> SgM DDec-singClassD (ClassDecl { cd_cxt = cls_cxt- , cd_name = cls_name- , cd_tvbs = cls_tvbs- , cd_fds = cls_fundeps- , cd_lde = LetDecEnv { lde_defns = default_defns- , lde_types = meth_sigs- , lde_infix = fixities- , lde_proms = promoted_defaults- , lde_bound_kvs = meth_bound_kvs } }) =- bindContext [foldPredTvbs (DConPr cls_name) cls_tvbs] $ do- (sing_sigs, _, tyvar_names, cxts, res_kis, singIDefunss)- <- unzip6 <$> zipWithM (singTySig no_meth_defns meth_sigs meth_bound_kvs)- meth_names (map promoteValRhs meth_names)- emitDecs $ concat singIDefunss- let default_sigs = catMaybes $- zipWith4 mk_default_sig meth_names sing_sigs tyvar_names res_kis- res_ki_map = Map.fromList (zip meth_names- (map (fromMaybe always_sig) res_kis))- sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names)- (Map.fromList cxts)- res_ki_map))- (Map.toList default_defns)- fixities' <- traverse (uncurry singInfixDecl) $ Map.toList fixities- cls_cxt' <- mapM singPred cls_cxt- return $ DClassD cls_cxt'- (singClassName cls_name)- cls_tvbs- cls_fundeps -- they are fine without modification- (map DLetDec (sing_sigs ++ sing_meths ++ fixities') ++ default_sigs)- where- no_meth_defns = error "Internal error: can't find declared method type"- always_sig = error "Internal error: no signature for default method"- meth_names = Map.keys meth_sigs-- mk_default_sig meth_name (DSigD s_name sty) bound_kvs (Just res_ki) =- DDefaultSigD s_name <$> add_constraints meth_name sty bound_kvs res_ki- mk_default_sig _ _ _ _ = error "Internal error: a singled signature isn't a signature."-- add_constraints meth_name sty (_, bound_kvs) res_ki = do -- Maybe monad- prom_dflt <- Map.lookup meth_name promoted_defaults- let default_pred = foldPred (DConPr equalityName)- -- NB: Need the res_ki here to prevent ambiguous- -- kinds in result-inferred default methods.- -- See #175- [ foldApply (promoteValRhs meth_name) tvs `DSigT` res_ki- , foldApply prom_dflt tvs ]- return $ DForallT tvbs (default_pred : cxt) (ravel args res)- where- (tvbs, cxt, args, res) = unravel sty- bound_kv_set = Set.fromList bound_kvs- -- Filter out explicitly bound kind variables. Otherwise, if you had- -- the following class (#312):- --- -- class Foo a where- -- bar :: a -> b -> b- -- bar _ x = x- --- -- Then it would be singled to:- --- -- class SFoo a where- -- sBar :: forall b (x :: a) (y :: b). Sing x -> Sing y -> Sing (sBar x y)- -- default :: forall b (x :: a) (y :: b).- -- (Bar b x y) ~ (BarDefault b x y) => ...- --- -- Which applies Bar/BarDefault to b, which shouldn't happen.- tvs = map tvbToType $- filter (\tvb -> extractTvbName tvb `Set.member` bound_kv_set) tvbs---singInstD :: AInstDecl -> SgM DDec-singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys- , id_sigs = inst_sigs, id_meths = ann_meths }) = do- bindContext cxt $ do- cxt' <- mapM singPred cxt- inst_kis <- mapM promoteType inst_tys- meths <- concatMapM (uncurry sing_meth) ann_meths- return (DInstanceD Nothing- cxt'- (foldl DAppT (DConT s_inst_name) inst_kis)- meths)-- where- s_inst_name = singClassName inst_name-- sing_meth :: Name -> ALetDecRHS -> SgM [DDec]- sing_meth name rhs = do- mb_s_info <- dsReify (singValName name)- inst_kis <- mapM promoteType inst_tys- let mk_subst cls_tvbs = Map.fromList $ zip (map extractTvbName vis_cls_tvbs) inst_kis- where- -- This is a half-hearted attempt to address the underlying problem- -- in #358, where we can sometimes have more class type variables- -- (due to implicit kind arguments) than class arguments. This just- -- ensures that the explicit type variables are properly mapped- -- to the class arguments, leaving the implicit kind variables- -- unmapped. That could potentially cause *other* problems, but- -- those are perhaps best avoided by using InstanceSigs. At the- -- very least, this workaround will make error messages slightly- -- less confusing.- vis_cls_tvbs = drop (length cls_tvbs - length inst_kis) cls_tvbs-- sing_meth_ty :: Set Name -> DType- -> SgM (DType, [Name], DCxt, DKind)- sing_meth_ty bound_kvs inner_ty = do- -- Make sure to expand through type synonyms here! Not doing so- -- resulted in #167.- raw_ty <- expand inner_ty- (s_ty, _num_args, tyvar_names, ctxt, _arg_kis, res_ki)- <- singType bound_kvs (promoteValRhs name) raw_ty- pure (s_ty, tyvar_names, ctxt, res_ki)-- (s_ty, tyvar_names, ctxt, m_res_ki) <- case Map.lookup name inst_sigs of- Just inst_sig -> do- -- We have an InstanceSig, so just single that type. Take care to- -- avoid binding the variables bound by the instance head as well.- let inst_bound = foldMap (fvDType . predToType) cxt <> foldMap fvDType inst_kis- (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty inst_bound inst_sig- pure (s_ty, tyvar_names, ctxt, Just res_ki)- Nothing -> case mb_s_info of- -- We don't have an InstanceSig, so we must compute the type to use- -- in the singled instance ourselves through reification.- Just (DVarI _ (DForallT cls_tvbs _cls_pred s_ty) _) -> do- let subst = mk_subst cls_tvbs- (sing_tvbs, ctxt, _args, res_ty) = unravel s_ty- m_res_ki = case res_ty of- _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki)- _ -> Nothing-- pure ( substType subst s_ty- , map extractTvbName sing_tvbs- , map (substPred subst) ctxt- , m_res_ki )- _ -> do- mb_info <- dsReify name- case mb_info of- Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do- let subst = mk_subst cls_tvbs- cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) cls_tvbs- cls_tvb_names = Set.fromList $ map extractTvbName cls_tvbs- cls_bound = cls_kvb_names `Set.union` cls_tvb_names- (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty cls_bound inner_ty- pure ( substType subst s_ty- , tyvar_names- , ctxt- , Just (substKind subst res_ki) )- _ -> fail $ "Cannot find type of method " ++ show name-- let kind_map = maybe Map.empty (Map.singleton name) m_res_ki- meth' <- singLetDecRHS (Map.singleton name tyvar_names)- (Map.singleton name ctxt)- kind_map name rhs- return $ map DLetDec [DSigD (singValName name) s_ty, meth']--singLetDecEnv :: ALetDecEnv- -> SgM a- -> SgM ([DLetDec], [DDec], a)- -- Return:- --- -- 1. The singled let-decs- -- 2. SingI instances for any defunctionalization symbols- -- (see Data.Singletons.Single.Defun)- -- 3. The result of running the `SgM a` action-singLetDecEnv (LetDecEnv { lde_defns = defns- , lde_types = types- , lde_infix = infix_decls- , lde_proms = proms- , lde_bound_kvs = bound_kvs })- thing_inside = do- let prom_list = Map.toList proms- (typeSigs, letBinds, tyvarNames, cxts, res_kis, singIDefunss)- <- unzip6 <$> mapM (uncurry (singTySig defns types bound_kvs)) prom_list- infix_decls' <- traverse (uncurry singInfixDecl) $ Map.toList infix_decls- let res_ki_map = Map.fromList [ (name, res_ki) | ((name, _), Just res_ki)- <- zip prom_list res_kis ]- bindLets letBinds $ do- let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames)- (Map.fromList cxts)- res_ki_map))- (Map.toList defns)- thing <- thing_inside- return (infix_decls' ++ typeSigs ++ let_decs, concat singIDefunss, thing)--singTySig :: Map Name ALetDecRHS -- definitions- -> Map Name DType -- type signatures- -> Map Name (Set Name) -- bound kind variables- -> Name -> DType -- the type is the promoted type, not the type sig!- -> SgM ( DLetDec -- the new type signature- , (Name, DExp) -- the let-bind entry- , (Name, [Name]) -- the scoped tyvar names in the tysig- , (Name, DCxt) -- the context of the type signature- , Maybe DKind -- the result kind in the tysig- , [DDec] -- SingI instances for defun symbols- )-singTySig defns types bound_kvs name prom_ty =- let sName = singValName name in- case Map.lookup name types of- Nothing -> do- num_args <- guess_num_args- (sty, tyvar_names) <- mk_sing_ty num_args- singIDefuns <- singDefuns name VarName []- (map (const Nothing) tyvar_names) Nothing- return ( DSigD sName sty- , (name, wrapSingFun num_args prom_ty (DVarE sName))- , (name, tyvar_names)- , (name, [])- , Nothing- , singIDefuns )- Just ty -> do- all_bound_kvs <- lookup_bound_kvs- (sty, num_args, tyvar_names, ctxt, arg_kis, res_ki)- <- singType all_bound_kvs prom_ty ty- bound_cxt <- askContext- singIDefuns <- singDefuns name VarName (bound_cxt ++ ctxt)- (map Just arg_kis) (Just res_ki)- return ( DSigD sName sty- , (name, wrapSingFun num_args prom_ty (DVarE sName))- , (name, tyvar_names)- , (name, ctxt)- , Just res_ki- , singIDefuns )- where- guess_num_args :: SgM Int- guess_num_args =- case Map.lookup name defns of- Nothing -> fail "Internal error: promotion known for something not let-bound."- Just (AValue _ n _) -> return n- Just (AFunction _ n _) -> return n-- lookup_bound_kvs :: SgM (Set Name)- lookup_bound_kvs =- case Map.lookup name bound_kvs of- Nothing -> fail $ "Internal error: " ++ nameBase name ++ " has no type variable "- ++ "bindings, despite having a type signature"- Just kvs -> pure kvs-- -- create a Sing t1 -> Sing t2 -> ... type of a given arity and result type- mk_sing_ty :: Int -> SgM (DType, [Name])- mk_sing_ty n = do- arg_names <- replicateM n (qNewName "arg")- return ( DForallT (map DPlainTV arg_names) []- (ravel (map (\nm -> singFamily `DAppT` DVarT nm) arg_names)- (singFamily `DAppT`- (foldl apply prom_ty (map DVarT arg_names))))- , arg_names )--singLetDecRHS :: Map Name [Name]- -> Map Name DCxt -- the context of the type signature- -- (might not be known)- -> Map Name DKind -- result kind (might not be known)- -> Name -> ALetDecRHS -> SgM DLetDec-singLetDecRHS bound_names cxts res_kis name ld_rhs =- bindContext (Map.findWithDefault [] name cxts) $- case ld_rhs of- AValue prom num_arrows exp ->- DValD (DVarPa (singValName name)) <$>- (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis))- AFunction prom_fun num_arrows clauses ->- let tyvar_names = case Map.lookup name bound_names of- Nothing -> []- Just ns -> ns- res_ki = Map.lookup name res_kis- in- DFunD (singValName name) <$>- mapM (singClause prom_fun num_arrows tyvar_names res_ki) clauses--singClause :: DType -- the promoted function- -> Int -- the number of arrows in the type. If this is more- -- than the number of patterns, we need to eta-expand- -- with unSingFun.- -> [Name] -- the names of the forall'd vars in the type sig of this- -- function. This list should have at least the length as the- -- number of patterns in the clause- -> Maybe DKind -- result kind, if known- -> ADClause -> SgM DClause-singClause prom_fun num_arrows bound_names res_ki- (ADClause var_proms pats exp) = do-- -- Fix #166:- when (num_arrows - length pats < 0) $- fail $ "Function being promoted to " ++ (pprint (typeToTH prom_fun)) ++- " has too many arguments."-- (sPats, sigPaExpsSigs) <- evalForPair $ mapM (singPat (Map.fromList var_proms)) pats- sBody <- singExp exp res_ki- -- when calling unSingFun, the promoted pats aren't in scope, so we use the- -- bound_names instead- let pattern_bound_names = zipWith const bound_names pats- -- this does eta-expansion. See comment at top of file.- sBody' = wrapUnSingFun (num_arrows - length pats)- (foldl apply prom_fun (map DVarT pattern_bound_names)) sBody- return $ DClause sPats $ mkSigPaCaseE sigPaExpsSigs sBody'--singPat :: Map Name Name -- from term-level names to type-level names- -> ADPat- -> QWithAux SingDSigPaInfos SgM DPat-singPat var_proms = go- where- go :: ADPat -> QWithAux SingDSigPaInfos SgM DPat- go (ADLitPa _lit) =- fail "Singling of literal patterns not yet supported"- go (ADVarPa name) = do- tyname <- case Map.lookup name var_proms of- Nothing ->- fail "Internal error: unknown variable when singling pattern"- Just tyname -> return tyname- pure $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname)- go (ADConPa name pats) = DConPa (singDataConName name) <$> mapM go pats- go (ADTildePa pat) = do- qReportWarning- "Lazy pattern converted into regular pattern during singleton generation."- go pat- go (ADBangPa pat) = DBangPa <$> go pat- go (ADSigPa prom_pat pat ty) = do- pat' <- go pat- -- Normally, calling dPatToDExp would be dangerous, since it fails if the- -- supplied pattern contains any wildcard patterns. However, promotePat- -- (which produced the pattern we're passing into dPatToDExp) maintains- -- an invariant that any promoted pattern signatures will be free of- -- wildcard patterns in the underlying pattern.- -- See Note [Singling pattern signatures].- addElement (dPatToDExp pat', DSigT prom_pat ty)- pure pat'- go ADWildPa = pure DWildPa---- | If given a non-empty list of 'SingDSigPaInfos', construct a case expression--- that brings singleton equality constraints into scope via pattern-matching.--- See @Note [Singling pattern signatures]@.-mkSigPaCaseE :: SingDSigPaInfos -> DExp -> DExp-mkSigPaCaseE exps_with_sigs exp- | null exps_with_sigs = exp- | otherwise =- let (exps, sigs) = unzip exps_with_sigs- scrutinee = mkTupleDExp exps- pats = map (DSigPa DWildPa . DAppT (DConT singFamilyName)) sigs- in DCaseE scrutinee [DMatch (mkTupleDPat pats) exp]---- Note [Annotate case return type]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ We're straining GHC's type inference here. One particular trouble area--- is determining the return type of a GADT pattern match. In general, GHC--- cannot infer return types of GADT pattern matches because the return type--- becomes "untouchable" in the case matches. See the OutsideIn paper. But,--- during singletonization, we *know* the return type. So, just add a type--- annotation. See #54.---- Note [Why error is so special]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- Some of the transformations that happen before this point produce impossible--- case matches. We must be careful when processing these so as not to make--- an error GHC will complain about. When binding the case-match variables, we--- normally include an equality constraint saying that the scrutinee is equal--- to the matched pattern. But, we can't do this in inaccessible matches, because--- equality is bogus, and GHC (rightly) complains. However, we then have another--- problem, because GHC doesn't have enough information when type-checking the--- RHS of the inaccessible match to deem it type-safe. The solution: treat error--- as super-special, so that GHC doesn't look too hard at singletonized error--- calls. Specifically, DON'T do the applySing stuff. Just use sError, which--- has a custom type (Sing x -> a) anyway.---- Note [Singling pattern signatures]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- We want to single a pattern signature, like so:------ f :: Maybe a -> a--- f (Just x :: Maybe a) = x------ Naïvely, one might expect this to single straightfowardly as:------ sF :: forall (z :: Maybe a). Sing z -> Sing (F z)--- sF (SJust sX :: Sing (Just x :: Maybe a)) = sX------ But the way GHC typechecks patterns prevents this from working, as GHC won't--- know that the type `z` is actually `Just x` until /after/ the entirety of--- the `SJust sX` pattern has been typechecked. (See Trac #12018 for an--- extended discussion on this topic.)------ To work around this design, we resort to a somewhat unsightly trick:--- immediately after matching on all the patterns, we perform a case on every--- pattern with a pattern signature, like so:------ sF :: forall (z :: Maybe a). Sing z -> Sing (F z)--- sF (SJust sX :: Sing z)--- = case (SJust sX :: Sing z) of--- (_ :: Sing (Just x :: Maybe a)) -> sX------ Now GHC accepts the fact that `z` is `Just x`, and all is well. In order--- to support this construction, the type of singPat is augmented with some--- extra information in the form of SingDSigPaInfos:------ type SingDSigPaInfos = [(DExp, DType)]------ Where the DExps corresponds to the expressions we case on just after the--- patterns (`SJust sX :: Sing x`, in the example above), and the DTypes--- correspond to the singled pattern signatures to use in the case alternative--- (`Sing (Just x :: Maybe a)` in the example above). singPat appends to the--- list of SingDSigPaInfos whenever it processes a DSigPa (pattern signature),--- and call sites can pass these SingDSigPaInfos to mkSigPaCaseE to construct a--- case expression like the one featured above.------ Some interesting consequences of this design:------ 1. We must promote DPats to ADPats, a variation of DPat where the annotated--- DSigPa counterpart, ADSigPa, stores the type that the original DPat was--- promoted to. This is necessary since promoting the type might have--- generated fresh variable names, so we need to be able to use the same--- names when singling.------ 2. Also when promoting a DSigPa to an ADSigPa, we remove any wildcards from--- the underlying pattern. To see why this is necessary, consider singling--- this example:------ g (Just _ :: Maybe a) = "hi"------ This must single to something like this:------ sG (SJust _ :: Sing z)--- = case (SJust _ :: Sing z) of--- (_ :: Sing (Just _ :: Maybe a)) -> "hi"------ But `SJust _` is not a valid expression, and since the minimal th-desugar--- AST lacks as-patterns, we can't replace it with something like--- `sG x@(SJust _ :: Sing z) = case x of ...`. But even if the th-desugar--- AST /did/ have as-patterns, we'd still be in trouble, as `Just _` isn't--- a valid type without the use of -XPartialTypeSignatures, which isn't a--- design we want to force upon others.------ We work around both issues by simply converting all wildcard patterns--- from the pattern that has a signature. That means our example becomes:------ sG (SJust sWild :: Sing z)--- = case (SJust sWild :: Sing z) of--- (_ :: Sing (Just wild :: Maybe a)) -> "hi"------ And now everything is hunky-dory.--singExp :: ADExp -> Maybe DKind -- the kind of the expression, if known- -> SgM DExp- -- See Note [Why error is so special]-singExp (ADVarE err `ADAppE` arg) _res_ki- | err == errorName = DAppE (DVarE (singValName err)) <$>- singExp arg (Just (DConT symbolName))-singExp (ADVarE name) _res_ki = lookupVarE name-singExp (ADConE name) _res_ki = lookupConE name-singExp (ADLitE lit) _res_ki = singLit lit-singExp (ADAppE e1 e2) _res_ki = do- e1' <- singExp e1 Nothing- e2' <- singExp e2 Nothing- -- `applySing undefined x` kills type inference, because GHC can't figure- -- out the type of `undefined`. So we don't emit `applySing` there.- if isException e1'- then return $ e1' `DAppE` e2'- else return $ (DVarE applySingName) `DAppE` e1' `DAppE` e2'-singExp (ADLamE ty_names prom_lam names exp) _res_ki = do- let sNames = map singValName names- exp' <- singExp exp Nothing- -- we need to bind the type variables... but DLamE doesn't allow SigT patterns.- -- So: build a case- let caseExp = DCaseE (mkTupleDExp (map DVarE sNames))- [DMatch (mkTupleDPat- (map ((DWildPa `DSigPa`) .- (singFamily `DAppT`) .- DVarT) ty_names)) exp']- return $ wrapSingFun (length names) prom_lam $ DLamE sNames caseExp-singExp (ADCaseE exp matches ret_ty) res_ki =- -- See Note [Annotate case return type]- DSigE <$> (DCaseE <$> singExp exp Nothing <*> mapM (singMatch res_ki) matches)- <*> pure (singFamily `DAppT` (ret_ty `maybeSigT` res_ki))-singExp (ADLetE env exp) res_ki = do- -- We intentionally discard the SingI instances for exp's defunctionalization- -- symbols, as we also do not generate the declarations for the- -- defunctionalization symbols in the first place during promotion.- (let_decs, _, exp') <- singLetDecEnv env $ singExp exp res_ki- pure $ DLetE let_decs exp'-singExp (ADSigE prom_exp exp ty) _ = do- exp' <- singExp exp (Just ty)- pure $ DSigE exp' $ DConT singFamilyName `DAppT` DSigT prom_exp ty---- See Note [DerivedDecl]-singDerivedEqDecs :: DerivedEqDecl -> SgM [DDec]-singDerivedEqDecs (DerivedDecl { ded_mb_cxt = mb_ctxt- , ded_type = ty- , ded_decl = DataDecl _ _ cons }) = do- (scons, _) <- singM [] $ mapM singCtor cons- mb_sctxt <- mapM (mapM singPred) mb_ctxt- kind <- promoteType ty- sEqInst <- mkEqualityInstance mb_sctxt kind cons scons sEqClassDesc- -- Beware! The user might have specified an instance context like this:- --- -- deriving instance Eq a => Eq (T a Int)- --- -- When we single the context, it will become (SEq a). But we do *not* want- -- this for the SDecide instance! The simplest solution is to simply replace- -- all occurrences of SEq with SDecide in the context.- let mb_sctxtDecide = fmap (map sEqToSDecide) mb_sctxt- sDecideInst <- mkEqualityInstance mb_sctxtDecide kind cons scons sDecideClassDesc- return [sEqInst, sDecideInst]---- Walk a DPred, replacing all occurrences of SEq with SDecide.-sEqToSDecide :: DPred -> DPred-sEqToSDecide = modifyConNameDPred $ \n ->- -- Why don't we directly compare n to sEqClassName? Because n is almost certainly- -- produced from a call to singClassName, which uses unqualified Names. Ugh.- if nameBase n == nameBase sEqClassName- then sDecideClassName- else n---- See Note [DerivedDecl]-singDerivedShowDecs :: DerivedShowDecl -> SgM [DDec]-singDerivedShowDecs (DerivedDecl { ded_mb_cxt = mb_cxt- , ded_type = ty- , ded_decl = DataDecl _ _ cons }) = do- z <- qNewName "z"- -- Derive the Show instance for the singleton type, like this:- --- -- deriving instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b))- --- -- Be careful: we want to generate an instance context that uses ShowSing,- -- not SShow.- show_cxt <- inferConstraintsDef (fmap mkShowSingContext mb_cxt)- (DConPr showSingName)- ty cons- let show_inst = DStandaloneDerivD Nothing show_cxt- (DConT showName `DAppT` (singFamily `DAppT` DSigT (DVarT z) ty))- pure [show_inst]--isException :: DExp -> Bool-isException (DVarE n) = nameBase n == "sUndefined"-isException (DConE {}) = False-isException (DLitE {}) = False-isException (DAppE (DVarE fun) _) | nameBase fun == "sError" = True-isException (DAppE fun _) = isException fun-isException (DAppTypeE e _) = isException e-isException (DLamE _ _) = False-isException (DCaseE e _) = isException e-isException (DLetE _ e) = isException e-isException (DSigE e _) = isException e-isException (DStaticE e) = isException e--singMatch :: Maybe DKind -- ^ the result kind, if known- -> ADMatch -> SgM DMatch-singMatch res_ki (ADMatch var_proms pat exp) = do- (sPat, sigPaExpsSigs) <- evalForPair $ singPat (Map.fromList var_proms) pat- sExp <- singExp exp res_ki- return $ DMatch sPat $ mkSigPaCaseE sigPaExpsSigs sExp--singLit :: Lit -> SgM DExp-singLit (IntegerL n)- | n >= 0 = return $- DVarE sFromIntegerName `DAppE`- (DVarE singMethName `DSigE`- (singFamily `DAppT` DLitT (NumTyLit n)))- | otherwise = do sLit <- singLit (IntegerL (-n))- return $ DVarE sNegateName `DAppE` sLit-singLit (StringL str) = do- let sing_str_lit = DVarE singMethName `DSigE`- (singFamily `DAppT` DLitT (StrTyLit str))- os_enabled <- qIsExtEnabled LangExt.OverloadedStrings- pure $ if os_enabled- then DVarE sFromStringName `DAppE` sing_str_lit- else sing_str_lit-singLit lit =- fail ("Only string and natural number literals can be singled: " ++ show lit)--maybeSigT :: DType -> Maybe DKind -> DType-maybeSigT ty Nothing = ty-maybeSigT ty (Just ki) = ty `DSigT` ki
− src/Data/Singletons/Single/Data.hs
@@ -1,181 +0,0 @@-{- Data/Singletons/Single/Data.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--Singletonizes constructors.--}--{-# LANGUAGE ParallelListComp, TupleSections, LambdaCase #-}--module Data.Singletons.Single.Data where--import Language.Haskell.TH.Desugar-import Language.Haskell.TH.Syntax-import Data.Singletons.Single.Defun-import Data.Singletons.Single.Monad-import Data.Singletons.Single.Type-import Data.Singletons.Single.Fixity-import Data.Singletons.Promote.Type-import Data.Singletons.Util-import Data.Singletons.Names-import Data.Singletons.Syntax-import Control.Monad-import qualified Data.Set as Set-import Data.Set (Set)---- We wish to consider the promotion of "Rep" to be *--- not a promoted data constructor.-singDataD :: DataDecl -> SgM [DDec]-singDataD (DataDecl name tvbs ctors) = do- let tvbNames = map extractTvbName tvbs- k <- promoteType (foldType (DConT name) (map DVarT tvbNames))- ctors' <- mapM singCtor ctors- ctorFixities <-- -- try to reify the fixity declarations for the constructors and then- -- singletonize them. In case the reification fails, we default to an- -- empty list of singletonized fixity declarations.- -- why this works:- -- 1. if we're in a call to 'genSingletons', the data type was defined- -- earlier and its constructors are in scope, the reification succeeds.- -- 2. if we're in a call to 'singletons', the reification will fail, but- -- the fixity declaration will get singletonized by itself (not from- -- here, look for other invocations of 'singInfixDecl')- singFixityDeclarations [ n | DCon _ _ n _ _ <- ctors ]- -- instance for SingKind- fromSingClauses <- mapM mkFromSingClause ctors- emptyFromSingClause <- mkEmptyFromSingClause- toSingClauses <- mapM mkToSingClause ctors- emptyToSingClause <- mkEmptyToSingClause- let singKindInst =- DInstanceD Nothing- (map (singKindConstraint . DVarT) tvbNames)- (DAppT (DConT singKindClassName) k)- [ DTySynInstD demoteName $ DTySynEqn- [k]- (foldType (DConT name)- (map (DAppT demote . DVarT) tvbNames))- , DLetDec $ DFunD fromSingName- (fromSingClauses `orIfEmpty` [emptyFromSingClause])- , DLetDec $ DFunD toSingName- (toSingClauses `orIfEmpty` [emptyToSingClause]) ]-- -- e.g. type SNat = (Sing :: Nat -> Type)- let kindedSingTy = DArrowT `DAppT` k `DAppT` DConT typeKindName- kindedSynInst =- DTySynD (singTyConName name)- []- (singFamily `DSigT` kindedSingTy)-- return $ (DDataInstD Data [] singFamilyName [] (Just kindedSingTy) ctors' []) :- kindedSynInst :- singKindInst :- ctorFixities- where -- in the Rep case, the names of the constructors are in the wrong scope- -- (they're types, not datacons), so we have to reinterpret them.- mkConName :: Name -> SgM Name- mkConName- | nameBase name == nameBase repName = mkDataName . nameBase- | otherwise = return-- mkFromSingClause :: DCon -> SgM DClause- mkFromSingClause c = do- let (cname, numArgs) = extractNameArgs c- cname' <- mkConName cname- varNames <- replicateM numArgs (qNewName "b")- return $ DClause [DConPa (singDataConName cname) (map DVarPa varNames)]- (foldExp- (DConE cname')- (map (DAppE (DVarE fromSingName) . DVarE) varNames))-- mkToSingClause :: DCon -> SgM DClause- mkToSingClause (DCon _tvbs _cxt cname fields _rty) = do- let types = tysOfConFields fields- varNames <- mapM (const $ qNewName "b") types- svarNames <- mapM (const $ qNewName "c") types- promoted <- mapM promoteType types- cname' <- mkConName cname- let varPats = zipWith mkToSingVarPat varNames promoted- recursiveCalls = zipWith mkRecursiveCall varNames promoted- return $- DClause [DConPa cname' varPats]- (multiCase recursiveCalls- (map (DConPa someSingDataName . listify . DVarPa)- svarNames)- (DAppE (DConE someSingDataName)- (foldExp (DConE (singDataConName cname))- (map DVarE svarNames))))-- mkToSingVarPat :: Name -> DKind -> DPat- mkToSingVarPat varName ki =- DSigPa (DVarPa varName) (DAppT (DConT demoteName) ki)-- mkRecursiveCall :: Name -> DKind -> DExp- mkRecursiveCall var_name ki =- DSigE (DAppE (DVarE toSingName) (DVarE var_name))- (DAppT (DConT someSingTypeName) ki)-- mkEmptyFromSingClause :: SgM DClause- mkEmptyFromSingClause = do- x <- qNewName "x"- pure $ DClause [DVarPa x]- $ DCaseE (DVarE x) []-- mkEmptyToSingClause :: SgM DClause- mkEmptyToSingClause = do- x <- qNewName "x"- pure $ DClause [DVarPa x]- $ DConE someSingDataName `DAppE` DCaseE (DVarE x) []---- refine a constructor.-singCtor :: DCon -> SgM DCon- -- polymorphic constructors are handled just- -- like monomorphic ones -- the polymorphism in- -- the kind is automatic-singCtor (DCon _tvbs cxt name fields rty)- | not (null cxt)- = fail "Singling of constrained constructors not yet supported"- | otherwise- = do- let types = tysOfConFields fields- sName = singDataConName name- sCon = DConE sName- pCon = DConT name- indexNames <- mapM (const $ qNewName "n") types- let indices = map DVarT indexNames- kinds <- mapM promoteType types- let bound_kvs = foldMap fvDType kinds- args <- zipWithM (buildArgType bound_kvs) types indices- rty' <- promoteType rty- let tvbs = map DPlainTV (Set.toList bound_kvs) ++ zipWith DKindedTV indexNames kinds- kindedIndices = zipWith DSigT indices kinds-- -- SingI instance for data constructor- emitDecs- [DInstanceD Nothing- (map (DAppPr (DConPr singIName)) indices)- (DAppT (DConT singIName)- (foldType pCon kindedIndices))- [DLetDec $ DValD (DVarPa singMethName)- (foldExp sCon (map (const $ DVarE singMethName) types))]]- -- SingI instances for defunctionalization symbols. Note that we don't- -- support contexts in constructors at the moment, so it's fine for now to- -- just assume that the context is always ().- emitDecs =<< singDefuns name DataName [] (map Just kinds) (Just rty')-- let noBang = Bang NoSourceUnpackedness NoSourceStrictness- conFields = case fields of- DNormalC dInfix _ -> DNormalC dInfix $ map (noBang,) args- DRecC rec_fields ->- DRecC [ (singValName field_name, noBang, arg)- | (field_name, _, _) <- rec_fields- | arg <- args ]- return $ DCon tvbs- []- sName- conFields- (DConT singFamilyName `DAppT` foldType pCon indices)- where buildArgType :: Set Name -> DType -> DType -> SgM DType- buildArgType bound_kvs ty index = do- (ty', _, _, _, _, _) <- singType bound_kvs index ty- return ty'
− src/Data/Singletons/Single/Defun.hs
@@ -1,213 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.Single.Defun--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Creates 'SingI' instances for promoted types' defunctionalization symbols.-----------------------------------------------------------------------------------module Data.Singletons.Single.Defun (singDefuns) where--import Data.List-import Data.Singletons.Names-import Data.Singletons.Promote.Defun-import Data.Singletons.Single.Monad-import Data.Singletons.Single.Type-import Data.Singletons.Util-import Language.Haskell.TH.Desugar-import Language.Haskell.TH.Syntax---- Given the Name of something, take the defunctionalization symbols for its--- promoted counterpart and create SingI instances for them. As a concrete--- example, if you have:------ foo :: Eq a => a -> a -> Bool------ Then foo's promoted counterpart, Foo, will have two defunctionalization--- symbols:------ FooSym0 :: a ~> a ~> Bool--- FooSym1 :: a -> a ~> Bool------ We can declare SingI instances for these two symbols like so:------ instance SEq a => SingI (FooSym0 :: a ~> a ~> Bool) where--- sing = singFun2 sFoo------ instance (SEq a, SingI x) => SingI (FooSym1 x :: a ~> Bool) where--- sing = singFun1 (sFoo (sing @_ @x))------ Note that singDefuns takes Maybe DKinds for the promoted argument and result--- types, in case we have an entity whose type needs to be inferred.--- See Note [singDefuns and type inference].------ Note that in the particular case of a data constructor, we actually generate--- /two/ SingI instances partial application—one for the defunctionalization--- symbol, and one for the data constructor placed inside TyCon{N}.--- See Note [SingI instances for partially applied constructors].-singDefuns :: Name -- The Name of the thing to promote.- -> NameSpace -- Whether the above Name is a value, data constructor,- -- or a type constructor.- -- See Note [SingI instances for partially applied constructors]- -> DCxt -- The type's context.- -> [Maybe DKind] -- The promoted argument types (if known).- -> Maybe DKind -- The promoted result type (if known).- -> SgM [DDec]-singDefuns n ns ty_ctxt mb_ty_args mb_ty_res =- case mb_ty_args of- [] -> pure [] -- If a function has no arguments, then it has no- -- defunctionalization symbols, so there's nothing to be done.- _ -> do sty_ctxt <- mapM singPred ty_ctxt- go 0 sty_ctxt [] mb_ty_args- where- num_ty_args :: Int- num_ty_args = length mb_ty_args-- -- Sadly, this algorithm is quadratic, because in each iteration of the loop- -- we must:- --- -- * Construct an arrow type of the form (a ~> ... ~> z), using a suffix of- -- the promoted argument types.- -- * Append a new type variable to the end of an ordered list.- --- -- In practice, this is unlikely to be a bottleneck, as singletons does not- -- support functions with more than 7 or so arguments anyways.- go :: Int -> DCxt -> [DTyVarBndr] -> [Maybe DKind] -> SgM [DDec]- go sym_num sty_ctxt tvbs mb_tyss- | sym_num < num_ty_args- , mb_ty:mb_tys <- mb_tyss- = do new_tvb_name <- qNewName "d"- let new_tvb = inferMaybeKindTV new_tvb_name mb_ty- insts <- go (sym_num + 1) sty_ctxt (tvbs ++ [new_tvb]) mb_tys- pure $ new_insts ++ insts- | otherwise- = pure []- where- sing_fun_num :: Int- sing_fun_num = num_ty_args - sym_num-- mk_sing_fun_expr :: DExp -> DExp- mk_sing_fun_expr sing_expr =- foldl' (\f tvb_n -> f `DAppE` (DVarE singMethName `DAppTypeE` DVarT tvb_n))- sing_expr- (map extractTvbName tvbs)-- singI_ctxt :: DCxt- singI_ctxt = map (DAppPr (DConPr singIName) . tvbToType) tvbs-- mk_inst_ty :: DType -> DType- mk_inst_ty inst_head- = case mb_inst_kind of- Just inst_kind -> inst_head `DSigT` inst_kind- Nothing -> inst_head-- tvb_tys :: [DType]- tvb_tys = map dTyVarBndrToDType tvbs-- -- Construct the arrow kind used to annotate the defunctionalization- -- symbol (e.g., the `a ~> a ~> Bool` in- -- `SingI (FooSym0 :: a ~> a ~> Bool)`).- -- If any of the argument kinds or result kind isn't known (i.e., is- -- Nothing), then we opt not to construct this arrow kind altogether.- -- See Note [singDefuns and type inference]- mb_inst_kind :: Maybe DType- mb_inst_kind = foldr buildTyFunArrow_maybe mb_ty_res mb_tyss-- new_insts :: [DDec]- new_insts- | DataName <- ns- = -- See Note [SingI instances for partially applied constructors]- let s_data_con = DConE $ singDataConName n in- [ mk_inst defun_inst_ty s_data_con- , mk_inst tycon_inst_ty s_data_con ]- | otherwise- = [mk_inst defun_inst_ty $ DVarE $ singValName n]- where- mk_inst :: DType -> DExp -> DDec- mk_inst inst_head sing_exp- = DInstanceD Nothing- (sty_ctxt ++ singI_ctxt)- (DConT singIName `DAppT` mk_inst_ty inst_head)- [DLetDec $ DValD (DVarPa singMethName)- $ wrapSingFun sing_fun_num inst_head- $ mk_sing_fun_expr sing_exp ]-- defun_inst_ty, tycon_inst_ty :: DType- defun_inst_ty = foldType (DConT (promoteTySym n sym_num)) tvb_tys- tycon_inst_ty = DConT (mkTyConName sing_fun_num) `DAppT`- foldType (DConT n) tvb_tys--{--Note [singDefuns and type inference]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider the following function:-- foo :: a -> Bool- foo _ = True--singDefuns would give the following SingI instance for FooSym0, with an-explicit kind signature:-- instance SingI (FooSym0 :: a ~> Bool) where ...--What happens if we leave off the type signature for foo?-- foo _ = True--Can singDefuns still do its job? Yes! It will simply generate:-- instance SingI FooSym0 where ...--In general, if any of the promoted argument or result types given to singDefun-are Nothing, then we avoid crafting an explicit kind signature. You might worry-that this could lead to SingI instances being generated that GHC cannot infer-the type for, such as:-- bar x = x == x- ==>- instance SingI BarSym0 -- Missing an SEq constraint?--This is true, but also not unprecedented, as the singled version of bar, sBar,-will /also/ fail to typecheck due to a missing SEq constraint. Therefore, this-design choice fits within the existing tradition of type inference in-singletons.--Note [SingI instances for partially applied constructors]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Unlike normal functions, where we generate one SingI instance for each of its-partial applications (one per defunctionalization symbol), we generate *two*-SingI instances for each partial application of a data constructor. That is,-if we have:-- data D a where- K :: a -> D a--K has an partial application, so we will generate the following two SingI-instances:-- instance SingI KSym0 where sing = singFun1 SK- instance SingI (TyCon1 KSym0) where sing = singFun1 SK--The first instance is exactly the same as what we'd generate for a normal,-partially applied function's defun symbol. The second one, while functionally-equivalent, is a bit dissatisfying: in general, adopting this approach means-that we end up generating many instances of the form:-- instance SingI (TyCon1 S1)- instance SingI (TyCon1 S2)- ...--Ideally, we'd have a single instance SingI (TyCon1 s) to rule them all. But-doing so would require writing something akin to:-- instance (forall a. SingI a => SingI (f a)) => SingI (TyCon1 f) where- sing = SLambda $ \(x :: Sing a) -> withSingI x $ sing @_ @(f a)--But this would require quantified constraints. Until GHC gains these, we-compensate by generating out several SingI (TyCon1 s) instances.--}
− src/Data/Singletons/Single/Eq.hs
@@ -1,120 +0,0 @@-{- Data/Singletons/Single/Eq.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--Defines functions to generate SEq and SDecide instances.--}--module Data.Singletons.Single.Eq where--import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Desugar-import Data.Singletons.Deriving.Infer-import Data.Singletons.Util-import Data.Singletons.Names-import Control.Monad---- making the SEq instance and the SDecide instance are rather similar,--- so we generalize-type EqualityClassDesc q = ((DCon, DCon) -> q DClause, q DClause, Name, Name)-sEqClassDesc, sDecideClassDesc :: Quasi q => EqualityClassDesc q-sEqClassDesc = (mkEqMethClause, mkEmptyEqMethClause, sEqClassName, sEqMethName)-sDecideClassDesc = (mkDecideMethClause, mkEmptyDecideMethClause, sDecideClassName, sDecideMethName)--mkEqualityInstance :: DsMonad q => Maybe DCxt -> DKind- -> [DCon] -- ^ The /original/ constructors (for inferring the instance context)- -> [DCon] -- ^ The /singletons/ constructors- -> EqualityClassDesc q -> q DDec-mkEqualityInstance mb_ctxt k ctors sctors (mkMeth, mkEmpty, className, methName) = do- let sctorPairs = [ (sc1, sc2) | sc1 <- sctors, sc2 <- sctors ]- methClauses <- if null sctors- then (:[]) <$> mkEmpty- else mapM mkMeth sctorPairs- constraints <- inferConstraintsDef mb_ctxt (DConPr className) k ctors- return $ DInstanceD Nothing- constraints- (DAppT (DConT className) k)- [DLetDec $ DFunD methName methClauses]--mkEqMethClause :: Quasi q => (DCon, DCon) -> q DClause-mkEqMethClause (c1, c2)- | lname == rname = do- lnames <- replicateM lNumArgs (qNewName "a")- rnames <- replicateM lNumArgs (qNewName "b")- let lpats = map DVarPa lnames- rpats = map DVarPa rnames- lvars = map DVarE lnames- rvars = map DVarE rnames- return $ DClause- [DConPa lname lpats, DConPa rname rpats]- (allExp (zipWith (\l r -> foldExp (DVarE sEqMethName) [l, r])- lvars rvars))- | otherwise =- return $ DClause- [DConPa lname (replicate lNumArgs DWildPa),- DConPa rname (replicate rNumArgs DWildPa)]- (DConE $ singDataConName falseName)- where allExp :: [DExp] -> DExp- allExp [] = DConE $ singDataConName trueName- allExp [one] = one- allExp (h:t) = DAppE (DAppE (DVarE $ singValName andName) h) (allExp t)-- (lname, lNumArgs) = extractNameArgs c1- (rname, rNumArgs) = extractNameArgs c2--mkEmptyEqMethClause :: Applicative q => q DClause-mkEmptyEqMethClause =- pure $ DClause [DWildPa, DWildPa]- $ DConE strueName--mkDecideMethClause :: Quasi q => (DCon, DCon) -> q DClause-mkDecideMethClause (c1, c2)- | lname == rname =- if lNumArgs == 0- then return $ DClause [DConPa lname [], DConPa rname []]- (DAppE (DConE provedName) (DConE reflName))- else do- lnames <- replicateM lNumArgs (qNewName "a")- rnames <- replicateM lNumArgs (qNewName "b")- contra <- qNewName "contra"- let lpats = map DVarPa lnames- rpats = map DVarPa rnames- lvars = map DVarE lnames- rvars = map DVarE rnames- refl <- qNewName "refl"- return $ DClause- [DConPa lname lpats, DConPa rname rpats]- (DCaseE (mkTupleDExp $- zipWith (\l r -> foldExp (DVarE sDecideMethName) [l, r])- lvars rvars)- ((DMatch (mkTupleDPat (replicate lNumArgs- (DConPa provedName [DConPa reflName []])))- (DAppE (DConE provedName) (DConE reflName))) :- [DMatch (mkTupleDPat (replicate i DWildPa ++- DConPa disprovedName [DVarPa contra] :- replicate (lNumArgs - i - 1) DWildPa))- (DAppE (DConE disprovedName)- (DLamE [refl] $- DCaseE (DVarE refl)- [DMatch (DConPa reflName []) $- (DAppE (DVarE contra)- (DConE reflName))]))- | i <- [0..lNumArgs-1] ]))-- | otherwise = do- x <- qNewName "x"- return $ DClause- [DConPa lname (replicate lNumArgs DWildPa),- DConPa rname (replicate rNumArgs DWildPa)]- (DAppE (DConE disprovedName) (DLamE [x] (DCaseE (DVarE x) [])))-- where- (lname, lNumArgs) = extractNameArgs c1- (rname, rNumArgs) = extractNameArgs c2--mkEmptyDecideMethClause :: Quasi q => q DClause-mkEmptyDecideMethClause = do- x <- qNewName "x"- pure $ DClause [DVarPa x, DWildPa]- $ DConE provedName `DAppE` DCaseE (DVarE x) []
− src/Data/Singletons/Single/Fixity.hs
@@ -1,33 +0,0 @@-module Data.Singletons.Single.Fixity where--import Prelude hiding ( exp )-import Language.Haskell.TH hiding ( cxt )-import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..))-import Data.Singletons.Util-import Data.Singletons.Names-import Language.Haskell.TH.Desugar--singInfixDecl :: DsMonad q => Name -> Fixity -> q DLetDec-singInfixDecl name fixity = do- mb_ns <- reifyNameSpace name- pure $ DInfixD fixity- $ case mb_ns of- Just TcClsName -> singTyConName name- Just DataName -> singDataConName name- Just VarName -> singValName name- -- If we can't find the Name for some odd reason,- -- fall back to singValName- Nothing -> singValName name--singFixityDeclaration :: DsMonad q => Name -> q [DDec]-singFixityDeclaration name = do- mFixity <- qReifyFixity name- case mFixity of- Nothing -> pure []- Just fixity -> sequenceA [DLetDec <$> singInfixDecl name fixity]--singFixityDeclarations :: DsMonad q => [Name] -> q [DDec]-singFixityDeclarations = concatMapM trySingFixityDeclaration- where- trySingFixityDeclaration name =- qRecover (return []) (singFixityDeclaration name)
− src/Data/Singletons/Single/Monad.hs
@@ -1,217 +0,0 @@-{- Data/Singletons/Single/Monad.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--This file defines the SgM monad and its operations, for use during singling.--The SgM monad allows reading from a SgEnv environment and is wrapped around a Q.--}--{-# LANGUAGE GeneralizedNewtypeDeriving, ParallelListComp, TemplateHaskell #-}--module Data.Singletons.Single.Monad (- SgM, bindLets, bindContext, askContext, lookupVarE, lookupConE,- wrapSingFun, wrapUnSingFun,- singM, singDecsM,- emitDecs, emitDecsM- ) where--import Prelude hiding ( exp )-import Data.Map ( Map )-import qualified Data.Map as Map-import Data.Singletons.Promote.Monad ( emitDecs, emitDecsM )-import Data.Singletons.Names-import Data.Singletons.Util-import Data.Singletons.Internal-import Language.Haskell.TH.Syntax hiding ( lift )-import Language.Haskell.TH.Desugar-import Control.Monad.Reader-import Control.Monad.Writer-import Control.Applicative-import Control.Monad.Fail---- environment during singling-data SgEnv =- SgEnv { sg_let_binds :: Map Name DExp -- from the *original* name- , sg_context :: DCxt -- See Note [Tracking the current type signature context]- , sg_local_decls :: [Dec]- }--emptySgEnv :: SgEnv-emptySgEnv = SgEnv { sg_let_binds = Map.empty- , sg_context = []- , sg_local_decls = []- }---- the singling monad-newtype SgM a = SgM (ReaderT SgEnv (WriterT [DDec] Q) a)- deriving ( Functor, Applicative, Monad- , MonadReader SgEnv, MonadWriter [DDec]- , MonadFail, MonadIO )--liftSgM :: Q a -> SgM a-liftSgM = SgM . lift . lift--instance Quasi SgM where- qNewName = liftSgM `comp1` qNewName- qReport = liftSgM `comp2` qReport- qLookupName = liftSgM `comp2` qLookupName- qReify = liftSgM `comp1` qReify- qReifyInstances = liftSgM `comp2` qReifyInstances- qLocation = liftSgM qLocation- qRunIO = liftSgM `comp1` qRunIO- qAddDependentFile = liftSgM `comp1` qAddDependentFile- qReifyRoles = liftSgM `comp1` qReifyRoles- qReifyAnnotations = liftSgM `comp1` qReifyAnnotations- qReifyModule = liftSgM `comp1` qReifyModule- qAddTopDecls = liftSgM `comp1` qAddTopDecls- qAddModFinalizer = liftSgM `comp1` qAddModFinalizer- qGetQ = liftSgM qGetQ- qPutQ = liftSgM `comp1` qPutQ-- qReifyFixity = liftSgM `comp1` qReifyFixity- qReifyConStrictness = liftSgM `comp1` qReifyConStrictness- qIsExtEnabled = liftSgM `comp1` qIsExtEnabled- qExtsEnabled = liftSgM qExtsEnabled- qAddForeignFilePath = liftSgM `comp2` qAddForeignFilePath- qAddTempFile = liftSgM `comp1` qAddTempFile- qAddCorePlugin = liftSgM `comp1` qAddCorePlugin-- qRecover (SgM handler) (SgM body) = do- env <- ask- (result, aux) <- liftSgM $- qRecover (runWriterT $ runReaderT handler env)- (runWriterT $ runReaderT body env)- tell aux- return result--instance DsMonad SgM where- localDeclarations = asks sg_local_decls--bindLets :: [(Name, DExp)] -> SgM a -> SgM a-bindLets lets1 =- local (\env@(SgEnv { sg_let_binds = lets2 }) ->- env { sg_let_binds = (Map.fromList lets1) `Map.union` lets2 })---- Add some constraints to the current type signature context.--- See Note [Tracking the current type signature context]-bindContext :: DCxt -> SgM a -> SgM a-bindContext ctxt1- = local (\env@(SgEnv { sg_context = ctxt2 }) ->- env { sg_context = ctxt1 ++ ctxt2 })---- Retrieve the current type signature context.--- See Note [Tracking the current type signature context]-askContext :: SgM DCxt-askContext = asks sg_context--lookupVarE :: Name -> SgM DExp-lookupVarE = lookup_var_con singValName (DVarE . singValName)--lookupConE :: Name -> SgM DExp-lookupConE = lookup_var_con singDataConName (DConE . singDataConName)--lookup_var_con :: (Name -> Name) -> (Name -> DExp) -> Name -> SgM DExp-lookup_var_con mk_sing_name mk_exp name = do- letExpansions <- asks sg_let_binds- sName <- mkDataName (nameBase (mk_sing_name name)) -- we want *term* names!- case Map.lookup name letExpansions of- Nothing -> do- -- try to get it from the global context- m_dinfo <- liftM2 (<|>) (dsReify sName) (dsReify name)- -- try the unrefined name too -- it's needed to bootstrap Enum- case m_dinfo of- Just (DVarI _ ty _) ->- let num_args = countArgs ty in- return $ wrapSingFun num_args (promoteValRhs name) (mk_exp name)- _ -> return $ mk_exp name -- lambda-bound- Just exp -> return exp--wrapSingFun :: Int -> DType -> DExp -> DExp-wrapSingFun 0 _ = id-wrapSingFun n ty =- let wrap_fun = DVarE $ case n of- 1 -> 'singFun1- 2 -> 'singFun2- 3 -> 'singFun3- 4 -> 'singFun4- 5 -> 'singFun5- 6 -> 'singFun6- 7 -> 'singFun7- _ -> error "No support for functions of arity > 7."- in- (wrap_fun `DAppTypeE` ty `DAppE`)--wrapUnSingFun :: Int -> DType -> DExp -> DExp-wrapUnSingFun 0 _ = id-wrapUnSingFun n ty =- let unwrap_fun = DVarE $ case n of- 1 -> 'unSingFun1- 2 -> 'unSingFun2- 3 -> 'unSingFun3- 4 -> 'unSingFun4- 5 -> 'unSingFun5- 6 -> 'unSingFun6- 7 -> 'unSingFun7- _ -> error "No support for functions of arity > 7."- in- (unwrap_fun `DAppTypeE` ty `DAppE`)--singM :: DsMonad q => [Dec] -> SgM a -> q (a, [DDec])-singM locals (SgM rdr) = do- other_locals <- localDeclarations- let wr = runReaderT rdr (emptySgEnv { sg_local_decls = other_locals ++ locals })- q = runWriterT wr- runQ q--singDecsM :: DsMonad q => [Dec] -> SgM [DDec] -> q [DDec]-singDecsM locals thing = do- (decs1, decs2) <- singM locals thing- return $ decs1 ++ decs2--{--Note [Tracking the current type signature context]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Much like we track the let-bound names in scope, we also track the current-context. For instance, in the following program:-- -- (1)- f :: forall a. Show a => a -> String -> Bool- f x y = g (show x) y- where- -- (2)- g :: forall b. Eq b => b -> b -> Bool- g = h- where- -- (3)- h :: b -> b -> Bool- h = (==)--Here is the context at various points:--(1) ()-(2) (Show a)-(3) (Show a, Eq b)--We track this informating during singling instead of during promotion, as the-promoted versions of things are often type families, which do not have-contexts.--Why do we bother tracking this at all? Ultimately, because singDefuns (from-Data.Singletons.Single.Defun) needs to know the current context in order to-generate a correctly typed SingI instance. For instance, if you called-singDefuns on the class method bar:-- class Foo a where- bar :: Eq a => a -> Bool--Then if you only grabbed the context of `bar` itself, then you'd end up-generating the following SingI instance for BarSym0:-- instance SEq a => SingI (FooSym0 :: a ~> Bool) where ...--Which is incorrect—there needs to be an (SFoo a) constraint as well! If we-track the current context when singling Foo, then we will correctly propagate-this information to singDefuns.--}
− src/Data/Singletons/Single/Type.hs
@@ -1,69 +0,0 @@-{- Data/Singletons/Single/Type.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--Singletonizes types.--}--module Data.Singletons.Single.Type where--import Language.Haskell.TH.Desugar-import Language.Haskell.TH.Syntax-import Data.Singletons.Names-import Data.Singletons.Single.Monad-import Data.Singletons.Promote.Type-import Data.Singletons.Util-import Control.Monad-import qualified Data.Set as Set-import Data.Set (Set)--singType :: Set Name -- the set of bound kind variables in this scope- -- see Note [Explicitly binding kind variables]- -- in Data.Singletons.Promote.Monad- -> DType -- the promoted version of the thing classified by...- -> DType -- ... this type- -> SgM ( DType -- the singletonized type- , Int -- the number of arguments- , [Name] -- the names of the tyvars used in the sing'd type- , DCxt -- the context of the singletonized type- , [DKind] -- the kinds of the argument types- , DKind ) -- the kind of the result type-singType bound_kvs prom ty = do- let (_, cxt, args, res) = unravel ty- num_args = length args- cxt' <- mapM singPred cxt- arg_names <- replicateM num_args (qNewName "t")- prom_args <- mapM promoteType args- prom_res <- promoteType res- let args' = map (\n -> singFamily `DAppT` (DVarT n)) arg_names- res' = singFamily `DAppT` (foldl apply prom (map DVarT arg_names) `DSigT` prom_res)- tau = ravel args' res'- -- Make sure to subtract out the bound variables currently in scope, lest we- -- accidentally shadow them in this type signature.- kv_names_to_bind = foldMap fvDType (prom_args ++ map predToType cxt' ++ [prom_res])- Set.\\ bound_kvs- kvs_to_bind = Set.toList kv_names_to_bind- let ty' = DForallT (map DPlainTV kvs_to_bind ++ zipWith DKindedTV arg_names prom_args)- cxt' tau- return (ty', num_args, arg_names, cxt, prom_args, prom_res)--singPred :: DPred -> SgM DPred-singPred = singPredRec []--singPredRec :: [DType] -> DPred -> SgM DPred-singPredRec _cxt (DForallPr {}) =- fail "Singling of quantified constraints not yet supported"-singPredRec ctx (DAppPr pr ty) = singPredRec (ty : ctx) pr-singPredRec _ctx (DSigPr _pr _ki) =- fail "Singling of constraints with explicit kinds not yet supported"-singPredRec _ctx (DVarPr _n) =- fail "Singling of contraint variables not yet supported"-singPredRec ctx (DConPr n)- | n == equalityName- = fail "Singling of type equality constraints not yet supported"- | otherwise = do- kis <- mapM promoteType ctx- let sName = singClassName n- return $ foldPred (DConPr sName) kis-singPredRec _ctx DWildCardPr = return DWildCardPr -- it just might work
− src/Data/Singletons/SuppressUnusedWarnings.hs
@@ -1,18 +0,0 @@--- Data/Singletons/SuppressUnusedWarnings.hs------ (c) Richard Eisenberg 2014--- rae@cs.brynmawr.edu------ This declares user-oriented exports that are actually meant to be hidden--- from the user. Why would anyone ever want this? Because what is below--- is dirty, and no one wants to see it.--{-# LANGUAGE AllowAmbiguousTypes, PolyKinds #-}--module Data.Singletons.SuppressUnusedWarnings where---- | This class (which users should never see) is to be instantiated in order--- to use an otherwise-unused data constructor, such as the "kind-inference"--- data constructor for defunctionalization symbols.-class SuppressUnusedWarnings (t :: k) where- suppressUnusedWarnings :: ()
− src/Data/Singletons/Syntax.hs
@@ -1,237 +0,0 @@-{- Data/Singletons/Syntax.hs--(c) Richard Eisenberg 2014-rae@cs.brynmawr.edu--Converts a list of DLetDecs into a LetDecEnv for easier processing,-and contains various other AST definitions.--}--{-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, DeriveDataTypeable,- StandaloneDeriving, FlexibleInstances, ConstraintKinds #-}--module Data.Singletons.Syntax where--import Prelude hiding ( exp )-import Data.Kind (Constraint, Type)-import Language.Haskell.TH.Syntax hiding (Type)-import Language.Haskell.TH.Desugar-import Data.Map.Strict ( Map )-import qualified Data.Map.Strict as Map-import Data.Set ( Set )-import Data.Semigroup (Semigroup(..))--type VarPromotions = [(Name, Name)] -- from term-level name to type-level name---- Information that is accumulated when promoting patterns.-data PromDPatInfos = PromDPatInfos- { prom_dpat_vars :: VarPromotions- -- Maps term-level pattern variables to their promoted, type-level counterparts.- , prom_dpat_sig_kvs :: Set Name- -- Kind variables bound by DSigPas.- -- See Note [Explicitly binding kind variables] in Data.Singletons.Promote.Monad- }--instance Semigroup PromDPatInfos where- PromDPatInfos vars1 sig_kvs1 <> PromDPatInfos vars2 sig_kvs2- = PromDPatInfos (vars1 <> vars2) (sig_kvs1 <> sig_kvs2)--instance Monoid PromDPatInfos where- mempty = PromDPatInfos mempty mempty---- A list of 'SingDSigPaInfos' is produced when singling pattern signatures, as we--- must case on the 'DExp's and match on them using the supplied 'DType's to--- bring the necessary singleton equality constraints into scope.--- See @Note [Singling pattern signatures]@.-type SingDSigPaInfos = [(DExp, DType)]---- The parts of data declarations that are relevant to singletons.-data DataDecl = DataDecl Name [DTyVarBndr] [DCon]---- The parts of type synonyms that are relevant to singletons.-data TySynDecl = TySynDecl Name [DTyVarBndr]---- The parts of open type families that are relevant to singletons.-type OpenTypeFamilyDecl = TypeFamilyDecl 'Open---- The parts of closed type families that are relevant to singletons.-type ClosedTypeFamilyDecl = TypeFamilyDecl 'Closed---- The parts of type families that are relevant to singletons.-newtype TypeFamilyDecl (info :: FamilyInfo)- = TypeFamilyDecl { getTypeFamilyDecl :: DTypeFamilyHead }--- Whether a type family is open or closed.-data FamilyInfo = Open | Closed--data ClassDecl ann = ClassDecl { cd_cxt :: DCxt- , cd_name :: Name- , cd_tvbs :: [DTyVarBndr]- , cd_fds :: [FunDep]- , cd_lde :: LetDecEnv ann- }--data InstDecl ann = InstDecl { id_cxt :: DCxt- , id_name :: Name- , id_arg_tys :: [DType]- , id_sigs :: Map Name DType- , id_meths :: [(Name, LetDecRHS ann)] }--type UClassDecl = ClassDecl Unannotated-type UInstDecl = InstDecl Unannotated--type AClassDecl = ClassDecl Annotated-type AInstDecl = InstDecl Annotated--{--We see below several datatypes beginning with "A". These are annotated structures,-necessary for Promote to communicate key things to Single. In particular, promotion-of expressions is *not* deterministic, due to the necessity to create unique names-for lets, cases, and lambdas. So, we put these promotions into an annotated AST-so that Single can use the right promotions.--}---- A DExp with let, lambda, and type-signature nodes annotated with their--- type-level equivalents-data ADExp = ADVarE Name- | ADConE Name- | ADLitE Lit- | ADAppE ADExp ADExp- | ADLamE [Name] -- type-level names corresponding to term-level ones- DType -- the promoted lambda- [Name] ADExp- | ADCaseE ADExp [ADMatch] DType- -- the type is the return type- | ADLetE ALetDecEnv ADExp- | ADSigE DType -- the promoted expression- ADExp DType---- A DPat with a pattern-signature node annotated with its type-level equivalent-data ADPat = ADLitPa Lit- | ADVarPa Name- | ADConPa Name [ADPat]- | ADTildePa ADPat- | ADBangPa ADPat- | ADSigPa DType -- The promoted pattern. Will not contain any wildcards,- -- as per Note [Singling pattern signatures]- ADPat DType- | ADWildPa--data ADMatch = ADMatch VarPromotions ADPat ADExp-data ADClause = ADClause VarPromotions- [ADPat] ADExp--data AnnotationFlag = Annotated | Unannotated---- These are used at the type-level exclusively-type Annotated = 'Annotated-type Unannotated = 'Unannotated--type family IfAnn (ann :: AnnotationFlag) (yes :: k) (no :: k) :: k where- IfAnn Annotated yes no = yes- IfAnn Unannotated yes no = no--data family LetDecRHS :: AnnotationFlag -> Type-data instance LetDecRHS Annotated- = AFunction DType -- promote function (unapplied)- Int -- number of arrows in type- [ADClause]- | AValue DType -- promoted exp- Int -- number of arrows in type- ADExp-data instance LetDecRHS Unannotated = UFunction [DClause]- | UValue DExp--type ALetDecRHS = LetDecRHS Annotated-type ULetDecRHS = LetDecRHS Unannotated--data LetDecEnv ann = LetDecEnv- { lde_defns :: Map Name (LetDecRHS ann)- , lde_types :: Map Name DType -- type signatures- , lde_infix :: Map Name Fixity -- infix declarations- , lde_proms :: IfAnn ann (Map Name DType) () -- possibly, promotions- , lde_bound_kvs :: IfAnn ann (Map Name (Set Name)) ()- -- The set of bound variables in scope.- -- See Note [Explicitly binding kind variables]- -- in Data.Singletons.Promote.Monad- }-type ALetDecEnv = LetDecEnv Annotated-type ULetDecEnv = LetDecEnv Unannotated--instance Semigroup ULetDecEnv where- LetDecEnv defns1 types1 infx1 _ _ <> LetDecEnv defns2 types2 infx2 _ _ =- LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () ()--instance Monoid ULetDecEnv where- mempty = LetDecEnv Map.empty Map.empty Map.empty () ()--valueBinding :: Name -> ULetDecRHS -> ULetDecEnv-valueBinding n v = emptyLetDecEnv { lde_defns = Map.singleton n v }--typeBinding :: Name -> DType -> ULetDecEnv-typeBinding n t = emptyLetDecEnv { lde_types = Map.singleton n t }--infixDecl :: Fixity -> Name -> ULetDecEnv-infixDecl f n = emptyLetDecEnv { lde_infix = Map.singleton n f }--emptyLetDecEnv :: ULetDecEnv-emptyLetDecEnv = mempty--buildLetDecEnv :: Quasi q => [DLetDec] -> q ULetDecEnv-buildLetDecEnv = go emptyLetDecEnv- where- go acc [] = return acc- go acc (DFunD name clauses : rest) =- go (valueBinding name (UFunction clauses) <> acc) rest- go acc (DValD (DVarPa name) exp : rest) =- go (valueBinding name (UValue exp) <> acc) rest- go acc (dec@(DValD {}) : rest) = do- flattened <- flattenDValD dec- go acc (flattened ++ rest)- go acc (DSigD name ty : rest) =- go (typeBinding name ty <> acc) rest- go acc (DInfixD f n : rest) =- go (infixDecl f n <> acc) rest- go acc (DPragmaD{} : rest) = go acc rest---- See Note [DerivedDecl]-data DerivedDecl (cls :: Type -> Constraint) = DerivedDecl- { ded_mb_cxt :: Maybe DCxt- , ded_type :: DType- , ded_decl :: DataDecl- }--type DerivedEqDecl = DerivedDecl Eq-type DerivedShowDecl = DerivedDecl Show--{- Note [DerivedDecl]-~~~~~~~~~~~~~~~~~~~~~-Most derived instances are wholly handled in-Data.Singletons.Partition.partitionDecs. There are two notable exceptions to-this rule, however:--* Eq instances (which are handled entirely outside of partitionDecs)-* Show instances (which are partially handled outside of partitionDecs)--For these instances, we use a DerivedDecl data type to encode just enough-information to recreate the derived instance:--1. Just the instance context, if it's standalone-derived, or Nothing if it's in- a deriving clause (ded_mb_cxt)-2. The datatype, applied to some number of type arguments, as in the- instance declaration (ded_type)-3. The datatype's original information, as provided through DataDecl (ded_decl)--Why are these instances handled outside of partitionDecs?--* Deriving Eq in singletons not only derives PEq/SEq instances, but it also- derives SDecide instances. This additional complication makes Eq difficult- to integrate with the other deriving machinery, so we handle it specially- in Data.Singletons.Promote and Data.Singletons.Single (depending on the task- at hand).-* Deriving Show in singletons not only derives PShow/SShow instances, but it- also derives Show instances for singletons types. To make this work,- we let partitionDecs handle the PShow/SShow instances, but we also stick the- relevant info into a DerivedDecl value for later use in- Data.Singletons.Single, where we additionally generate Show- instances.--}
− src/Data/Singletons/TH.hs
@@ -1,192 +0,0 @@-{-# LANGUAGE ExplicitNamespaces, CPP #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.TH--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ This module contains everything you need to derive your own singletons via--- Template Haskell.------ TURN ON @-XScopedTypeVariables@ IN YOUR MODULE IF YOU WANT THIS TO WORK.----------------------------------------------------------------------------------module Data.Singletons.TH (- -- * Primary Template Haskell generation functions- singletons, singletonsOnly, genSingletons,- promote, promoteOnly, genDefunSymbols, genPromotions,-- -- ** Functions to generate equality instances- promoteEqInstances, promoteEqInstance,- singEqInstances, singEqInstance,- singEqInstancesOnly, singEqInstanceOnly,- singDecideInstances, singDecideInstance,-- -- ** Functions to generate 'Ord' instances- promoteOrdInstances, promoteOrdInstance,- singOrdInstances, singOrdInstance,-- -- ** Functions to generate 'Bounded' instances- promoteBoundedInstances, promoteBoundedInstance,- singBoundedInstances, singBoundedInstance,-- -- ** Functions to generate 'Enum' instances- promoteEnumInstances, promoteEnumInstance,- singEnumInstances, singEnumInstance,-- -- ** Functions to generate 'Show' instances- promoteShowInstances, promoteShowInstance,- singShowInstances, singShowInstance,-- -- ** Utility functions- cases, sCases,-- -- * Basic singleton definitions- Sing(SFalse, STrue, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7,- SLT, SEQ, SGT),- module Data.Singletons,-- -- * Auxiliary definitions- -- | These definitions might be mentioned in code generated by Template Haskell,- -- so they must be in scope.-- PEq(..), If, sIf, type (&&), (%&&), SEq(..),- POrd(..), SOrd(..), ThenCmp, sThenCmp,- SDecide(..), (:~:)(..), Void, Refuted, Decision(..),- PBounded(..), SBounded(..),- PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum),- PShow(..), SShow(..),- ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace,- ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace,- PFunctor(..), SFunctor(..),- PFoldable(..), SFoldable(..), PMonoid(..), SMonoid(..),- PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..),- (:.), (%.),- SomeSing(..),-- Error, sError, ErrorSym0, ErrorSym1,- Undefined, sUndefined, UndefinedSym0,- TrueSym0, FalseSym0,- type (==@#@$), type (==@#@$$), type (==@#@$$$),- type (>@#@$), type (>@#@$$), type (>@#@$$$),- LTSym0, EQSym0, GTSym0,- Tuple0Sym0,- Tuple2Sym0, Tuple2Sym1, Tuple2Sym2,- Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3,- Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4,- Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5,- Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6,- Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7,- CompareSym0, CompareSym1, CompareSym2,- ThenCmpSym0, ThenCmpSym1, ThenCmpSym2,- FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,- MinBoundSym0, MaxBoundSym0,- ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,- ShowStringSym0, ShowStringSym1, ShowStringSym2,- ShowParenSym0, ShowParenSym1, ShowParenSym2,- ShowSpaceSym0, ShowSpaceSym1,- ShowCharSym0, ShowCharSym1, ShowCharSym2,- ShowCommaSpaceSym0, ShowCommaSpaceSym1,- FmapSym0, FmapSym1, FmapSym2,- type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),- FoldMapSym0, FoldMapSym1, FoldMapSym2,- MemptySym0,- MappendSym0, MappendSym1, MappendSym2,- FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,- TraverseSym0, TraverseSym1, TraverseSym2,- PureSym0, PureSym1,- type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),- LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3,- type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),- (:@#@$), (:@#@$$), (:@#@$$$),-- SuppressUnusedWarnings(..)-- ) where--import Data.Singletons-import Data.Singletons.Single-import Data.Singletons.Promote-import Data.Singletons.Prelude.Applicative-import Data.Singletons.Prelude.Base- hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)-import Data.Singletons.Prelude.Instances- hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl)-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Foldable-import Data.Singletons.Prelude.Functor hiding (Void)-import Data.Singletons.Prelude.Monoid-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Show-import Data.Singletons.Prelude.Traversable-import Data.Singletons.Decide-import Data.Singletons.TypeLits-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.Names-import Language.Haskell.TH.Desugar--import Language.Haskell.TH-import Data.Singletons.Util-import Control.Arrow ( first )---- | The function 'cases' generates a case expression where each right-hand side--- is identical. This may be useful if the type-checker requires knowledge of which--- constructor is used to satisfy equality or type-class constraints, but where--- each constructor is treated the same.-cases :: DsMonad q- => Name -- ^ The head of the type of the scrutinee. (Like @''Maybe@ or @''Bool@.)- -> q Exp -- ^ The scrutinee, in a Template Haskell quote- -> q Exp -- ^ The body, in a Template Haskell quote- -> q Exp-cases tyName expq bodyq = do- dinfo <- dsReify tyName- case dinfo of- Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) ->- expToTH <$> buildCases (map extractNameArgs ctors) expq bodyq- Just _ ->- fail $ "Using <<cases>> with something other than a type constructor: "- ++ (show tyName)- _ -> fail $ "Cannot find " ++ show tyName---- | The function 'sCases' generates a case expression where each right-hand side--- is identical. This may be useful if the type-checker requires knowledge of which--- constructor is used to satisfy equality or type-class constraints, but where--- each constructor is treated the same. For 'sCases', unlike 'cases', the--- scrutinee is a singleton. But make sure to pass in the name of the /original/--- datatype, preferring @''Maybe@ over @''SMaybe@.-sCases :: DsMonad q- => Name -- ^ The head of the type the scrutinee's type is based on.- -- (Like @''Maybe@ or @''Bool@.)- -> q Exp -- ^ The scrutinee, in a Template Haskell quote- -> q Exp -- ^ The body, in a Template Haskell quote- -> q Exp-sCases tyName expq bodyq = do- dinfo <- dsReify tyName- case dinfo of- Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) ->- let ctor_stuff = map (first singDataConName . extractNameArgs) ctors in- expToTH <$> buildCases ctor_stuff expq bodyq- Just _ ->- fail $ "Using <<cases>> with something other than a type constructor: "- ++ (show tyName)- _ -> fail $ "Cannot find " ++ show tyName--buildCases :: DsMonad m- => [(Name, Int)]- -> m Exp -- scrutinee- -> m Exp -- body- -> m DExp-buildCases ctor_infos expq bodyq =- DCaseE <$> (dsExp =<< expq) <*>- mapM (\con -> DMatch (conToPat con) <$> (dsExp =<< bodyq)) ctor_infos- where- conToPat :: (Name, Int) -> DPat- conToPat (name, num_fields) =- DConPa name (replicate num_fields DWildPa)
− src/Data/Singletons/TypeError.hs
@@ -1,188 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Data.Singletons.TypeError--- Copyright : (C) 2018 Ryan Scott--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines a drop-in replacement for 'TL.TypeError' (from "GHC.TypeLits")--- that can be used at the value level as well. Since this is a drop-in--- replacement, it is not recommended to import all of "GHC.TypeLits"--- and "Data.Singletons.TypeError" at the same time, as many of the definitons--- in the latter deliberately clash with the former.---------------------------------------------------------------------------------module Data.Singletons.TypeError (- TypeError, sTypeError, typeError,- ErrorMessage'(..), ErrorMessage, PErrorMessage,- Sing(SText, SShowType, (:%<>:), (:%$$:)), SErrorMessage,- ConvertPErrorMessage, showErrorMessage,-- -- * Defunctionalization symbols- TextSym0, TextSym1,- ShowTypeSym0, ShowTypeSym1,- type (:<>:@#@$), type (:<>:@#@$$), type (:<>:@#@$$$),- type (:$$:@#@$), type (:$$:@#@$$), type (:$$:@#@$$$),- TypeErrorSym0, TypeErrorSym1- ) where--import Data.Kind-import Data.Singletons.TH-import qualified Data.Text as Text-import qualified GHC.TypeLits as TL (ErrorMessage(..), TypeError)-import GHC.Stack (HasCallStack)-import GHC.TypeLits hiding (ErrorMessage(..), TypeError)-import Prelude hiding ((<>))-import Text.PrettyPrint (Doc, text, (<>), ($$))---- | A description of a custom type error.------ This is a variation on 'TL.ErrorMessage' that is parameterized over what--- text type is used in the 'Text' constructor. Instantiating it with--- 'Text.Text' gives you 'ErrorMessage', and instantiating it with 'Symbol'--- gives you 'PErrorMessage'.-data ErrorMessage' s- = Text s- -- ^ Show the text as is.- | forall t. ShowType t- -- ^ Pretty print the type.- -- @ShowType :: k -> ErrorMessage@- | ErrorMessage' s :<>: ErrorMessage' s- -- ^ Put two pieces of error message next- -- to each other.- | ErrorMessage' s :$$: ErrorMessage' s- -- ^ Stack two pieces of error message on top- -- of each other.-infixl 6 :<>:-infixl 5 :$$:---- | A value-level `ErrorMessage'` which uses 'Text.Text' as its text type.-type ErrorMessage = ErrorMessage' Text.Text---- | A type-level `ErrorMessage'` which uses 'Symbol' as its text kind.-type PErrorMessage = ErrorMessage' Symbol--data instance Sing :: PErrorMessage -> Type where- -- It would be lovely to not have to write those (:: PErrorMessage) kind- -- ascriptions in the return types of each constructor.- -- See Trac #14111.- SText :: Sing t -> Sing ('Text t :: PErrorMessage)- SShowType :: Sing ty -> Sing ('ShowType ty :: PErrorMessage)- (:%<>:) :: Sing e1 -> Sing e2 -> Sing (e1 ':<>: e2 :: PErrorMessage)- (:%$$:) :: Sing e1 -> Sing e2 -> Sing (e1 ':$$: e2 :: PErrorMessage)-infixl 6 :%<>:-infixl 5 :%$$:--type SErrorMessage = (Sing :: PErrorMessage -> Type)--instance SingKind PErrorMessage where- type Demote PErrorMessage = ErrorMessage- fromSing (SText t) = Text (fromSing t)- fromSing (SShowType{}) = ShowType (error "Can't single ShowType")- fromSing (e1 :%<>: e2) = fromSing e1 :<>: fromSing e2- fromSing (e1 :%$$: e2) = fromSing e1 :$$: fromSing e2- toSing (Text t) = withSomeSing t $ SomeSing . SText- toSing (ShowType{}) = SomeSing $ SShowType (error "Can't single ShowType")- toSing (e1 :<>: e2) = withSomeSing e1 $ \sE1 ->- withSomeSing e2 $ \sE2 ->- SomeSing (sE1 :%<>: sE2)- toSing (e1 :$$: e2) = withSomeSing e1 $ \sE1 ->- withSomeSing e2 $ \sE2 ->- SomeSing (sE1 :%$$: sE2)--instance SingI t => SingI ('Text t :: PErrorMessage) where- sing = SText sing--instance SingI ty => SingI ('ShowType ty :: PErrorMessage) where- sing = SShowType sing--instance (SingI e1, SingI e2) => SingI (e1 ':<>: e2 :: PErrorMessage) where- sing = sing :%<>: sing--instance (SingI e1, SingI e2) => SingI (e1 ':$$: e2 :: PErrorMessage) where- sing = sing :%$$: sing---- | Convert an 'ErrorMessage' into a human-readable 'String'.-showErrorMessage :: ErrorMessage -> String-showErrorMessage = show . go- where- go :: ErrorMessage -> Doc- go (Text t) = text (Text.unpack t)- go (ShowType _) = text "<type>" -- Not much we can do here- go (e1 :<>: e2) = go e1 <> go e2- go (e1 :$$: e2) = go e1 $$ go e2---- | The value-level counterpart to 'TypeError'.------ Note that this is not quite as expressive as 'TypeError', as it is unable--- to print the contents of 'ShowType' constructors (it will simply print--- @\"\<type\>\"@ in their place).-typeError :: HasCallStack => ErrorMessage -> a-typeError = error . showErrorMessage---- | Convert a 'PErrorMessage' to a 'TL.ErrorMessage' from "GHC.TypeLits".-type family ConvertPErrorMessage (a :: PErrorMessage) :: TL.ErrorMessage where- ConvertPErrorMessage ('Text t) = 'TL.Text t- ConvertPErrorMessage ('ShowType ty) = 'TL.ShowType ty- ConvertPErrorMessage (e1 ':<>: e2) = ConvertPErrorMessage e1 'TL.:<>: ConvertPErrorMessage e2- ConvertPErrorMessage (e1 ':$$: e2) = ConvertPErrorMessage e1 'TL.:$$: ConvertPErrorMessage e2---- | A drop-in replacement for 'TL.TypeError'. This also exists at the--- value-level as 'typeError'.-type family TypeError (a :: PErrorMessage) :: b where- -- We cannot define this as a type synonym due to Trac #12048.- TypeError a = TL.TypeError (ConvertPErrorMessage a)---- | The singleton for 'typeError'.------ Note that this is not quite as expressive as 'TypeError', as it is unable--- to handle 'ShowType' constructors at all.-sTypeError :: HasCallStack => Sing err -> Sing (TypeError err)-sTypeError = typeError . fromSing--$(genDefunSymbols [''ErrorMessage', ''TypeError])--instance SingI (TextSym0 :: Symbol ~> PErrorMessage) where- sing = singFun1 SText-instance SingI (TyCon1 'Text :: Symbol ~> PErrorMessage) where- sing = singFun1 SText--instance SingI (ShowTypeSym0 :: t ~> PErrorMessage) where- sing = singFun1 SShowType-instance SingI (TyCon1 'ShowType :: t ~> PErrorMessage) where- sing = singFun1 SShowType--instance SingI ((:<>:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where- sing = singFun2 (:%<>:)-instance SingI (TyCon2 '(:<>:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where- sing = singFun2 (:%<>:)-instance SingI x => SingI ((:<>:@#@$$) x :: PErrorMessage ~> PErrorMessage) where- sing = singFun1 (sing @x :%<>:)-instance SingI x => SingI (TyCon1 ('(:<>:) x) :: PErrorMessage ~> PErrorMessage) where- sing = singFun1 (sing @x :%<>:)--instance SingI ((:$$:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where- sing = singFun2 (:%$$:)-instance SingI (TyCon2 '(:$$:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where- sing = singFun2 (:%$$:)-instance SingI x => SingI ((:$$:@#@$$) x :: PErrorMessage ~> PErrorMessage) where- sing = singFun1 (sing @x :%$$:)-instance SingI x => SingI (TyCon1 ('(:$$:) x) :: PErrorMessage ~> PErrorMessage) where- sing = singFun1 (sing @x :%$$:)--instance SingI TypeErrorSym0 where- sing = singFun1 sTypeError
− src/Data/Singletons/TypeLits.hs
@@ -1,225 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, ConstraintKinds,- GADTs, TypeApplications, TypeFamilies, UndecidableInstances,- DataKinds, PolyKinds #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.TypeLits--- Copyright : (C) 2014 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines and exports singletons useful for the Nat and Symbol kinds.----------------------------------------------------------------------------------{-# OPTIONS_GHC -Wno-orphans #-}--module Data.Singletons.TypeLits (- Nat, Symbol,- Sing(SNat, SSym),- SNat, SSymbol, withKnownNat, withKnownSymbol,- Error, sError,- ErrorWithoutStackTrace, sErrorWithoutStackTrace,- Undefined, sUndefined,- KnownNat, natVal,- KnownSymbol, symbolVal,-- type (^), (%^),- type (<=?), (%<=?),-- TN.Log2, sLog2,- Div, sDiv, Mod, sMod, DivMod, sDivMod,- Quot, sQuot, Rem, sRem, QuotRem, sQuotRem,-- -- * Defunctionalization symbols- ErrorSym0, ErrorSym1,- ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,- UndefinedSym0,- KnownNatSym0, KnownNatSym1,- KnownSymbolSym0, KnownSymbolSym1,- type (^@#@$), type (^@#@$$), type (^@#@$$$),- type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$),- Log2Sym0, Log2Sym1,- DivSym0, DivSym1, DivSym2,- ModSym0, ModSym1, ModSym2,- DivModSym0, DivModSym1, DivModSym2,- QuotSym0, QuotSym1, QuotSym2,- RemSym0, RemSym1, RemSym2,- QuotRemSym0, QuotRemSym1, QuotRemSym2- ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Tuple-import Data.Singletons.Promote-import Data.Singletons.ShowSing () -- for Show instances-import Data.Singletons.TypeLits.Internal--import Data.String (IsString(..))-import qualified GHC.TypeNats as TN-import GHC.TypeNats (Div, Mod, SomeNat(..))-import Numeric.Natural (Natural)--import Unsafe.Coerce---- | This bogus 'Num' instance is helpful for people who want to define--- functions over Nats that will only be used at the type level or--- as singletons. A correct SNum instance for Nat singletons exists.-instance Num Nat where- (+) = no_term_level_nats- (-) = no_term_level_nats- (*) = no_term_level_nats- negate = no_term_level_nats- abs = no_term_level_nats- signum = no_term_level_nats- fromInteger = no_term_level_nats--instance Eq Nat where- (==) = no_term_level_nats--instance Ord Nat where- compare = no_term_level_nats--instance Enum Nat where- toEnum = no_term_level_nats- fromEnum = no_term_level_nats- enumFromTo = no_term_level_nats- enumFromThenTo = no_term_level_nats--instance Show Nat where- showsPrec = no_term_level_nats---- | This bogus instance is helpful for people who want to define--- functions over Symbols that will only be used at the type level or--- as singletons.-instance Eq Symbol where- (==) = no_term_level_syms--instance Ord Symbol where- compare = no_term_level_syms--instance IsString Symbol where- fromString = no_term_level_syms--instance Semigroup Symbol where- (<>) = no_term_level_syms--instance Monoid Symbol where- mempty = no_term_level_syms--instance Show Symbol where- showsPrec = no_term_level_syms--no_term_level_nats :: a-no_term_level_nats = error "The kind `Nat` may not be used at the term level."--no_term_level_syms :: a-no_term_level_syms = error "The kind `Symbol` may not be used at the term level."---- These are often useful in TypeLits-heavy code-$(genDefunSymbols [''KnownNat, ''KnownSymbol])----------------------------------------------------------------- Log2, Div, Mod, DivMod, and friends---------------------------------------------------------------{- | Adapted from GHC's source code.--Compute the logarithm of a number in the given base, rounded down to the-closest integer. -}-genLog2 :: Natural -> Natural-genLog2 x = exactLoop 0 x- where- exactLoop s i- | i == 1 = s- | i < 2 = s- | otherwise =- let s1 = s + 1- in s1 `seq` case divMod i 2 of- (j,r)- | r == 0 -> exactLoop s1 j- | otherwise -> underLoop s1 j-- underLoop s i- | i < 2 = s- | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i 2)---sLog2 :: Sing x -> Sing (TN.Log2 x)-sLog2 sx =- let x = fromSing sx- in case x of- 0 -> error "log2 of 0"- _ -> case TN.someNatVal (genLog2 x) of- SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res)-$(genDefunSymbols [''TN.Log2])-instance SingI Log2Sym0 where- sing = singFun1 sLog2--sDiv :: Sing x -> Sing y -> Sing (Div x y)-sDiv sx sy =- let x = fromSing sx- y = fromSing sy- res = TN.someNatVal (x `div` y)- in case res of- SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res)-infixl 7 `sDiv`-$(genDefunSymbols [''Div])-instance SingI DivSym0 where- sing = singFun2 sDiv-instance SingI x => SingI (DivSym1 x) where- sing = singFun1 $ sDiv (sing @x)--sMod :: Sing x -> Sing y -> Sing (Mod x y)-sMod sx sy =- let x = fromSing sx- y = fromSing sy- res = TN.someNatVal (x `mod` y)- in case res of- SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res)-infixl 7 `sMod`-$(genDefunSymbols [''Mod])-instance SingI ModSym0 where- sing = singFun2 sMod-instance SingI x => SingI (ModSym1 x) where- sing = singFun1 $ sMod $ sing @x--$(promoteOnly [d|- divMod :: Nat -> Nat -> (Nat, Nat)- divMod x y = (div x y, mod x y)-- quotRem :: Nat -> Nat -> (Nat, Nat)- quotRem = divMod-- quot :: Nat -> Nat -> Nat- quot = div- infixl 7 `quot`-- rem :: Nat -> Nat -> Nat- rem = mod- infixl 7 `rem`- |])--sDivMod :: Sing x -> Sing y -> Sing (DivMod x y)-sDivMod sx sy =- let x = fromSing sx- y = fromSing sy- (q,r) = x `divMod` y- qRes = TN.someNatVal q- rRes = TN.someNatVal r- in case (qRes, rRes) of- (SomeNat (_ :: Proxy q), SomeNat (_ :: Proxy r))- -> unsafeCoerce (STuple2 (SNat :: Sing q) (SNat :: Sing r))--sQuotRem :: Sing x -> Sing y -> Sing (QuotRem x y)-sQuotRem = sDivMod--sQuot :: Sing x -> Sing y -> Sing (Quot x y)-sQuot = sDiv-infixl 7 `sQuot`--sRem :: Sing x -> Sing y -> Sing (Rem x y)-sRem = sMod-infixl 7 `sRem`
− src/Data/Singletons/TypeLits/Internal.hs
@@ -1,231 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Singletons.TypeLits.Internal--- Copyright : (C) 2014 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ Defines and exports singletons useful for the Nat and Symbol kinds.--- This exports the internal, unsafe constructors. Use Data.Singletons.TypeLits--- for a safe interface.----------------------------------------------------------------------------------{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, FlexibleInstances,- UndecidableInstances, ScopedTypeVariables, RankNTypes,- GADTs, FlexibleContexts, TypeOperators, ConstraintKinds,- TemplateHaskell, StandaloneDeriving,- TypeApplications #-}-{-# OPTIONS_GHC -Wno-orphans #-}--module Data.Singletons.TypeLits.Internal (- Sing(..),-- Nat, Symbol,- SNat, SSymbol, withKnownNat, withKnownSymbol,- Error, sError,- ErrorWithoutStackTrace, sErrorWithoutStackTrace,- Undefined, sUndefined,- KnownNat, TN.natVal, KnownSymbol, symbolVal,- type (^), (%^),- type (<=?), (%<=?),-- -- * Defunctionalization symbols- ErrorSym0, ErrorSym1,- ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,- UndefinedSym0,- type (^@#@$), type (^@#@$$), type (^@#@$$$),- type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$)- ) where--import Data.Singletons.Promote-import Data.Singletons.Internal-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord as O-import Data.Singletons.Decide-import Data.Singletons.Prelude.Bool-import GHC.Stack (HasCallStack)-import GHC.TypeLits as TL-import qualified GHC.TypeNats as TN-import Data.Proxy ( Proxy(..) )-import Numeric.Natural (Natural)-import Unsafe.Coerce--import qualified Data.Text as T-import Data.Text ( Text )----------------------------------------------------------------------------- TypeLits singletons ----------------------------------------------------------------------------------------------------------------------data instance Sing (n :: Nat) = KnownNat n => SNat--instance KnownNat n => SingI n where- sing = SNat--instance SingKind Nat where- type Demote Nat = Natural- fromSing (SNat :: Sing n) = TN.natVal (Proxy :: Proxy n)- toSing n = case TN.someNatVal n of- SomeNat (_ :: Proxy n) -> SomeSing (SNat :: Sing n)--data instance Sing (n :: Symbol) = KnownSymbol n => SSym--instance KnownSymbol n => SingI n where- sing = SSym--instance SingKind Symbol where- type Demote Symbol = Text- fromSing (SSym :: Sing n) = T.pack (symbolVal (Proxy :: Proxy n))- toSing s = case someSymbolVal (T.unpack s) of- SomeSymbol (_ :: Proxy n) -> SomeSing (SSym :: Sing n)---- SDecide instances:-instance SDecide Nat where- (SNat :: Sing n) %~ (SNat :: Sing m)- | Just r <- TN.sameNat (Proxy :: Proxy n) (Proxy :: Proxy m)- = Proved r- | otherwise- = Disproved (\_ -> error errStr)- where errStr = "Broken Nat singletons"--instance SDecide Symbol where- (SSym :: Sing n) %~ (SSym :: Sing m)- | Just r <- sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m)- = Proved r- | otherwise- = Disproved (\_ -> error errStr)- where errStr = "Broken Symbol singletons"---- PEq instances-instance PEq Nat-instance PEq Symbol---- need SEq instances for TypeLits kinds-instance SEq Nat where- (SNat :: Sing n) %== (SNat :: Sing m)- = case sameNat (Proxy :: Proxy n) (Proxy :: Proxy m) of- Just Refl -> STrue- Nothing -> unsafeCoerce SFalse--instance SEq Symbol where- (SSym :: Sing n) %== (SSym :: Sing m)- = case sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m) of- Just Refl -> STrue- Nothing -> unsafeCoerce SFalse---- POrd instances-instance POrd Nat where- type (a :: Nat) `Compare` (b :: Nat) = a `TN.CmpNat` b--instance POrd Symbol where- type (a :: Symbol) `Compare` (b :: Symbol) = a `TL.CmpSymbol` b---- | Kind-restricted synonym for 'Sing' for @Nat@s-type SNat (x :: Nat) = Sing x---- | Kind-restricted synonym for 'Sing' for @Symbol@s-type SSymbol (x :: Symbol) = Sing x---- SOrd instances-instance SOrd Nat where- a `sCompare` b = case fromSing a `compare` fromSing b of- LT -> unsafeCoerce SLT- EQ -> unsafeCoerce SEQ- GT -> unsafeCoerce SGT--instance SOrd Symbol where- a `sCompare` b = case fromSing a `compare` fromSing b of- LT -> unsafeCoerce SLT- EQ -> unsafeCoerce SEQ- GT -> unsafeCoerce SGT---- Convenience functions---- | Given a singleton for @Nat@, call something requiring a--- @KnownNat@ instance.-withKnownNat :: Sing n -> (KnownNat n => r) -> r-withKnownNat SNat f = f---- | Given a singleton for @Symbol@, call something requiring--- a @KnownSymbol@ instance.-withKnownSymbol :: Sing n -> (KnownSymbol n => r) -> r-withKnownSymbol SSym f = f---- | The promotion of 'error'. This version is more poly-kinded for--- easier use.-type family Error (str :: k0) :: k where {}-$(genDefunSymbols [''Error])-instance SingI (ErrorSym0 :: Symbol ~> a) where- sing = singFun1 sError---- | The singleton for 'error'-sError :: HasCallStack => Sing (str :: Symbol) -> a-sError sstr = error (T.unpack (fromSing sstr))---- | The promotion of 'errorWithoutStackTrace'. This version is more--- poly-kinded for easier use.-type family ErrorWithoutStackTrace (str :: k0) :: k where {}-$(genDefunSymbols [''ErrorWithoutStackTrace])-instance SingI (ErrorWithoutStackTraceSym0 :: Symbol ~> a) where- sing = singFun1 sErrorWithoutStackTrace---- | The singleton for 'errorWithoutStackTrace'.-sErrorWithoutStackTrace :: Sing (str :: Symbol) -> a-sErrorWithoutStackTrace sstr = errorWithoutStackTrace (T.unpack (fromSing sstr))---- | The promotion of 'undefined'.-type family Undefined :: k where {}-$(genDefunSymbols [''Undefined])---- | The singleton for 'undefined'.-sUndefined :: HasCallStack => a-sUndefined = undefined---- | The singleton analogue of '(TN.^)' for 'Nat's.-(%^) :: Sing a -> Sing b -> Sing (a ^ b)-sa %^ sb =- let a = fromSing sa- b = fromSing sb- ex = TN.someNatVal (a ^ b)- in- case ex of- SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab)-infixr 8 %^---- Defunctionalization symbols for type-level (^)-$(genDefunSymbols [''(^)])-instance SingI (^@#@$) where- sing = singFun2 (%^)-instance SingI x => SingI ((^@#@$$) x) where- sing = singFun1 (sing @x %^)---- | The singleton analogue of 'TN.<=?'------ Note that, because of historical reasons in GHC's 'TN.Nat' API, 'TN.<=?'--- is incompatible (unification-wise) with 'O.<=' and the 'PEq', 'SEq',--- 'POrd', and 'SOrd' instances for 'Nat'. @(a '<=?' b) ~ 'True@ does not--- imply anything about @a 'O.<=' b@ or any other 'PEq' / 'POrd'--- relationships.------ (Be aware that 'O.<=' in the paragraph above refers to 'O.<=' from the--- 'POrd' typeclass, exported from "Data.Singletons.Prelude.Ord", and /not/--- the 'TN.<=' from "GHC.TypeNats". The latter is simply a type alias for--- @(a 'TN.<=?' b) ~ 'True@.)------ This is provided here for the sake of completeness and for compatibility--- with libraries with APIs built around '<=?'. New code should use--- 'CmpNat', exposed through this library through the 'POrd' and 'SOrd'--- instances for 'Nat'.-(%<=?) :: Sing a -> Sing b -> Sing (a <=? b)-sa %<=? sb = unsafeCoerce (sa %<= sb)-infix 4 %<=?---- Defunctionalization symbols for (<=?)-$(genDefunSymbols [''(<=?)])-instance SingI (<=?@#@$) where- sing = singFun2 (%<=?)-instance SingI x => SingI ((<=?@#@$$) x) where- sing = singFun1 (sing @x %<=?)
− src/Data/Singletons/TypeRepTYPE.hs
@@ -1,100 +0,0 @@-{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleInstances,- GADTs, UndecidableInstances, ScopedTypeVariables,- MagicHash, TypeOperators, PolyKinds #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module : Data.Singletons.TypeRepTYPE--- Copyright : (C) 2013 Richard Eisenberg--- License : BSD-style (see LICENSE)--- Maintainer : Ryan Scott--- Stability : experimental--- Portability : non-portable------ This module defines singleton instances making 'TypeRep' the singleton for--- the kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@), an instantiation of--- which is the famous kind 'Type'. The definitions don't fully line up with--- what is expected within the singletons library, so expect unusual results!----------------------------------------------------------------------------------module Data.Singletons.TypeRepTYPE (- Sing(STypeRep),- -- | Here is the definition of the singleton for @'TYPE' rep@:- --- -- > newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where- -- > STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a- --- -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and- -- 'TestCoercion' are also supplied.-- SomeTypeRepTYPE(..)- ) where--import Data.Kind (Type)-import Data.Singletons.Prelude.Instances-import Data.Singletons.Internal-import Data.Singletons.Prelude.Eq-import Data.Singletons.Decide-import Data.Type.Equality ((:~:)(..))-import GHC.Exts (RuntimeRep, TYPE)-import Type.Reflection-import Type.Reflection.Unsafe-import Unsafe.Coerce---- | A choice of singleton for the kind @'TYPE' rep@ (for some 'RuntimeRep'--- @rep@), an instantiation of which is the famous kind 'Type'.------ Conceivably, one could generalize this instance to `Sing :: k -> Type` for--- /any/ kind @k@, and remove all other 'Sing' instances. We don't adopt this--- design, however, since it is far more convenient in practice to work with--- explicit singleton values than 'TypeRep's (for instance, 'TypeRep's are--- more difficult to pattern match on, and require extra runtime checks).------ We cannot produce explicit singleton values for everything in @'TYPE' rep@,--- however, since it is an open kind, so we reach for 'TypeRep' in this one--- particular case.-newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where- STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a- deriving (Eq, Ord, Show)---- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to--- kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@).-data SomeTypeRepTYPE :: RuntimeRep -> Type where- SomeTypeRepTYPE :: forall (rep :: RuntimeRep) (a :: TYPE rep). !(TypeRep a) -> SomeTypeRepTYPE rep--instance Eq (SomeTypeRepTYPE rep) where- SomeTypeRepTYPE a == SomeTypeRepTYPE b =- case eqTypeRep a b of- Just HRefl -> True- Nothing -> False--instance Ord (SomeTypeRepTYPE rep) where- SomeTypeRepTYPE a `compare` SomeTypeRepTYPE b =- typeRepFingerprint a `compare` typeRepFingerprint b--instance Show (SomeTypeRepTYPE rep) where- showsPrec p (SomeTypeRepTYPE ty) = showsPrec p ty--instance Typeable a => SingI (a :: TYPE rep) where- sing = STypeRep typeRep-instance SingKind (TYPE rep) where- type Demote (TYPE rep) = SomeTypeRepTYPE rep- fromSing (STypeRep tr) = SomeTypeRepTYPE tr- toSing (SomeTypeRepTYPE tr) = SomeSing $ STypeRep tr--instance PEq (TYPE rep)-instance SEq (TYPE rep) where- STypeRep tra %== STypeRep trb =- case eqTypeRep tra trb of- Just HRefl -> STrue- Nothing -> unsafeCoerce SFalse- -- the Data.Typeable interface isn't strong enough- -- to enable us to define this without unsafeCoerce--instance SDecide (TYPE rep) where- STypeRep tra %~ STypeRep trb =- case eqTypeRep tra trb of- Just HRefl -> Proved Refl- Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed")
− src/Data/Singletons/Util.hs
@@ -1,549 +0,0 @@-{- Data/Singletons/Util.hs--(c) Richard Eisenberg 2013-rae@cs.brynmawr.edu--This file contains helper functions internal to the singletons package.-Users of the package should not need to consult this file.--}--{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes,- TemplateHaskell, GeneralizedNewtypeDeriving,- MultiParamTypeClasses, StandaloneDeriving,- UndecidableInstances, MagicHash, UnboxedTuples,- LambdaCase, NoMonomorphismRestriction #-}--module Data.Singletons.Util where--import Prelude hiding ( exp, foldl, concat, mapM, any, pred )-import Language.Haskell.TH.Syntax hiding ( lift )-import Language.Haskell.TH.Desugar-import Data.Char-import Control.Monad hiding ( mapM )-import Control.Monad.Writer hiding ( mapM )-import Control.Monad.Reader hiding ( mapM )-import qualified Data.Map as Map-import Data.List.NonEmpty (NonEmpty(..))-import Data.Map ( Map )-import qualified Data.Monoid as Monoid-import Data.Semigroup as Semigroup-import Data.Foldable-import Data.Functor.Identity-import Data.Traversable-import Data.Generics-import Data.Maybe-import Data.Void-import Control.Monad.Fail ( MonadFail )---- The list of types that singletons processes by default-basicTypes :: [Name]-basicTypes = [ ''Maybe- , ''[]- , ''Either- , ''NonEmpty- , ''Void- ] ++ boundedBasicTypes--boundedBasicTypes :: [Name]-boundedBasicTypes =- [ ''(,)- , ''(,,)- , ''(,,,)- , ''(,,,,)- , ''(,,,,,)- , ''(,,,,,,)- , ''Identity- ] ++ enumBasicTypes--enumBasicTypes :: [Name]-enumBasicTypes = [ ''Bool, ''Ordering, ''() ]--semigroupBasicTypes :: [Name]-semigroupBasicTypes- = [ ''Dual- , ''All- , ''Any- , ''Sum- , ''Product- -- , ''Endo see https://github.com/goldfirere/singletons/issues/82- {- , ''Alt singletons doesn't support higher kinds :(- see https://github.com/goldfirere/singletons/issues/150- -}-- , ''Min- , ''Max- , ''Semigroup.First- , ''Semigroup.Last- , ''WrappedMonoid- ]--monoidBasicTypes :: [Name]-monoidBasicTypes- = [ ''Monoid.First- , ''Monoid.Last- ]---- like reportWarning, but generalized to any Quasi-qReportWarning :: Quasi q => String -> q ()-qReportWarning = qReport False---- like reportError, but generalized to any Quasi-qReportError :: Quasi q => String -> q ()-qReportError = qReport True---- | Generate a new Unique-qNewUnique :: DsMonad q => q Int-qNewUnique = do- Name _ flav <- qNewName "x"- case flav of- NameU n -> return n- _ -> error "Internal error: `qNewName` didn't return a NameU"--checkForRep :: Quasi q => [Name] -> q ()-checkForRep names =- when (any ((== "Rep") . nameBase) names)- (fail $ "A data type named <<Rep>> is a special case.\n" ++- "Promoting it will not work as expected.\n" ++- "Please choose another name for your data type.")--checkForRepInDecls :: Quasi q => [DDec] -> q ()-checkForRepInDecls decls =- checkForRep (allNamesIn decls)--tysOfConFields :: DConFields -> [DType]-tysOfConFields (DNormalC _ stys) = map snd stys-tysOfConFields (DRecC vstys) = map (\(_,_,ty) -> ty) vstys---- extract the name and number of arguments to a constructor-extractNameArgs :: DCon -> (Name, Int)-extractNameArgs = liftSnd length . extractNameTypes---- extract the name and types of constructor arguments-extractNameTypes :: DCon -> (Name, [DType])-extractNameTypes (DCon _ _ n fields _) = (n, tysOfConFields fields)--extractName :: DCon -> Name-extractName (DCon _ _ n _ _) = n---- | is a valid Haskell infix data constructor (i.e., does it begin with a colon?)-isInfixDataCon :: String -> Bool-isInfixDataCon (':':_) = True-isInfixDataCon _ = False---- | Is an identifier a legal data constructor name in Haskell? That is, is its--- first character an uppercase letter (prefix) or a colon (infix)?-isDataConName :: Name -> Bool-isDataConName n = let first = head (nameBase n) in isUpper first || first == ':'---- | Is an identifier uppercase?------ Note that this will always return 'False' for infix names, since the concept--- of upper- and lower-case doesn't make sense for non-alphabetic characters.--- If you want to check if a name is legal as a data constructor, use the--- 'isDataConName' function.-isUpcase :: Name -> Bool-isUpcase n = let first = head (nameBase n) in isUpper first---- Make an identifier uppercase. If the identifier is infix, this acts as the--- identity function.-upcase :: Name -> Name-upcase = mkName . toUpcaseStr noPrefix---- make an identifier uppercase and return it as a String-toUpcaseStr :: (String, String) -- (alpha, symb) prefixes to prepend- -> Name -> String-toUpcaseStr (alpha, symb) n- | isHsLetter first- = upcase_alpha-- | otherwise- = upcase_symb-- where- str = nameBase n- first = head str-- upcase_alpha = alpha ++ (toUpper first) : tail str- upcase_symb = symb ++ str--noPrefix :: (String, String)-noPrefix = ("", "")---- Put an uppercase prefix on a constructor name. Takes two prefixes:--- one for identifiers and one for symbols.------ This is different from 'prefixName' in that infix constructor names always--- start with a colon, so we must insert the prefix after the colon in order--- for the new name to be syntactically valid.-prefixConName :: String -> String -> Name -> Name-prefixConName pre tyPre n = case (nameBase n) of- (':' : rest) -> mkName (':' : tyPre ++ rest)- alpha -> mkName (pre ++ alpha)---- Put a prefix on a name. Takes two prefixes: one for identifiers--- and one for symbols.-prefixName :: String -> String -> Name -> Name-prefixName pre tyPre n =- let str = nameBase n- first = head str in- if isHsLetter first- then mkName (pre ++ str)- else mkName (tyPre ++ str)---- Put a suffix on a name. Takes two suffixes: one for identifiers--- and one for symbols.-suffixName :: String -> String -> Name -> Name-suffixName ident symb n =- let str = nameBase n- first = head str in- if isHsLetter first- then mkName (str ++ ident)- else mkName (str ++ symb)---- convert a number into both alphanumeric and symoblic forms-uniquePrefixes :: String -- alphanumeric prefix- -> String -- symbolic prefix- -> Int- -> (String, String) -- (alphanum, symbolic)-uniquePrefixes alpha symb n = (alpha ++ n_str, symb ++ convert n_str)- where- n_str = show n-- convert [] = []- convert (d : ds) =- let d' = case d of- '0' -> '!'- '1' -> '#'- '2' -> '$'- '3' -> '%'- '4' -> '&'- '5' -> '*'- '6' -> '+'- '7' -> '.'- '8' -> '/'- '9' -> '>'- _ -> error "non-digit in show #"- in d' : convert ds---- extract the kind from a TyVarBndr-extractTvbKind :: DTyVarBndr -> Maybe DKind-extractTvbKind (DPlainTV _) = Nothing-extractTvbKind (DKindedTV _ k) = Just k---- extract the name from a TyVarBndr.-extractTvbName :: DTyVarBndr -> Name-extractTvbName (DPlainTV n) = n-extractTvbName (DKindedTV n _) = n--tvbToType :: DTyVarBndr -> DType-tvbToType = DVarT . extractTvbName--inferMaybeKindTV :: Name -> Maybe DKind -> DTyVarBndr-inferMaybeKindTV n Nothing = DPlainTV n-inferMaybeKindTV n (Just k) = DKindedTV n k--resultSigToMaybeKind :: DFamilyResultSig -> Maybe DKind-resultSigToMaybeKind DNoSig = Nothing-resultSigToMaybeKind (DKindSig k) = Just k-resultSigToMaybeKind (DTyVarSig (DPlainTV _)) = Nothing-resultSigToMaybeKind (DTyVarSig (DKindedTV _ k)) = Just k---- Reconstruct arrow kind from the list of kinds-ravel :: [DType] -> DType -> DType-ravel [] res = res-ravel (h:t) res = DAppT (DAppT DArrowT h) (ravel t res)---- | Convert a 'DPred' to a 'DType'.-predToType :: DPred -> DType-predToType (DForallPr tvbs cxt p) = DForallT tvbs cxt (predToType p)-predToType (DAppPr p t) = DAppT (predToType p) t-predToType (DSigPr p k) = DSigT (predToType p) k-predToType (DVarPr n) = DVarT n-predToType (DConPr n) = DConT n-predToType DWildCardPr = DWildCardT---- count the number of arguments in a type-countArgs :: DType -> Int-countArgs ty = length args- where (_, _, args, _) = unravel ty---- changes all TyVars not to be NameU's. Workaround for GHC#11812-noExactTyVars :: Data a => a -> a-noExactTyVars = everywhere go- where- go :: Data a => a -> a- go = mkT fix_tvb `extT` fix_ty `extT` fix_inj_ann-- no_exact_name :: Name -> Name- no_exact_name (Name (OccName occ) (NameU unique)) = mkName (occ ++ show unique)- no_exact_name n = n-- fix_tvb (DPlainTV n) = DPlainTV (no_exact_name n)- fix_tvb (DKindedTV n k) = DKindedTV (no_exact_name n) k-- fix_ty (DVarT n) = DVarT (no_exact_name n)- fix_ty ty = ty-- fix_inj_ann (InjectivityAnn lhs rhs)- = InjectivityAnn (no_exact_name lhs) (map no_exact_name rhs)--substKind :: Map Name DKind -> DKind -> DKind-substKind = substType---- | Non–capture-avoiding substitution. (If you want capture-avoiding--- substitution, use @substTy@ from "Language.Haskell.TH.Desugar.Subst".-substType :: Map Name DType -> DType -> DType-substType subst ty | Map.null subst = ty-substType subst (DForallT tvbs cxt inner_ty)- = DForallT tvbs' cxt' inner_ty'- where- (subst', tvbs') = mapAccumL subst_tvb subst tvbs- cxt' = map (substPred subst') cxt- inner_ty' = substType subst' inner_ty-substType subst (DAppT ty1 ty2) = substType subst ty1 `DAppT` substType subst ty2-substType subst (DSigT ty ki) = substType subst ty `DSigT` substType subst ki-substType subst (DVarT n) =- case Map.lookup n subst of- Just ki -> ki- Nothing -> DVarT n-substType _ ty@(DConT {}) = ty-substType _ ty@(DArrowT) = ty-substType _ ty@(DLitT {}) = ty-substType _ ty@DWildCardT = ty--substPred :: Map Name DType -> DPred -> DPred-substPred subst pred | Map.null subst = pred-substPred subst (DForallPr tvbs cxt inner_pred)- = DForallPr tvbs' cxt' inner_pred'- where- (subst', tvbs') = mapAccumL subst_tvb subst tvbs- cxt' = map (substPred subst') cxt- inner_pred' = substPred subst' inner_pred-substPred subst (DAppPr pred ty) =- DAppPr (substPred subst pred) (substType subst ty)-substPred subst (DSigPr pred ki) =- DSigPr (substPred subst pred) (substKind subst ki)-substPred _ pred@(DVarPr {}) = pred-substPred _ pred@(DConPr {}) = pred-substPred _ pred@DWildCardPr = pred--subst_tvb :: Map Name DKind -> DTyVarBndr -> (Map Name DKind, DTyVarBndr)-subst_tvb s tvb@(DPlainTV n) = (Map.delete n s, tvb)-subst_tvb s (DKindedTV n k) = (Map.delete n s, DKindedTV n (substKind s k))--cuskify :: DTyVarBndr -> DTyVarBndr-cuskify (DPlainTV tvname) = DKindedTV tvname $ DConT typeKindName-cuskify tvb = tvb---- apply a type to a list of types-foldType :: DType -> [DType] -> DType-foldType = foldl DAppT---- apply a type to a list of type variable binders-foldTypeTvbs :: DType -> [DTyVarBndr] -> DType-foldTypeTvbs ty = foldType ty . map tvbToType---- apply a pred to a list of types-foldPred :: DPred -> [DType] -> DPred-foldPred = foldl DAppPr---- apply a pred to a list of type variable binders-foldPredTvbs :: DPred -> [DTyVarBndr] -> DPred-foldPredTvbs pr = foldPred pr . map tvbToType---- | Decompose an applied type into its individual components. For example, this:------ @--- Either Int Char--- @------ would be unfolded to this:------ @--- Either :| [Int, Char]--- @-unfoldType :: DType -> NonEmpty DType-unfoldType = go []- where- go :: [DType] -> DType -> NonEmpty DType- go acc (DAppT t1 t2) = go (t2:acc) t1- go acc (DSigT t _) = go acc t- go acc (DForallT _ _ t) = go acc t- go acc t = t :| acc---- Construct a data type's variable binders, possibly using fresh variables--- from the data type's kind signature.-buildDataDTvbs :: DsMonad q => [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr]-buildDataDTvbs tvbs mk = do- extra_tvbs <- mkExtraDKindBinders $ fromMaybe (DConT typeKindName) mk- pure $ tvbs ++ extra_tvbs---- apply an expression to a list of expressions-foldExp :: DExp -> [DExp] -> DExp-foldExp = foldl DAppE---- is a function type?-isFunTy :: DType -> Bool-isFunTy (DAppT (DAppT DArrowT _) _) = True-isFunTy (DForallT _ _ _) = True-isFunTy _ = False---- choose the first non-empty list-orIfEmpty :: [a] -> [a] -> [a]-orIfEmpty [] x = x-orIfEmpty x _ = x---- build a pattern match over several expressions, each with only one pattern-multiCase :: [DExp] -> [DPat] -> DExp -> DExp-multiCase [] [] body = body-multiCase scruts pats body =- DCaseE (mkTupleDExp scruts) [DMatch (mkTupleDPat pats) body]---- Make a desugar function into a TH function.-wrapDesugar :: (Desugar th ds, DsMonad q) => (th -> ds -> q ds) -> th -> q th-wrapDesugar f th = do- ds <- desugar th- fmap sweeten $ f th ds---- a monad transformer for writing a monoid alongside returning a Q-newtype QWithAux m q a = QWA { runQWA :: WriterT m q a }- deriving ( Functor, Applicative, Monad, MonadTrans- , MonadWriter m, MonadReader r- , MonadFail, MonadIO )---- make a Quasi instance for easy lifting-instance (Quasi q, Monoid m) => Quasi (QWithAux m q) where- qNewName = lift `comp1` qNewName- qReport = lift `comp2` qReport- qLookupName = lift `comp2` qLookupName- qReify = lift `comp1` qReify- qReifyInstances = lift `comp2` qReifyInstances- qLocation = lift qLocation- qRunIO = lift `comp1` qRunIO- qAddDependentFile = lift `comp1` qAddDependentFile- qReifyRoles = lift `comp1` qReifyRoles- qReifyAnnotations = lift `comp1` qReifyAnnotations- qReifyModule = lift `comp1` qReifyModule- qAddTopDecls = lift `comp1` qAddTopDecls- qAddModFinalizer = lift `comp1` qAddModFinalizer- qGetQ = lift qGetQ- qPutQ = lift `comp1` qPutQ-- qReifyFixity = lift `comp1` qReifyFixity- qReifyConStrictness = lift `comp1` qReifyConStrictness- qIsExtEnabled = lift `comp1` qIsExtEnabled- qExtsEnabled = lift qExtsEnabled- qAddForeignFilePath = lift `comp2` qAddForeignFilePath- qAddTempFile = lift `comp1` qAddTempFile- qAddCorePlugin = lift `comp1` qAddCorePlugin-- qRecover exp handler = do- (result, aux) <- lift $ qRecover (evalForPair exp) (evalForPair handler)- tell aux- return result--instance (DsMonad q, Monoid m) => DsMonad (QWithAux m q) where- localDeclarations = lift localDeclarations---- helper functions for composition-comp1 :: (b -> c) -> (a -> b) -> a -> c-comp1 = (.)--comp2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d-comp2 f g a b = f (g a b)---- run a computation with an auxiliary monoid, discarding the monoid result-evalWithoutAux :: Quasi q => QWithAux m q a -> q a-evalWithoutAux = liftM fst . runWriterT . runQWA---- run a computation with an auxiliary monoid, returning only the monoid result-evalForAux :: Quasi q => QWithAux m q a -> q m-evalForAux = execWriterT . runQWA---- run a computation with an auxiliary monoid, return both the result--- of the computation and the monoid result-evalForPair :: QWithAux m q a -> q (a, m)-evalForPair = runWriterT . runQWA---- in a computation with an auxiliary map, add a binding to the map-addBinding :: (Quasi q, Ord k) => k -> v -> QWithAux (Map.Map k v) q ()-addBinding k v = tell (Map.singleton k v)---- in a computation with an auxiliar list, add an element to the list-addElement :: Quasi q => elt -> QWithAux [elt] q ()-addElement elt = tell [elt]---- | Call 'lookupTypeNameWithLocals' first to ensure we have a 'Name' in the--- type namespace, then call 'dsReify'.---- See also Note [Using dsReifyTypeNameInfo when promoting instances]--- in Data.Singletons.Promote.-dsReifyTypeNameInfo :: DsMonad q => Name -> q (Maybe DInfo)-dsReifyTypeNameInfo ty_name = do- mb_name <- lookupTypeNameWithLocals (nameBase ty_name)- case mb_name of- Just n -> dsReify n- Nothing -> pure Nothing---- lift concatMap into a monad--- could this be more efficient?-concatMapM :: (Monad monad, Monoid monoid, Traversable t)- => (a -> monad monoid) -> t a -> monad monoid-concatMapM fn list = do- bss <- mapM fn list- return $ fold bss---- make a one-element list-listify :: a -> [a]-listify = (:[])--fstOf3 :: (a,b,c) -> a-fstOf3 (a,_,_) = a--liftFst :: (a -> b) -> (a, c) -> (b, c)-liftFst f (a, c) = (f a, c)--liftSnd :: (a -> b) -> (c, a) -> (c, b)-liftSnd f (c, a) = (c, f a)--snocView :: [a] -> ([a], a)-snocView [] = error "snocView nil"-snocView [x] = ([], x)-snocView (x : xs) = liftFst (x:) (snocView xs)--partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])-partitionWith f = go [] []- where go bs cs [] = (reverse bs, reverse cs)- go bs cs (a:as) =- case f a of- Left b -> go (b:bs) cs as- Right c -> go bs (c:cs) as--partitionWithM :: Monad m => (a -> m (Either b c)) -> [a] -> m ([b], [c])-partitionWithM f = go [] []- where go bs cs [] = return (reverse bs, reverse cs)- go bs cs (a:as) = do- fa <- f a- case fa of- Left b -> go (b:bs) cs as- Right c -> go bs (c:cs) as--partitionLetDecs :: [DDec] -> ([DLetDec], [DDec])-partitionLetDecs = partitionWith (\case DLetDec ld -> Left ld- dec -> Right dec)--{-# INLINEABLE zipWith3M #-}-zipWith3M :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]-zipWith3M f (a:as) (b:bs) = (:) <$> f a b <*> zipWith3M f as bs-zipWith3M _ _ _ = return []--mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])-mapAndUnzip3M _ [] = return ([],[],[])-mapAndUnzip3M f (x:xs) = do- (r1, r2, r3) <- f x- (rs1, rs2, rs3) <- mapAndUnzip3M f xs- return (r1:rs1, r2:rs2, r3:rs3)---- is it a letter or underscore?-isHsLetter :: Char -> Bool-isHsLetter c = isLetter c || c == '_'
tests/ByHand.hs view
@@ -14,67 +14,71 @@ FlexibleInstances, FlexibleContexts, UndecidableInstances, RankNTypes, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, ScopedTypeVariables,- LambdaCase, TemplateHaskell, EmptyCase,- AllowAmbiguousTypes, TypeApplications, EmptyCase- #-}+ LambdaCase, EmptyCase,+ TypeApplications, EmptyCase, CPP #-} -module ByHand where+#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif -import Data.Kind (Type)-import Prelude hiding (Bool, False, True, Maybe, Just, Nothing, Either, Left, Right, map, zipWith,- (&&), (||), (+), (-))-import Unsafe.Coerce+#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+module ByHand where +import Data.Kind import Data.Type.Equality hiding (type (==), apply) import Data.Proxy- import Data.Singletons import Data.Singletons.Decide+import Prelude hiding ((+), (-), map, zipWith)+import Unsafe.Coerce ----------------------------------- -- Original ADTs ------------------ ----------------------------------- -data Nat :: Type where+#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif+data Nat where Zero :: Nat Succ :: Nat -> Nat deriving Eq -data Bool :: Type where- False :: Bool- True :: Bool--data Maybe :: Type -> Type where- Nothing :: Maybe a- Just :: a -> Maybe a- deriving Eq- -- Defined using names to avoid fighting with concrete syntax+#if __GLASGOW_HASKELL__ >= 810+type List :: Type -> Type+#endif data List :: Type -> Type where Nil :: List a Cons :: a -> List a -> List a deriving Eq -data Either :: Type -> Type -> Type where- Left :: a -> Either a b- Right :: b -> Either a b-- ----------------------------------- -- One-time definitions ----------- ----------------------------------- -- Promoted equality type class+#if __GLASGOW_HASKELL__ >= 810+type PEq :: Type -> Constraint+#endif class PEq k where type (==) (a :: k) (b :: k) :: Bool -- omitting definition of /= -- Singleton type equality type class+#if __GLASGOW_HASKELL__ >= 810+type SEq :: Type -> Constraint+#endif class SEq k where (%==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a == b) -- omitting definition of %/= -type family If cond tru fls where+#if __GLASGOW_HASKELL__ >= 810+type If :: Bool -> a -> a -> a+#endif+type family If (cond :: Bool) (tru :: a) (fls :: a) :: a where If True tru fls = tru If False tru fls = fls @@ -88,14 +92,30 @@ -- Nat -data instance Sing :: Nat -> Type where- SZero :: Sing Zero- SSucc :: Sing n -> Sing (Succ n)+#if __GLASGOW_HASKELL__ >= 810+type SNat :: Nat -> Type+#endif+data SNat :: Nat -> Type where+ SZero :: SNat Zero+ SSucc :: SNat n -> SNat (Succ n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Nat =+#else+type instance Sing =+#endif+ SNat +#if _+_GLASGOW_HASKELL__ >= 810+type SuccSym0 :: Nat ~> Nat+#endif data SuccSym0 :: Nat ~> Nat type instance Apply SuccSym0 x = Succ x -type family EqualsNat (a :: Nat) (b :: Nat) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsNat :: Nat -> Nat -> Bool+#endif+type family EqualsNat (a :: Nat) (b :: Nat) :: Bool where EqualsNat Zero Zero = True EqualsNat (Succ a) (Succ b) = a == b EqualsNat (n1 :: Nat) (n2 :: Nat) = False@@ -121,6 +141,8 @@ sing = SZero instance SingI n => SingI (Succ n) where sing = SSucc sing+instance SingI1 Succ where+ liftSing = SSucc instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero@@ -130,14 +152,28 @@ -- Bool -data instance Sing :: Bool -> Type where- SFalse :: Sing False- STrue :: Sing True+#if __GLASGOW_HASKELL__ >= 810+type SBool :: Bool -> Type+#endif+data SBool :: Bool -> Type where+ SFalse :: SBool False+ STrue :: SBool True+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Bool =+#else+type instance Sing =+#endif+ SBool +{- (&&) :: Bool -> Bool -> Bool False && _ = False True && x = x+-} +#if __GLASGOW_HASKELL__ >= 810+type (&&) :: Bool -> Bool -> Bool+#endif type family (a :: Bool) && (b :: Bool) :: Bool where False && _ = False True && x = x@@ -161,11 +197,23 @@ -- Maybe -data instance Sing :: Maybe k -> Type where- SNothing :: Sing Nothing- SJust :: forall k (a :: k). Sing a -> Sing (Just a)+#if __GLASGOW_HASKELL__ >= 810+type SMaybe :: forall k. Maybe k -> Type+#endif+data SMaybe :: forall k. Maybe k -> Type where+ SNothing :: SMaybe Nothing+ SJust :: forall k (a :: k). Sing a -> SMaybe (Just a)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Maybe k) =+#else+type instance Sing =+#endif+ SMaybe -type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsMaybe :: Maybe k -> Maybe k -> Bool+#endif+type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) :: Bool where EqualsMaybe Nothing Nothing = True EqualsMaybe (Just a) (Just a') = a == a' EqualsMaybe (x :: Maybe k) (y :: Maybe k) = False@@ -191,6 +239,8 @@ sing = SNothing instance SingI a => SingI (Just (a :: k)) where sing = SJust sing+instance SingI1 Just where+ liftSing = SJust instance SingKind k => SingKind (Maybe k) where type Demote (Maybe k) = Maybe (Demote k) fromSing SNothing = Nothing@@ -202,21 +252,41 @@ -- List -data instance Sing :: List k -> Type where- SNil :: Sing Nil- SCons :: forall k (h :: k) (t :: List k). Sing h -> Sing t -> Sing (Cons h t)+#if __GLASGOW_HASKELL__ >= 810+type SList :: forall k. List k -> Type+#endif+data SList :: forall k. List k -> Type where+ SNil :: SList Nil+ SCons :: forall k (h :: k) (t :: List k). Sing h -> SList t -> SList (Cons h t)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(List k) =+#else+type instance Sing =+#endif+ SList -type NilSym0 = Nil+#if __GLASGOW_HASKELL__ >= 810+type NilSym0 :: List a+#endif+type family NilSym0 :: List a where+ NilSym0 = Nil -data ConsSym0 :: a ~> List a ~> List a+#if __GLASGOW_HASKELL__ >= 810+type ConsSym0 :: forall a. a ~> List a ~> List a+type ConsSym1 :: forall a. a -> List a ~> List a+type ConsSym2 :: forall a. a -> List a -> List a+#endif+data ConsSym0 :: forall a. a ~> List a ~> List a+data ConsSym1 :: forall a. a -> List a ~> List a+type family ConsSym2 (x :: a) (y :: List a) :: List a where+ ConsSym2 x y = Cons x y type instance Apply ConsSym0 a = ConsSym1 a--data ConsSym1 :: a -> List a ~> List a-type instance Apply (ConsSym1 a) b = ConsSym2 a b--type ConsSym2 a b = Cons a b+type instance Apply (ConsSym1 a) b = Cons a b -type family EqualsList (a :: List k) (b :: List k) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsList :: List k -> List k -> Bool+#endif+type family EqualsList (a :: List k) (b :: List k) :: Bool where EqualsList Nil Nil = True EqualsList (Cons a b) (Cons a' b') = (a == a') && (b == b') EqualsList (x :: List k) (y :: List k) = False@@ -244,6 +314,10 @@ instance (SingI h, SingI t) => SingI (Cons (h :: k) (t :: List k)) where sing = SCons sing sing+instance SingI h => SingI1 (Cons (h :: k)) where+ liftSing = SCons sing+instance SingI2 Cons where+ liftSing2 = SCons instance SingKind k => SingKind (List k) where type Demote (List k) = List (Demote k) fromSing SNil = Nil@@ -256,14 +330,27 @@ -- Either -data instance Sing :: Either k1 k2 -> Type where- SLeft :: forall k1 (a :: k1). Sing a -> Sing (Left a)- SRight :: forall k2 (b :: k2). Sing b -> Sing (Right b)+#if __GLASGOW_HASKELL__ >= 810+type SEither :: forall k1 k2. Either k1 k2 -> Type+#endif+data SEither :: forall k1 k2. Either k1 k2 -> Type where+ SLeft :: forall k1 (a :: k1). Sing a -> SEither (Left a)+ SRight :: forall k2 (b :: k2). Sing b -> SEither (Right b)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Either k1 k2) =+#else+type instance Sing =+#endif+ SEither instance (SingI a) => SingI (Left (a :: k)) where sing = SLeft sing+instance SingI1 Left where+ liftSing = SLeft instance (SingI b) => SingI (Right (b :: k)) where sing = SRight sing+instance SingI1 Right where+ liftSing = SRight instance (SingKind k1, SingKind k2) => SingKind (Either k1 k2) where type Demote (Either k1 k2) = Either (Demote k1) (Demote k2) fromSing (SLeft x) = Left (fromSing x)@@ -289,14 +376,28 @@ -- Composite +#if __GLASGOW_HASKELL__ >= 810+type Composite :: Type -> Type -> Type+#endif data Composite :: Type -> Type -> Type where MkComp :: Either (Maybe a) b -> Composite a b -data instance Sing :: Composite k1 k2 -> Type where- SMkComp :: forall k1 k2 (a :: Either (Maybe k1) k2). Sing a -> Sing (MkComp a)+#if __GLASGOW_HASKELL__ >= 810+type SComposite :: forall k1 k2. Composite k1 k2 -> Type+#endif+data SComposite :: forall k1 k2. Composite k1 k2 -> Type where+ SMkComp :: forall k1 k2 (a :: Either (Maybe k1) k2). SEither a -> SComposite (MkComp a)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Composite k1 k2) =+#else+type instance Sing =+#endif+ SComposite instance SingI a => SingI (MkComp (a :: Either (Maybe k1) k2)) where sing = SMkComp sing+instance SingI1 MkComp where+ liftSing = SMkComp instance (SingKind k1, SingKind k2) => SingKind (Composite k1 k2) where type Demote (Composite k1 k2) = Composite (Demote k1) (Demote k2)@@ -313,8 +414,22 @@ -- Empty +#if __GLASGOW_HASKELL__ >= 810+type Empty :: Type+#endif data Empty-data instance Sing :: Empty -> Type++#if __GLASGOW_HASKELL__ >= 810+type SEmpty :: Empty -> Type+#endif+data SEmpty :: Empty -> Type++#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Empty =+#else+type instance Sing =+#endif+ SEmpty instance SingKind Empty where type Demote Empty = Empty fromSing = \case@@ -322,23 +437,44 @@ -- Type +#if __GLASGOW_HASKELL__ >= 810+type Vec :: Type -> Nat -> Type+#endif data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) +#if __GLASGOW_HASKELL__ >= 810+type Rep :: Type+#endif data Rep = Nat | Maybe Rep | Vec Rep Nat -data instance Sing :: Type -> Type where- SNat :: Sing Nat- SMaybe :: Sing a -> Sing (Maybe a)- SVec :: Sing a -> Sing n -> Sing (Vec a n)+#if __GLASGOW_HASKELL__ >= 810+type SRep :: Type -> Type+#endif+data SRep :: Type -> Type where+ SNat :: SRep Nat+ SMaybe :: SRep a -> SRep (Maybe a)+ SVec :: SRep a -> SNat n -> SRep (Vec a n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Type =+#else+type instance Sing =+#endif+ SRep instance SingI Nat where sing = SNat instance SingI a => SingI (Maybe a) where sing = SMaybe sing+instance SingI1 Maybe where+ liftSing = SMaybe instance (SingI a, SingI n) => SingI (Vec a n) where sing = SVec sing sing+instance SingI a => SingI1 (Vec a) where+ liftSing = SVec sing+instance SingI2 Vec where+ liftSing2 = SVec instance SingKind Type where type Demote Type = Rep@@ -374,7 +510,10 @@ (Disproved contra, _) -> Disproved (\Refl -> contra Refl) (_, Disproved contra) -> Disproved (\Refl -> contra Refl) -type family EqualsType (a :: Type) (b :: Type) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsType :: Type -> Type -> Bool+#endif+type family EqualsType (a :: Type) (b :: Type) :: Bool where EqualsType a a = True EqualsType _ _ = False instance PEq Type where@@ -394,12 +533,18 @@ isJust Nothing = False isJust (Just _) = True +#if __GLASGOW_HASKELL__ >= 810+type IsJust :: Maybe k -> Bool+#endif type family IsJust (a :: Maybe k) :: Bool where IsJust Nothing = False IsJust (Just a) = True -- defunctionalization symbols-data IsJustSym0 :: Maybe a ~> Bool+#if __GLASGOW_HASKELL__ >= 810+type IsJustSym0 :: forall a. Maybe a ~> Bool+#endif+data IsJustSym0 :: forall a. Maybe a ~> Bool type instance Apply IsJustSym0 a = IsJust a sIsJust :: Sing a -> Sing (IsJust a)@@ -410,10 +555,16 @@ pred Zero = Zero pred (Succ n) = n +#if __GLASGOW_HASKELL__ >= 810+type Pred :: Nat -> Nat+#endif type family Pred (a :: Nat) :: Nat where Pred Zero = Zero Pred (Succ n) = n +#if __GLASGOW_HASKELL__ >= 810+type PredSym0 :: Nat ~> Nat+#endif data PredSym0 :: Nat ~> Nat type instance Apply PredSym0 a = Pred a @@ -425,15 +576,22 @@ map _ Nil = Nil map f (Cons h t) = Cons (f h) (map f t) +#if __GLASGOW_HASKELL__ >= 810+type Map :: (k1 ~> k2) -> List k1 -> List k2+#endif type family Map (f :: k1 ~> k2) (l :: List k1) :: List k2 where Map f Nil = Nil Map f (Cons h t) = Cons (Apply f h) (Map f t) -- defunctionalization symbols-data MapSym1 :: (a ~> b) -> List a ~> List b-data MapSym0 :: (a ~> b) ~> List a ~> List b-type instance Apply (MapSym1 f) xs = Map f xs+#if __GLASGOW_HASKELL__ >= 810+type MapSym0 :: forall a b. (a ~> b) ~> List a ~> List b+type MapSym1 :: forall a b. (a ~> b) -> List a ~> List b+#endif+data MapSym0 :: forall a b. (a ~> b) ~> List a ~> List b+data MapSym1 :: forall a b. (a ~> b) -> List a ~> List b type instance Apply MapSym0 f = MapSym1 f+type instance Apply (MapSym1 f) xs = Map f xs sMap :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). (forall b. Proxy f -> Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a)@@ -458,26 +616,32 @@ baz :: Sing (Cons Zero (Cons Zero Nil)) baz = sMap2 (Proxy :: Proxy PredSym0) (sPred) (SCons (SSucc SZero) (SCons SZero SNil)) -zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]-zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys-zipWith _ [] (_:_) = []-zipWith _ (_:_) [] = []-zipWith _ [] [] = []+zipWith :: (a -> b -> c) -> List a -> List b -> List c+zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith f xs ys)+zipWith _ Nil (Cons _ _) = Nil+zipWith _ (Cons _ _) Nil = Nil+zipWith _ Nil Nil = Nil -type family ZipWith (k1 :: a ~> b ~> c)- (k2 :: List a)- (k3 :: List b) :: List c where+#if __GLASGOW_HASKELL__ >= 810+type ZipWith :: (a ~> b ~> c) -> List a -> List b -> List c+#endif+type family ZipWith (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b) :: List c where ZipWith f (Cons x xs) (Cons y ys) = Cons (Apply (Apply f x) y) (ZipWith f xs ys) ZipWith f Nil (Cons z1 z2) = Nil ZipWith f (Cons z1 z2) Nil = Nil ZipWith f Nil Nil = Nil -data ZipWithSym2 :: (a ~> b ~> c) -> List a -> List b ~> List c-data ZipWithSym1 :: (a ~> b ~> c) -> List a ~> List b ~> List c-data ZipWithSym0 :: (a ~> b ~> c) ~> List a ~> List b ~> List c-type instance Apply (ZipWithSym2 f xs) ys = ZipWith f xs ys-type instance Apply (ZipWithSym1 f) xs = ZipWithSym2 f xs+#if __GLASGOW_HASKELL__ >= 810+type ZipWithSym0 :: forall a b c. (a ~> b ~> c) ~> List a ~> List b ~> List c+type ZipWithSym1 :: forall a b c. (a ~> b ~> c) -> List a ~> List b ~> List c+type ZipWithSym2 :: forall a b c. (a ~> b ~> c) -> List a -> List b ~> List c+#endif+data ZipWithSym0 :: forall a b c. (a ~> b ~> c) ~> List a ~> List b ~> List c+data ZipWithSym1 :: forall a b c. (a ~> b ~> c) -> List a ~> List b ~> List c+data ZipWithSym2 :: forall a b c. (a ~> b ~> c) -> List a -> List b ~> List c type instance Apply ZipWithSym0 f = ZipWithSym1 f+type instance Apply (ZipWithSym1 f) xs = ZipWithSym2 f xs+type instance Apply (ZipWithSym2 f xs) ys = ZipWith f xs ys sZipWith :: forall a b c (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b).@@ -492,17 +656,25 @@ either l _ (Left x) = l x either _ r (Right x) = r x +#if __GLASGOW_HASKELL__ >= 810+type Either_ :: (a ~> c) -> (b ~> c) -> Either a b -> c+#endif type family Either_ (l :: a ~> c) (r :: b ~> c) (e :: Either a b) :: c where Either_ l r (Left x) = Apply l x Either_ l r (Right x) = Apply r x -- defunctionalization symbols-data Either_Sym2 :: (a ~> c) -> (b ~> c) -> Either a b ~> c-data Either_Sym1 :: (a ~> c) -> (b ~> c) ~> Either a b ~> c-data Either_Sym0 :: (a ~> c) ~> (b ~> c) ~> Either a b ~> c-type instance Apply (Either_Sym2 k1 k2) k3 = Either_ k1 k2 k3-type instance Apply (Either_Sym1 k1) k2 = Either_Sym2 k1 k2+#if __GLASGOW_HASKELL__ >= 810+type Either_Sym0 :: forall a c b. (a ~> c) ~> (b ~> c) ~> Either a b ~> c+type Either_Sym1 :: forall a c b. (a ~> c) -> (b ~> c) ~> Either a b ~> c+type Either_Sym2 :: forall a c b. (a ~> c) -> (b ~> c) -> Either a b ~> c+#endif+data Either_Sym0 :: forall a c b. (a ~> c) ~> (b ~> c) ~> Either a b ~> c+data Either_Sym1 :: forall a c b. (a ~> c) -> (b ~> c) ~> Either a b ~> c+data Either_Sym2 :: forall a c b. (a ~> c) -> (b ~> c) -> Either a b ~> c type instance Apply Either_Sym0 k1 = Either_Sym1 k1+type instance Apply (Either_Sym1 k1) k2 = Either_Sym2 k1 k2+type instance Apply (Either_Sym2 k1 k2) k3 = Either_ k1 k2 k3 sEither :: forall a b c (l :: a ~> c)@@ -541,6 +713,9 @@ eitherToNat (Left x) = x eitherToNat (Right x) = x +#if __GLASGOW_HASKELL__ >= 810+type EitherToNat :: Either Nat Nat -> Nat+#endif type family EitherToNat (e :: Either Nat Nat) :: Nat where EitherToNat (Left x) = x EitherToNat (Right x) = x@@ -553,14 +728,21 @@ liftMaybe _ Nothing = Nothing liftMaybe f (Just a) = Just (f a) +#if __GLASGOW_HASKELL__ >= 810+type LiftMaybe :: (a ~> b) -> Maybe a -> Maybe b+#endif type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where LiftMaybe f Nothing = Nothing LiftMaybe f (Just a) = Just (Apply f a) -data LiftMaybeSym1 :: (a ~> b) -> Maybe a ~> Maybe b-data LiftMaybeSym0 :: (a ~> b) ~> Maybe a ~> Maybe b-type instance Apply (LiftMaybeSym1 k1) k2 = LiftMaybe k1 k2+#if __GLASGOW_HASKELL__ >= 810+type LiftMaybeSym0 :: forall a b. (a ~> b) ~> Maybe a ~> Maybe b+type LiftMaybeSym1 :: forall a b. (a ~> b) -> Maybe a ~> Maybe b+#endif+data LiftMaybeSym0 :: forall a b. (a ~> b) ~> Maybe a ~> Maybe b+data LiftMaybeSym1 :: forall a b. (a ~> b) -> Maybe a ~> Maybe b type instance Apply LiftMaybeSym0 k1 = LiftMaybeSym1 k1+type instance Apply (LiftMaybeSym1 k1) k2 = LiftMaybe k1 k2 sLiftMaybe :: forall a b (f :: a ~> b) (x :: Maybe a). (forall (y :: a). Proxy f -> Sing y -> Sing (Apply f y)) ->@@ -572,15 +754,22 @@ Zero + x = x (Succ x) + y = Succ (x + y) +#if __GLASGOW_HASKELL__ >= 810+type (+) :: Nat -> Nat -> Nat+#endif type family (+) (m :: Nat) (n :: Nat) :: Nat where Zero + x = x (Succ x) + y = Succ (x + y) -- defunctionalization symbols-data (+$$) :: Nat -> Nat ~> Nat-data (+$) :: Nat ~> Nat ~> Nat-type instance Apply ((+$$) k1) k2 = (+) k1 k2-type instance Apply (+$) k1 = (+$$) k1+#if __GLASGOW_HASKELL__ >= 810+type (+@#@$) :: Nat ~> Nat ~> Nat+type (+@#@$$) :: Nat -> Nat ~> Nat+#endif+data (+@#@$) :: Nat ~> Nat ~> Nat+data (+@#@$$) :: Nat -> Nat ~> Nat+type instance Apply (+@#@$) k1 = (+@#@$$) k1+type instance Apply ((+@#@$$) k1) k2 = (+) k1 k2 (%+) :: Sing m -> Sing n -> Sing (m + n) SZero %+ x = x@@ -591,15 +780,22 @@ (Succ x) - Zero = Succ x (Succ x) - (Succ y) = x - y +#if __GLASGOW_HASKELL__ >= 810+type (-) :: Nat -> Nat -> Nat+#endif type family (-) (m :: Nat) (n :: Nat) :: Nat where Zero - x = Zero (Succ x) - Zero = Succ x (Succ x) - (Succ y) = x - y -data (-$$) :: Nat -> Nat ~> Nat-data (-$) :: Nat ~> Nat ~> Nat-type instance Apply ((-$$) k1) k2 = (-) k1 k2-type instance Apply (-$) k1 = (-$$) k1+#if __GLASGOW_HASKELL__ >= 810+type (-@#@$) :: Nat ~> Nat ~> Nat+type (-@#@$$) :: Nat -> Nat ~> Nat+#endif+data (-@#@$) :: Nat ~> Nat ~> Nat+data (-@#@$$) :: Nat -> Nat ~> Nat+type instance Apply (-@#@$) k1 = (-@#@$$) k1+type instance Apply ((-@#@$$) k1) k2 = (-) k1 k2 (%-) :: Sing m -> Sing n -> Sing (m - n) SZero %- _ = SZero@@ -609,46 +805,66 @@ isZero :: Nat -> Bool isZero n = if n == Zero then True else False +#if __GLASGOW_HASKELL__ >= 810+type IsZero :: Nat -> Bool+#endif type family IsZero (n :: Nat) :: Bool where IsZero n = If (n == Zero) True False +#if __GLASGOW_HASKELL__ >= 810+type IsZeroSym0 :: Nat ~> Bool+#endif data IsZeroSym0 :: Nat ~> Bool type instance Apply IsZeroSym0 a = IsZero a sIsZero :: Sing n -> Sing (IsZero n) sIsZero n = sIf (n %== SZero) STrue SFalse +{- (||) :: Bool -> Bool -> Bool False || x = x True || _ = True+-} +#if __GLASGOW_HASKELL__ >= 810+type (||) :: Bool -> Bool -> Bool+#endif type family (a :: Bool) || (b :: Bool) :: Bool where False || x = x True || x = True -data (||$$) :: Bool -> Bool ~> Bool-data (||$) :: Bool ~> Bool ~> Bool-type instance Apply ((||$$) a) b = (||) a b-type instance Apply (||$) a = (||$$) a+#if __GLASGOW_HASKELL__ >= 810+type (||@#@$) :: Bool ~> Bool ~> Bool+type (||@#@$$) :: Bool -> Bool ~> Bool+#endif+data (||@#@$) :: Bool ~> Bool ~> Bool+data (||@#@$$) :: Bool -> Bool ~> Bool+type instance Apply (||@#@$) a = (||@#@$$) a+type instance Apply ((||@#@$$) a) b = (||) a b (%||) :: Sing a -> Sing b -> Sing (a || b) SFalse %|| x = x STrue %|| _ = STrue -{- contains :: Eq a => a -> List a -> Bool contains _ Nil = False contains elt (Cons h t) = (elt == h) || contains elt t--} +#if __GLASGOW_HASKELL__ >= 810+type Contains :: k -> List k -> Bool+#endif type family Contains (a :: k) (b :: List k) :: Bool where Contains elt Nil = False Contains elt (Cons h t) = (elt == h) || (Contains elt t) -data ContainsSym1 :: a -> List a ~> Bool-data ContainsSym0 :: a ~> List a ~> Bool-type instance Apply (ContainsSym1 a) b = Contains a b+#if __GLASGOW_HASKELL__ >= 810+type ContainsSym0 :: forall a. a ~> List a ~> Bool+type ContainsSym1 :: forall a. a -> List a ~> Bool+#endif+data ContainsSym0 :: forall a. a ~> List a ~> Bool+data ContainsSym1 :: forall a. a -> List a ~> Bool type instance Apply ContainsSym0 a = ContainsSym1 a+type instance Apply (ContainsSym1 a) b = Contains a b {- sContains :: forall k. SEq k =>@@ -671,13 +887,14 @@ in lambda elt h t -{- cont :: Eq a => a -> List a -> Bool cont = \elt list -> case list of Nil -> False Cons h t -> (elt == h) || cont elt t--} +#if __GLASGOW_HASKELL__ >= 810+type Cont :: a ~> List a ~> Bool+#endif type family Cont :: a ~> List a ~> Bool where Cont = Lambda10Sym0 @@ -700,21 +917,22 @@ type family Case10 a b scrut where Case10 elt list Nil = False- Case10 elt list (Cons h t) = (||$) @@ ((==$) @@ elt @@ h) @@ (Cont @@ elt @@ t)+ Case10 elt list (Cons h t) = (||@#@$) @@ ((==@#@$) @@ elt @@ h) @@ (Cont @@ elt @@ t) -data (==$) f where- (:###==$) :: ((==$) @@ arg) ~ (==$$) arg- => Proxy arg- -> (==$) f-type instance (==$) `Apply` x = (==$$) x+data (==@#@$) f where+ (:###==@#@$) :: ((==@#@$) @@ arg) ~ (==@#@$$) arg+ => Proxy arg+ -> (==@#@$) f+type instance (==@#@$) `Apply` x = (==@#@$$) x -data (==$$) a f where- (:###==$$) :: ((==$$) x @@ arg) ~ (==$$$) x arg- => Proxy arg- -> (==$$) x y-type instance (==$$) a `Apply` b = (==$$$) a b+data (==@#@$$) a f where+ (:###==@#@$$) :: ((==@#@$$) x @@ arg) ~ (==@#@$$$) x arg+ => Proxy arg+ -> (==@#@$$) x y+type instance (==@#@$$) a `Apply` b = (==) a b -type (==$$$) a b = (==) a b+type family (==@#@$$$) a b where+ (==@#@$$$) a b = (==) a b impNat :: forall m n. SingI n => Proxy n -> Sing m -> Sing (n + m)@@ -723,29 +941,20 @@ callImpNat :: forall n m. Sing n -> Sing m -> Sing (n + m) callImpNat sn sm = withSingI sn (impNat (Proxy :: Proxy n) sm) -instance Show (Sing (n :: Nat)) where+instance Show (SNat n) where show SZero = "SZero" show (SSucc n) = "SSucc (" ++ (show n) ++ ")" -{- findIndices :: (a -> Bool) -> [a] -> [Nat] findIndices p ls = loop Zero ls where loop _ [] = [] loop n (x:xs) | p x = n : loop (Succ n) xs | otherwise = loop (Succ n) xs--} -findIndices' :: forall a. (a -> Bool) -> [a] -> [Nat]-findIndices' p ls =- let loop :: Nat -> [a] -> [Nat]- loop _ [] = []- loop n (x:xs) = case p x of- True -> n : loop (Succ n) xs- False -> loop (Succ n) xs- in- loop Zero ls-+#if __GLASGOW_HASKELL__ >= 810+type FindIndices :: (a ~> Bool) -> List a -> List Nat+#endif type family FindIndices (f :: a ~> Bool) (ls :: List a) :: List Nat where FindIndices p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls @@ -767,9 +976,10 @@ KindInferenceLet123LoopSym3 :: ((Let123LoopSym3 a b c @@ z) ~ Let123LoopSym4 a b c z) => Proxy z -> Let123LoopSym3 a b c d-type instance Apply (Let123LoopSym3 a b c) d = Let123LoopSym4 a b c d+type instance Apply (Let123LoopSym3 a b c) d = Let123Loop a b c d -type Let123LoopSym4 a b c d = Let123Loop a b c d+type family Let123LoopSym4 a b c d where+ Let123LoopSym4 a b c d = Let123Loop a b c d data FindIndicesSym0 a where KindInferenceFindIndicesSym0 :: (FindIndicesSym0 @@ z) ~ FindIndicesSym1 z@@ -781,17 +991,18 @@ KindInferenceFindIndicesSym1 :: (FindIndicesSym1 a @@ z) ~ FindIndicesSym2 a z => Proxy z -> FindIndicesSym1 a b-type instance Apply (FindIndicesSym1 a) b = FindIndicesSym2 a b+type instance Apply (FindIndicesSym1 a) b = FindIndices a b -type FindIndicesSym2 a b = FindIndices a b+type family FindIndicesSym2 a b where+ FindIndicesSym2 a b = FindIndices a b sFindIndices :: forall a (t1 :: a ~> Bool) (t2 :: (List a)). Sing t1 -> Sing t2 -> Sing (FindIndicesSym0 @@ t1 @@ t2) sFindIndices sP sLs =- let sLoop :: forall (u1 :: Nat). Sing u1- -> forall (u2 :: List a). Sing u2+ let sLoop :: forall (u1 :: Nat) (u2 :: List a).+ Sing u1 -> Sing u2 -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2) sLoop _ SNil = SNil sLoop sN (sX `SCons` sXs) = case sP @@ sX of@@ -829,9 +1040,10 @@ KindInferenceLambda22Sym1 :: (Lambda22Sym1 a @@ z) ~ Lambda22Sym2 a z => Proxy z -> Lambda22Sym1 a b-type instance Apply (Lambda22Sym1 a) b = Lambda22Sym2 a b+type instance Apply (Lambda22Sym1 a) b = Lambda22 a b -type Lambda22Sym2 a b = Lambda22 a b+type family Lambda22Sym2 a b where+ Lambda22Sym2 a b = Lambda22 a b {- sFI :: forall a (t1 :: a ~> Bool) (t2 :: List a). Sing t1@@ -857,8 +1069,20 @@ ------------------------------------------------------------ -data G a where+#if __GLASGOW_HASKELL__ >= 810+type G :: Type -> Type+#endif+data G :: Type -> Type where MkG :: G Bool -data instance Sing :: G a -> Type where- SMkG :: Sing MkG+#if __GLASGOW_HASKELL__ >= 810+type SG :: forall a. G a -> Type+#endif+data SG :: forall a. G a -> Type where+ SMkG :: SG MkG+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(G a) =+#else+type instance Sing =+#endif+ SG
tests/ByHand2.hs view
@@ -1,44 +1,85 @@ {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators, DefaultSignatures, ScopedTypeVariables, InstanceSigs, MultiParamTypeClasses, FunctionalDependencies,- UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-}+ UndecidableInstances, CPP, TypeApplications #-}+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-orphans #-}++#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif module ByHand2 where -import Prelude hiding ( Eq(..), Ord(..), Bool(..), Ordering(..), not )-import Data.Kind (Type)+import Data.Kind import Data.Singletons (Sing) +#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif data Nat = Zero | Succ Nat-data Bool = False | True-data Ordering = LT | EQ | GT -not :: Bool -> Bool-not False = True-not True = False+#if __GLASGOW_HASKELL__ >= 810+type SNat :: Nat -> Type+#endif+data SNat :: Nat -> Type where+ SZero :: SNat 'Zero+ SSucc :: SNat n -> SNat ('Succ n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Nat =+#else+type instance Sing =+#endif+ SNat -class Eq a where- (==) :: a -> a -> Bool- (/=) :: a -> a -> Bool- infix 4 ==, /=+{-+type Bool :: Type+data Bool = False | True+-} - x == y = not (x /= y)- x /= y = not (x == y)+#if __GLASGOW_HASKELL__ >= 810+type SBool :: Bool -> Type+#endif+data SBool :: Bool -> Type where+ SFalse :: SBool 'False+ STrue :: SBool 'True+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Bool =+#else+type instance Sing =+#endif+ SBool -instance Eq Nat where- Zero == Zero = True- Zero == Succ _ = False- Succ _ == Zero = False- Succ x == Succ y = x == y+{-+type Ordering :: Type+data Ordering = LT | EQ | GT+-} -data instance Sing :: Bool -> Type where- SFalse :: Sing 'False- STrue :: Sing 'True+#if __GLASGOW_HASKELL__ >= 810+type SOrdering :: Ordering -> Type+#endif+data SOrdering :: Ordering -> Type where+ SLT :: SOrdering 'LT+ SEQ :: SOrdering 'EQ+ SGT :: SOrdering 'GT+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Ordering =+#else+type instance Sing =+#endif+ SOrdering -data instance Sing :: Nat -> Type where- SZero :: Sing 'Zero- SSucc :: Sing n -> Sing ('Succ n)+{-+not :: Bool -> Bool+not True = False+not False = True+-} +#if __GLASGOW_HASKELL__ >= 810+type Not :: Bool -> Bool+#endif type family Not (x :: Bool) :: Bool where Not 'True = 'False Not 'False = 'True@@ -47,6 +88,20 @@ sNot STrue = SFalse sNot SFalse = STrue +{-+type Eq :: Type -> Constraint+class Eq a where+ (==) :: a -> a -> Bool+ (/=) :: a -> a -> Bool+ infix 4 ==, /=++ x == y = not (x /= y)+ x /= y = not (x == y)+-}++#if __GLASGOW_HASKELL__ >= 810+type PEq :: Type -> Constraint+#endif class PEq a where type (==) (x :: a) (y :: a) :: Bool type (/=) (x :: a) (y :: a) :: Bool@@ -54,12 +109,9 @@ type x == y = Not (x /= y) type x /= y = Not (x == y) -instance PEq Nat where- type 'Zero == 'Zero = 'True- type 'Succ x == 'Zero = 'False- type 'Zero == 'Succ x = 'False- type 'Succ x == 'Succ y = x == y-+#if __GLASGOW_HASKELL__ >= 810+type SEq :: Type -> Constraint+#endif class SEq a where (%==) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x == y) (%/=) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y)@@ -70,6 +122,18 @@ default (%/=) :: ((x /= y) ~ (Not (x == y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y) x %/= y = sNot (x %== y) +instance Eq Nat where+ Zero == Zero = True+ Zero == Succ _ = False+ Succ _ == Zero = False+ Succ x == Succ y = x == y++instance PEq Nat where+ type 'Zero == 'Zero = 'True+ type 'Succ x == 'Zero = 'False+ type 'Zero == 'Succ x = 'False+ type 'Succ x == 'Succ y = x == y+ instance SEq Nat where (%==) :: forall (x :: Nat) (y :: Nat). Sing x -> Sing y -> Sing (x == y) SZero %== SZero = STrue@@ -77,6 +141,7 @@ SZero %== SSucc _ = SFalse SSucc x %== SSucc y = x %== y +{- instance Eq Ordering where LT == LT = True LT == EQ = False@@ -87,35 +152,7 @@ GT == LT = False GT == EQ = False GT == GT = True--class Eq a => Ord a where- compare :: a -> a -> Ordering- (<) :: a -> a -> Bool-- x < y = compare x y == LT--class PEq a => POrd a where- type Compare (x :: a) (y :: a) :: Ordering- type (<) (x :: a) (y :: a) :: Bool-- type x < y = Compare x y == 'LT--instance Ord Nat where- compare Zero Zero = EQ- compare Zero (Succ _) = LT- compare (Succ _) Zero = GT- compare (Succ a) (Succ b) = compare a b--instance POrd Nat where- type Compare 'Zero 'Zero = 'EQ- type Compare 'Zero ('Succ x) = 'LT- type Compare ('Succ x) 'Zero = 'GT- type Compare ('Succ x) ('Succ y) = Compare x y--data instance Sing :: Ordering -> Type where- SLT :: Sing 'LT- SEQ :: Sing 'EQ- SGT :: Sing 'GT+-} instance PEq Ordering where type 'LT == 'LT = 'True@@ -139,6 +176,27 @@ SGT %== SEQ = SFalse SGT %== SGT = STrue +{-+type Ord :: Type -> Constraint+class Eq a => Ord a where+ compare :: a -> a -> Ordering+ (<) :: a -> a -> Bool++ x < y = compare x y == LT+-}++#if __GLASGOW_HASKELL__ >= 810+type POrd :: Type -> Constraint+#endif+class PEq a => POrd a where+ type Compare (x :: a) (y :: a) :: Ordering+ type (<) (x :: a) (y :: a) :: Bool++ type x < y = Compare x y == 'LT++#if __GLASGOW_HASKELL__ >= 810+type SOrd :: Type -> Constraint+#endif class SEq a => SOrd a where sCompare :: Sing (x :: a) -> Sing (y :: a) -> Sing (Compare x y) (%<) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x < y)@@ -146,18 +204,39 @@ default (%<) :: ((x < y) ~ (Compare x y == 'LT)) => Sing (x :: a) -> Sing (y :: a) -> Sing (x < y) x %< y = sCompare x y %== SLT +instance Ord Nat where+ compare Zero Zero = EQ+ compare Zero (Succ _) = LT+ compare (Succ _) Zero = GT+ compare (Succ a) (Succ b) = compare a b++instance POrd Nat where+ type Compare 'Zero 'Zero = 'EQ+ type Compare 'Zero ('Succ x) = 'LT+ type Compare ('Succ x) 'Zero = 'GT+ type Compare ('Succ x) ('Succ y) = Compare x y+ instance SOrd Nat where sCompare SZero SZero = SEQ sCompare SZero (SSucc _) = SLT sCompare (SSucc _) SZero = SGT sCompare (SSucc x) (SSucc y) = sCompare x y +#if __GLASGOW_HASKELL__ >= 810+type Pointed :: Type -> Constraint+#endif class Pointed a where point :: a +#if __GLASGOW_HASKELL__ >= 810+type PPointed :: Type -> Constraint+#endif class PPointed a where type Point :: a +#if __GLASGOW_HASKELL__ >= 810+type SPointed :: Type -> Constraint+#endif class SPointed a where sPoint :: Sing (Point :: a) @@ -172,6 +251,9 @@ -------------------------------- +#if __GLASGOW_HASKELL__ >= 810+type FD :: Type -> Type -> Constraint+#endif class FD a b | a -> b where meth :: a -> a l2r :: a -> b@@ -184,6 +266,9 @@ t1 = meth True t2 = l2r False +#if __GLASGOW_HASKELL__ >= 810+type PFD :: Type -> Type -> Constraint+#endif class PFD a b | a -> b where type Meth (x :: a) :: a type L2r (x :: a) :: b@@ -194,8 +279,15 @@ type L2r 'True = 'Succ 'Zero type T1 = Meth 'True-type T2 = L2r 'False +#if __GLASGOW_HASKELL__ >= 810+type T2 :: Nat+#endif+type T2 = (L2r 'False :: Nat)++#if __GLASGOW_HASKELL__ >= 810+type SFD :: Type -> Type -> Constraint+#endif class SFD a b | a -> b where sMeth :: forall (x :: a). Sing x -> Sing (Meth x :: a) sL2r :: forall (x :: a). Sing x -> Sing (L2r x :: b)@@ -206,5 +298,5 @@ sL2r STrue = SSucc SZero sT1 = sMeth STrue-sT2 :: Sing (T2 :: Nat)+sT2 :: Sing T2 sT2 = sL2r SFalse
tests/SingletonsTestSuite.hs view
@@ -1,123 +1,6 @@-module Main (- main- ) where--import Test.Tasty ( TestTree, defaultMain, testGroup )-import SingletonsTestSuiteUtils ( compileAndDumpStdTest, compileAndDumpTest- , testCompileAndDumpGroup, ghcOpts- -- , cleanFiles- )+-- | Currently, there is code to execute at runtime as a part of this test+-- suite, as the only interesting part is making sure that the code typechecks.+module Main (main) where main :: IO ()-main = do--- cleanFiles We really need to parallelize the testsuite.- defaultMain tests--tests :: TestTree-tests =- testGroup "Testsuite" $ [- testCompileAndDumpGroup "Singletons"- [ compileAndDumpStdTest "Nat"- , compileAndDumpStdTest "Empty"- , compileAndDumpStdTest "Maybe"- , compileAndDumpStdTest "BoxUnBox"- , compileAndDumpStdTest "Operators"- , compileAndDumpStdTest "HigherOrder"- , compileAndDumpStdTest "Contains"- , compileAndDumpStdTest "AsPattern"- , compileAndDumpStdTest "DataValues"- , compileAndDumpStdTest "EqInstances"- , compileAndDumpStdTest "CaseExpressions"- , compileAndDumpStdTest "Star"- , compileAndDumpStdTest "ReturnFunc"- , compileAndDumpStdTest "Lambdas"- , compileAndDumpStdTest "LambdasComprehensive"- , compileAndDumpStdTest "Error"- , compileAndDumpStdTest "TopLevelPatterns"- , compileAndDumpStdTest "LetStatements"- , compileAndDumpStdTest "LambdaCase"- , compileAndDumpStdTest "Sections"- , compileAndDumpStdTest "PatternMatching"- , compileAndDumpStdTest "Records"- , compileAndDumpStdTest "T29"- , compileAndDumpStdTest "T33"- , compileAndDumpStdTest "T54"- , compileAndDumpStdTest "Classes"- , compileAndDumpStdTest "Classes2"- , compileAndDumpStdTest "FunDeps"- , compileAndDumpStdTest "T78"- , compileAndDumpStdTest "OrdDeriving"- , compileAndDumpStdTest "BoundedDeriving"- , compileAndDumpStdTest "BadBoundedDeriving"- , compileAndDumpStdTest "EnumDeriving"- , compileAndDumpStdTest "BadEnumDeriving"- , compileAndDumpStdTest "Fixity"- , compileAndDumpStdTest "Undef"- , compileAndDumpStdTest "T124"- , compileAndDumpStdTest "T136"- , compileAndDumpStdTest "T136b"- , compileAndDumpStdTest "T153"- , compileAndDumpStdTest "T157"- , compileAndDumpStdTest "T159"- , compileAndDumpStdTest "T167"- , compileAndDumpStdTest "T145"- , compileAndDumpStdTest "PolyKinds"- , compileAndDumpStdTest "PolyKindsApp"- , compileAndDumpStdTest "T160"- , compileAndDumpStdTest "T163"- , compileAndDumpStdTest "T166"- , compileAndDumpStdTest "T172"- , compileAndDumpStdTest "T175"- , compileAndDumpStdTest "T176"- , compileAndDumpStdTest "T178"- , compileAndDumpStdTest "T183"- , compileAndDumpStdTest "T184"- , compileAndDumpStdTest "T187"- , compileAndDumpStdTest "T190"- , compileAndDumpStdTest "ShowDeriving"- , compileAndDumpStdTest "EmptyShowDeriving"- , compileAndDumpStdTest "StandaloneDeriving"- , compileAndDumpStdTest "T197"- , compileAndDumpStdTest "T197b"- , compileAndDumpStdTest "T200"- , compileAndDumpStdTest "T206"- , compileAndDumpStdTest "T209"- , compileAndDumpStdTest "T216"- , compileAndDumpStdTest "T226"- , compileAndDumpStdTest "T229"- , compileAndDumpStdTest "T249"- , compileAndDumpStdTest "OverloadedStrings"- , compileAndDumpStdTest "T271"- , compileAndDumpStdTest "T287"- , compileAndDumpStdTest "TypeRepTYPE"- , compileAndDumpStdTest "T297"- , compileAndDumpStdTest "T312"- , compileAndDumpStdTest "T313"- , compileAndDumpStdTest "T316"- , compileAndDumpStdTest "T322"- , compileAndDumpStdTest "NatSymbolReflexive"- , compileAndDumpStdTest "T323"- , compileAndDumpStdTest "T332"- , compileAndDumpStdTest "T342"- , compileAndDumpStdTest "FunctorLikeDeriving"- , compileAndDumpStdTest "T353"- , compileAndDumpStdTest "T358"- , compileAndDumpStdTest "T371"- ],- testCompileAndDumpGroup "Promote"- [ compileAndDumpStdTest "Constructors"- , compileAndDumpStdTest "GenDefunSymbols"- , compileAndDumpStdTest "Newtypes"- , compileAndDumpStdTest "Pragmas"- , compileAndDumpStdTest "Prelude"- , compileAndDumpStdTest "T180"- , compileAndDumpStdTest "T361"- ],- testGroup "Database client"- [ compileAndDumpTest "GradingClient/Database" ghcOpts- , compileAndDumpTest "GradingClient/Main" ghcOpts- ],- testCompileAndDumpGroup "InsertionSort"- [ compileAndDumpStdTest "InsertionSortImp"- ]- ]+main = pure ()
− tests/SingletonsTestSuiteUtils.hs
@@ -1,205 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module SingletonsTestSuiteUtils (- compileAndDumpTest- , compileAndDumpStdTest- , testCompileAndDumpGroup- , ghcOpts- , cleanFiles- ) where--import Build_singletons ( ghcPath, ghcFlags, rootDir )-import Control.Exception ( Exception, throw )-import Data.List ( intercalate )-import System.Exit ( ExitCode(..) )-import System.FilePath ( takeBaseName, pathSeparator )-import System.IO ( IOMode(..), hGetContents, openFile )-import System.FilePath ( (</>) )-import System.Process ( CreateProcess(..), StdStream(..)- , createProcess, proc, waitForProcess- , callCommand )-import Test.Tasty ( TestTree, testGroup )-import Test.Tasty.Golden ( goldenVsFileDiff )---- Some infractructure for handling external process errors-newtype ProcessException = ProcessException String- deriving newtype (Eq, Ord, Show)- deriving anyclass Exception---- directory storing compile-and-run tests and golden files-goldenPath :: FilePath-goldenPath = rootDir </> "tests/compile-and-dump/"--ghcVersion :: String-ghcVersion = ".ghc86"---- GHC options used when running the tests-ghcOpts :: [String]-ghcOpts = ghcFlags ++ [- "-v0"- , "-c"- , "-ddump-splices"- , "-dsuppress-uniques"- , "-fforce-recomp"- , "-fprint-explicit-kinds"- , "-O0"- , "-i" ++ goldenPath- , "-XTemplateHaskell"- , "-XDataKinds"- , "-XKindSignatures"- , "-XTypeFamilies"- , "-XTypeOperators"- , "-XMultiParamTypeClasses"- , "-XGADTs"- , "-XFlexibleInstances"- , "-XUndecidableInstances"- , "-XRankNTypes"- , "-XScopedTypeVariables"- , "-XPolyKinds"- , "-XFlexibleContexts"- , "-XIncoherentInstances"- , "-XLambdaCase"- , "-XUnboxedTuples"- , "-XInstanceSigs"- , "-XDefaultSignatures"- , "-XCPP"- , "-XStandaloneDeriving"- , "-XTypeApplications"- , "-XEmptyCase"- , "-XNoStarIsType"- ]---- Compile a test using specified GHC options. Save output to file, filter with--- sed and compare it with golden file. This function also builds golden file--- from a template file. Putting it here is a bit of a hack but it's easy and it--- works.------ First parameter is a path to the test file relative to goldenPath directory--- with no ".hs".-compileAndDumpTest :: FilePath -> [String] -> TestTree-compileAndDumpTest testName opts =- goldenVsFileDiff- (takeBaseName testName)- (\ref new -> ["diff", "-w", "-B", ref, new]) -- see Note [Diff options]- goldenFilePath- actualFilePath- compileWithGHC- where- testPath = testName ++ ".hs"- templateFilePath = goldenPath ++ testName ++ ghcVersion ++ ".template"- goldenFilePath = goldenPath ++ testName ++ ".golden"- actualFilePath = goldenPath ++ testName ++ ".actual"-- compileWithGHC :: IO ()- compileWithGHC = do- hActualFile <- openFile actualFilePath WriteMode- (_, _, _, pid) <- createProcess (proc ghcPath (testPath : opts))- { std_out = UseHandle hActualFile- , std_err = UseHandle hActualFile- , cwd = Just goldenPath }- _ <- waitForProcess pid -- see Note [Ignore exit code]- filterWithSed actualFilePath -- see Note [Normalization with sed]- buildGoldenFile templateFilePath goldenFilePath- return ()---- Compile-and-dump test using standard GHC options defined by the testsuite.--- It takes two parameters: name of a file containing a test (no ".hs"--- extension) and directory where the test is located (relative to--- goldenPath). Test name and path are passed separately so that this function--- can be used easily with testCompileAndDumpGroup.-compileAndDumpStdTest :: FilePath -> FilePath -> TestTree-compileAndDumpStdTest testName testPath =- compileAndDumpTest (testPath ++ (pathSeparator : testName)) ghcOpts---- A convenience function for defining a group of compile-and-dump tests stored--- in the same subdirectory. It takes the name of subdirectory and list of--- functions that given the name of subdirectory create a TestTree. Designed for--- use with compileAndDumpStdTest.-testCompileAndDumpGroup :: FilePath -> [FilePath -> TestTree] -> TestTree-testCompileAndDumpGroup testDir tests =- testGroup testDir $ map ($ testDir) tests---- Note [Ignore exit code]--- ~~~~~~~~~~~~~~~~~~~~~~~----- It may happen that compilation of a source file fails. We could find out--- whether that happened by inspecting the exit code of GHC process. But it--- would be tricky to get a helpful message from the failing test: we would need--- to display stderr which we just wrote into a file. Luckliy we don't have to--- do that - we can ignore the problem here and let the test fail when the--- actual file is compared with the golden file.---- Note [Diff options]--- ~~~~~~~~~~~~~~~~~~~------ We use following diff options:--- -w - Ignore all white space.--- -B - Ignore changes whose lines are all blank.---- Note [Normalization with sed]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ Output file is normalized with sed. Line numbers generated in splices:------ Foo:(40,3)-(42,4)--- Foo.hs:7:3:--- Equals_1235967303------ are turned into:------ Foo:(0,0)-(0,0)--- Foo.hs:0:0:--- Equals_0123456789------ This allows to insert comments into test file without the need to modify the--- golden file to adjust line numbers.------ Note that GNU sed (on Linux) and BSD sed (on MacOS) are slightly different.--- We use conditional compilation to deal with this.--filterWithSed :: FilePath -> IO ()-filterWithSed file = runProcessWithOpts CreatePipe "sed"-#ifdef darwin_HOST_OS- [ "-i", "''"-#else- [ "-i"-#endif- , "-e", "'s/([0-9]*,[0-9]*)-([0-9]*,[0-9]*)/(0,0)-(0,0)/g'"- , "-e", "'s/:[0-9][0-9]*:[0-9][0-9]*/:0:0/g'"- , "-e", "'s/:[0-9]*:[0-9]*-[0-9]*/:0:0:/g'"- , "-e", "'s/[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/0123456789/g'"- , "-e", "'s/[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/0123456789876543210/g'"- , "-e", "'s/[!#$%&*+./>]\\{10\\}/%%%%%%%%%%/g'"- , "-e", "'s/[!#$%&*+./>]\\{19\\}/%%%%%%%%%%%%%%%%%%%/g'"- -- Remove pretty-printed references to the singletons package- -- (e.g., turn `singletons-2.4.1:Sing` into `Sing`) to make the output- -- more stable.- , "-e", "'s/singletons-[0-9]\\+\\(\\.[0-9]\\+\\)*://g'"- , file- ]--buildGoldenFile :: FilePath -> FilePath -> IO ()-buildGoldenFile templateFilePath goldenFilePath = do- hGoldenFile <- openFile goldenFilePath WriteMode- runProcessWithOpts (UseHandle hGoldenFile) "awk"- [ "-f", goldenPath </> "buildGoldenFiles.awk"- , templateFilePath- ]--runProcessWithOpts :: StdStream -> String -> [String] -> IO ()-runProcessWithOpts stdout program opts = do- (_, _, Just serr, pid) <-- createProcess (proc "bash" ["-c", (intercalate " " (program : opts))])- { std_out = stdout- , std_err = CreatePipe }- ecode <- waitForProcess pid- case ecode of- ExitSuccess -> return ()- ExitFailure _ -> do- err <- hGetContents serr -- Text would be faster than String, but this is- -- a corner case so probably not worth it.- throw $ ProcessException ("Error when running " ++ program ++ ":\n" ++ err)--cleanFiles :: IO ()-cleanFiles = callCommand $ "rm -f " ++ rootDir </> "tests/compile-and-dump/*/*.{hi,o}"
− tests/compile-and-dump/GradingClient/Database.ghc86.template
@@ -1,2610 +0,0 @@-GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Nat- = Zero | Succ Nat- deriving (Eq, Ord) |]- ======>- data Nat- = Zero | Succ Nat- deriving (Eq, Ord)- type ZeroSym0 = Zero- type SuccSym1 (t0123456789876543210 :: Nat) =- Succ t0123456789876543210- instance SuppressUnusedWarnings SuccSym0 where- suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ())- data SuccSym0 :: (~>) Nat Nat- where- SuccSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>- SuccSym0 t0123456789876543210- type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210- type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where- Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- Compare_0123456789876543210 Zero (Succ _) = LTSym0- Compare_0123456789876543210 (Succ _) Zero = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Nat where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where- Equals_0123456789876543210 Zero Zero = TrueSym0- Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b- Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0- instance PEq Nat where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: Nat -> Type- where- SZero :: Sing Zero- SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n)- type SNat = (Sing :: Nat -> Type)- instance SingKind Nat where- type Demote Nat = Nat- fromSing SZero = Zero- fromSing (SSucc b) = Succ (fromSing b)- toSing Zero = SomeSing SZero- toSing (Succ (b :: Demote Nat))- = case toSing b :: SomeSing Nat of {- SomeSing c -> SomeSing (SSucc c) }- instance SOrd Nat => SOrd Nat where- sCompare ::- forall (t1 :: Nat) (t2 :: Nat).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering)- -> Type) t1) t2)- sCompare SZero SZero- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare- (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil)- sCompare SZero (SSucc _) = SLT- sCompare (SSucc _) SZero = SGT- instance SEq Nat => SEq Nat where- (%==) SZero SZero = STrue- (%==) SZero (SSucc _) = SFalse- (%==) (SSucc _) SZero = SFalse- (%==) (SSucc a) (SSucc b) = ((%==) a) b- instance SDecide Nat => SDecide Nat where- (%~) SZero SZero = Proved Refl- (%~) SZero (SSucc _) = Disproved (\ x -> case x of)- (%~) (SSucc _) SZero = Disproved (\ x -> case x of)- (%~) (SSucc a) (SSucc b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SingI Zero where- sing = SZero- instance SingI n => SingI (Succ (n :: Nat)) where- sing = SSucc sing- instance SingI (SuccSym0 :: (~>) Nat Nat) where- sing = (singFun1 @SuccSym0) SSucc- instance SingI (TyCon1 Succ :: (~>) Nat Nat) where- sing = (singFun1 @(TyCon1 Succ)) SSucc-GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| append :: Schema -> Schema -> Schema- append (Sch s1) (Sch s2) = Sch (s1 ++ s2)- attrNotIn :: Attribute -> Schema -> Bool- attrNotIn _ (Sch []) = True- attrNotIn (Attr name u) (Sch ((Attr name' _) : t))- = (name /= name') && (attrNotIn (Attr name u) (Sch t))- disjoint :: Schema -> Schema -> Bool- disjoint (Sch []) _ = True- disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s)- occurs :: [AChar] -> Schema -> Bool- occurs _ (Sch []) = False- occurs name (Sch ((Attr name' _) : attrs))- = name == name' || occurs name (Sch attrs)- lookup :: [AChar] -> Schema -> U- lookup _ (Sch []) = undefined- lookup name (Sch ((Attr name' u) : attrs))- = if name == name' then u else lookup name (Sch attrs)- - data U- = BOOL | STRING | NAT | VEC U Nat- deriving (Read, Eq, Show)- data AChar- = CA |- CB |- CC |- CD |- CE |- CF |- CG |- CH |- CI |- CJ |- CK |- CL |- CM |- CN |- CO |- CP |- CQ |- CR |- CS |- CT |- CU |- CV |- CW |- CX |- CY |- CZ- deriving (Read, Show, Eq)- data Attribute = Attr [AChar] U- data Schema = Sch [Attribute] |]- ======>- data U- = BOOL | STRING | NAT | VEC U Nat- deriving (Read, Eq, Show)- data AChar- = CA |- CB |- CC |- CD |- CE |- CF |- CG |- CH |- CI |- CJ |- CK |- CL |- CM |- CN |- CO |- CP |- CQ |- CR |- CS |- CT |- CU |- CV |- CW |- CX |- CY |- CZ- deriving (Read, Show, Eq)- data Attribute = Attr [AChar] U- data Schema = Sch [Attribute]- append :: Schema -> Schema -> Schema- append (Sch s1) (Sch s2) = Sch (s1 ++ s2)- attrNotIn :: Attribute -> Schema -> Bool- attrNotIn _ (Sch []) = True- attrNotIn (Attr name u) (Sch (Attr name' _ : t))- = ((name /= name') && (attrNotIn ((Attr name) u)) (Sch t))- disjoint :: Schema -> Schema -> Bool- disjoint (Sch []) _ = True- disjoint (Sch (h : t)) s- = ((attrNotIn h) s && (disjoint (Sch t)) s)- occurs :: [AChar] -> Schema -> Bool- occurs _ (Sch []) = False- occurs name (Sch (Attr name' _ : attrs))- = ((name == name') || (occurs name) (Sch attrs))- lookup :: [AChar] -> Schema -> U- lookup _ (Sch []) = undefined- lookup name (Sch (Attr name' u : attrs))- = if (name == name') then u else (lookup name) (Sch attrs)- type BOOLSym0 = BOOL- type STRINGSym0 = STRING- type NATSym0 = NAT- type VECSym2 (t0123456789876543210 :: U) (t0123456789876543210 :: Nat) =- VEC t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (VECSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) VECSym1KindInference) ())- data VECSym1 (t0123456789876543210 :: U) :: (~>) Nat U- where- VECSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (VECSym1 t0123456789876543210) arg) (VECSym2 t0123456789876543210 arg) =>- VECSym1 t0123456789876543210 t0123456789876543210- type instance Apply (VECSym1 t0123456789876543210) t0123456789876543210 = VEC t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings VECSym0 where- suppressUnusedWarnings = snd (((,) VECSym0KindInference) ())- data VECSym0 :: (~>) U ((~>) Nat U)- where- VECSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) =>- VECSym0 t0123456789876543210- type instance Apply VECSym0 t0123456789876543210 = VECSym1 t0123456789876543210- type CASym0 = CA- type CBSym0 = CB- type CCSym0 = CC- type CDSym0 = CD- type CESym0 = CE- type CFSym0 = CF- type CGSym0 = CG- type CHSym0 = CH- type CISym0 = CI- type CJSym0 = CJ- type CKSym0 = CK- type CLSym0 = CL- type CMSym0 = CM- type CNSym0 = CN- type COSym0 = CO- type CPSym0 = CP- type CQSym0 = CQ- type CRSym0 = CR- type CSSym0 = CS- type CTSym0 = CT- type CUSym0 = CU- type CVSym0 = CV- type CWSym0 = CW- type CXSym0 = CX- type CYSym0 = CY- type CZSym0 = CZ- type AttrSym2 (t0123456789876543210 :: [AChar]) (t0123456789876543210 :: U) =- Attr t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (AttrSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) AttrSym1KindInference) ())- data AttrSym1 (t0123456789876543210 :: [AChar]) :: (~>) U Attribute- where- AttrSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (AttrSym1 t0123456789876543210) arg) (AttrSym2 t0123456789876543210 arg) =>- AttrSym1 t0123456789876543210 t0123456789876543210- type instance Apply (AttrSym1 t0123456789876543210) t0123456789876543210 = Attr t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings AttrSym0 where- suppressUnusedWarnings = snd (((,) AttrSym0KindInference) ())- data AttrSym0 :: (~>) [AChar] ((~>) U Attribute)- where- AttrSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) =>- AttrSym0 t0123456789876543210- type instance Apply AttrSym0 t0123456789876543210 = AttrSym1 t0123456789876543210- type SchSym1 (t0123456789876543210 :: [Attribute]) =- Sch t0123456789876543210- instance SuppressUnusedWarnings SchSym0 where- suppressUnusedWarnings = snd (((,) SchSym0KindInference) ())- data SchSym0 :: (~>) [Attribute] Schema- where- SchSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) =>- SchSym0 t0123456789876543210- type instance Apply SchSym0 t0123456789876543210 = Sch t0123456789876543210- type Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: forall name0123456789876543210- name'0123456789876543210- u0123456789876543210- attrs0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 u0123456789876543210 name'0123456789876543210 name0123456789876543210 attrs0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall name0123456789876543210- name'0123456789876543210- u0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name'0123456789876543210 name0123456789876543210 u0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall name0123456789876543210- name'0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) name'0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall name0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where- Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name'- type family Case_0123456789876543210 name name' u attrs t where- Case_0123456789876543210 name name' u attrs 'True = u- Case_0123456789876543210 name name' u attrs 'False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs)- type LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) =- Lookup a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) LookupSym1KindInference) ())- data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U- where- LookupSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) =>- LookupSym1 a0123456789876543210 a0123456789876543210- type instance Apply (LookupSym1 a0123456789876543210) a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings LookupSym0 where- suppressUnusedWarnings = snd (((,) LookupSym0KindInference) ())- data LookupSym0 :: (~>) [AChar] ((~>) Schema U)- where- LookupSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) =>- LookupSym0 a0123456789876543210- type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210- type OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) =- Occurs a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) OccursSym1KindInference) ())- data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool- where- OccursSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) =>- OccursSym1 a0123456789876543210 a0123456789876543210- type instance Apply (OccursSym1 a0123456789876543210) a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings OccursSym0 where- suppressUnusedWarnings = snd (((,) OccursSym0KindInference) ())- data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)- where- OccursSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) =>- OccursSym0 a0123456789876543210- type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210- type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) =- AttrNotIn a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ())- data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool- where- AttrNotInSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) =>- AttrNotInSym1 a0123456789876543210 a0123456789876543210- type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings AttrNotInSym0 where- suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ())- data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)- where- AttrNotInSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) =>- AttrNotInSym0 a0123456789876543210- type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210- type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) =- Disjoint a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) DisjointSym1KindInference) ())- data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool- where- DisjointSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) =>- DisjointSym1 a0123456789876543210 a0123456789876543210- type instance Apply (DisjointSym1 a0123456789876543210) a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings DisjointSym0 where- suppressUnusedWarnings = snd (((,) DisjointSym0KindInference) ())- data DisjointSym0 :: (~>) Schema ((~>) Schema Bool)- where- DisjointSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) =>- DisjointSym0 a0123456789876543210- type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210- type AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) =- Append a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) AppendSym1KindInference) ())- data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema- where- AppendSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) =>- AppendSym1 a0123456789876543210 a0123456789876543210- type instance Apply (AppendSym1 a0123456789876543210) a0123456789876543210 = Append a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings AppendSym0 where- suppressUnusedWarnings = snd (((,) AppendSym0KindInference) ())- data AppendSym0 :: (~>) Schema ((~>) Schema Schema)- where- AppendSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) =>- AppendSym0 a0123456789876543210- type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210- type family Lookup (a :: [AChar]) (a :: Schema) :: U where- Lookup _ (Sch '[]) = UndefinedSym0- Lookup name (Sch ( '(:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs)- type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where- Occurs _ (Sch '[]) = FalseSym0- Occurs name (Sch ( '(:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs))- type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where- AttrNotIn _ (Sch '[]) = TrueSym0- AttrNotIn (Attr name u) (Sch ( '(:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t))- type family Disjoint (a :: Schema) (a :: Schema) :: Bool where- Disjoint (Sch '[]) _ = TrueSym0- Disjoint (Sch ( '(:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s)- type family Append (a :: Schema) (a :: Schema) :: Schema where- Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2)- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ BOOL a_0123456789876543210 = Apply (Apply ShowStringSym0 "BOOL") a_0123456789876543210- ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210- ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) U ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) U ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow U where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ CA a_0123456789876543210 = Apply (Apply ShowStringSym0 "CA") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CB a_0123456789876543210 = Apply (Apply ShowStringSym0 "CB") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CC a_0123456789876543210 = Apply (Apply ShowStringSym0 "CC") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CD a_0123456789876543210 = Apply (Apply ShowStringSym0 "CD") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CE a_0123456789876543210 = Apply (Apply ShowStringSym0 "CE") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CF a_0123456789876543210 = Apply (Apply ShowStringSym0 "CF") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CG a_0123456789876543210 = Apply (Apply ShowStringSym0 "CG") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CH a_0123456789876543210 = Apply (Apply ShowStringSym0 "CH") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CI a_0123456789876543210 = Apply (Apply ShowStringSym0 "CI") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CJ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CJ") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CK a_0123456789876543210 = Apply (Apply ShowStringSym0 "CK") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CL a_0123456789876543210 = Apply (Apply ShowStringSym0 "CL") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CM a_0123456789876543210 = Apply (Apply ShowStringSym0 "CM") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CN a_0123456789876543210 = Apply (Apply ShowStringSym0 "CN") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CO a_0123456789876543210 = Apply (Apply ShowStringSym0 "CO") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CP a_0123456789876543210 = Apply (Apply ShowStringSym0 "CP") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CQ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CQ") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CR a_0123456789876543210 = Apply (Apply ShowStringSym0 "CR") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CS a_0123456789876543210 = Apply (Apply ShowStringSym0 "CS") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CT a_0123456789876543210 = Apply (Apply ShowStringSym0 "CT") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CU a_0123456789876543210 = Apply (Apply ShowStringSym0 "CU") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CV a_0123456789876543210 = Apply (Apply ShowStringSym0 "CV") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CW a_0123456789876543210 = Apply (Apply ShowStringSym0 "CW") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210- ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) AChar ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow AChar where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where- Equals_0123456789876543210 BOOL BOOL = TrueSym0- Equals_0123456789876543210 STRING STRING = TrueSym0- Equals_0123456789876543210 NAT NAT = TrueSym0- Equals_0123456789876543210 (VEC a a) (VEC b b) = (&&) ((==) a b) ((==) a b)- Equals_0123456789876543210 (_ :: U) (_ :: U) = FalseSym0- instance PEq U where- type (==) a b = Equals_0123456789876543210 a b- type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where- Equals_0123456789876543210 CA CA = TrueSym0- Equals_0123456789876543210 CB CB = TrueSym0- Equals_0123456789876543210 CC CC = TrueSym0- Equals_0123456789876543210 CD CD = TrueSym0- Equals_0123456789876543210 CE CE = TrueSym0- Equals_0123456789876543210 CF CF = TrueSym0- Equals_0123456789876543210 CG CG = TrueSym0- Equals_0123456789876543210 CH CH = TrueSym0- Equals_0123456789876543210 CI CI = TrueSym0- Equals_0123456789876543210 CJ CJ = TrueSym0- Equals_0123456789876543210 CK CK = TrueSym0- Equals_0123456789876543210 CL CL = TrueSym0- Equals_0123456789876543210 CM CM = TrueSym0- Equals_0123456789876543210 CN CN = TrueSym0- Equals_0123456789876543210 CO CO = TrueSym0- Equals_0123456789876543210 CP CP = TrueSym0- Equals_0123456789876543210 CQ CQ = TrueSym0- Equals_0123456789876543210 CR CR = TrueSym0- Equals_0123456789876543210 CS CS = TrueSym0- Equals_0123456789876543210 CT CT = TrueSym0- Equals_0123456789876543210 CU CU = TrueSym0- Equals_0123456789876543210 CV CV = TrueSym0- Equals_0123456789876543210 CW CW = TrueSym0- Equals_0123456789876543210 CX CX = TrueSym0- Equals_0123456789876543210 CY CY = TrueSym0- Equals_0123456789876543210 CZ CZ = TrueSym0- Equals_0123456789876543210 (_ :: AChar) (_ :: AChar) = FalseSym0- instance PEq AChar where- type (==) a b = Equals_0123456789876543210 a b- sLookup ::- forall (t :: [AChar]) (t :: Schema).- Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U)- sOccurs ::- forall (t :: [AChar]) (t :: Schema).- Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool)- sAttrNotIn ::- forall (t :: Attribute) (t :: Schema).- Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool)- sDisjoint ::- forall (t :: Schema) (t :: Schema).- Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool)- sAppend ::- forall (t :: Schema) (t :: Schema).- Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema)- sLookup _ (SSch SNil) = sUndefined- sLookup- (sName :: Sing name)- (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u))- (sAttrs :: Sing attrs)))- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs)- sScrutinee_0123456789876543210- = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName))- sName'- in (case sScrutinee_0123456789876543210 of- STrue -> sU- SFalse- -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName))- ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) ::- Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U)- sOccurs _ (SSch SNil) = SFalse- sOccurs- (sName :: Sing name)- (SSch (SCons (SAttr (sName' :: Sing name') _)- (sAttrs :: Sing attrs)))- = (applySing- ((applySing ((singFun2 @(||@#@$)) (%||)))- ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName))- sName')))- ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName))- ((applySing ((singFun1 @SchSym0) SSch)) sAttrs))- sAttrNotIn _ (SSch SNil) = STrue- sAttrNotIn- (SAttr (sName :: Sing name) (sU :: Sing u))- (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t)))- = (applySing- ((applySing ((singFun2 @(&&@#@$)) (%&&)))- ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName))- sName')))- ((applySing- ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU)))- ((applySing ((singFun1 @SchSym0) SSch)) sT))- sDisjoint (SSch SNil) _ = STrue- sDisjoint- (SSch (SCons (sH :: Sing h) (sT :: Sing t)))- (sS :: Sing s)- = (applySing- ((applySing ((singFun2 @(&&@#@$)) (%&&)))- ((applySing- ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH))- sS)))- ((applySing- ((applySing ((singFun2 @DisjointSym0) sDisjoint))- ((applySing ((singFun1 @SchSym0) SSch)) sT)))- sS)- sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2))- = (applySing ((singFun1 @SchSym0) SSch))- ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2)- instance SingI (LookupSym0 :: (~>) [AChar] ((~>) Schema U)) where- sing = (singFun2 @LookupSym0) sLookup- instance SingI d =>- SingI (LookupSym1 (d :: [AChar]) :: (~>) Schema U) where- sing = (singFun1 @(LookupSym1 (d :: [AChar]))) (sLookup (sing @d))- instance SingI (OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)) where- sing = (singFun2 @OccursSym0) sOccurs- instance SingI d =>- SingI (OccursSym1 (d :: [AChar]) :: (~>) Schema Bool) where- sing = (singFun1 @(OccursSym1 (d :: [AChar]))) (sOccurs (sing @d))- instance SingI (AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)) where- sing = (singFun2 @AttrNotInSym0) sAttrNotIn- instance SingI d =>- SingI (AttrNotInSym1 (d :: Attribute) :: (~>) Schema Bool) where- sing- = (singFun1 @(AttrNotInSym1 (d :: Attribute)))- (sAttrNotIn (sing @d))- instance SingI (DisjointSym0 :: (~>) Schema ((~>) Schema Bool)) where- sing = (singFun2 @DisjointSym0) sDisjoint- instance SingI d =>- SingI (DisjointSym1 (d :: Schema) :: (~>) Schema Bool) where- sing- = (singFun1 @(DisjointSym1 (d :: Schema))) (sDisjoint (sing @d))- instance SingI (AppendSym0 :: (~>) Schema ((~>) Schema Schema)) where- sing = (singFun2 @AppendSym0) sAppend- instance SingI d =>- SingI (AppendSym1 (d :: Schema) :: (~>) Schema Schema) where- sing = (singFun1 @(AppendSym1 (d :: Schema))) (sAppend (sing @d))- data instance Sing :: U -> Type- where- SBOOL :: Sing BOOL- SSTRING :: Sing STRING- SNAT :: Sing NAT- SVEC :: forall (n :: U) (n :: Nat).- (Sing (n :: U)) -> (Sing (n :: Nat)) -> Sing (VEC n n)- type SU = (Sing :: U -> Type)- instance SingKind U where- type Demote U = U- fromSing SBOOL = BOOL- fromSing SSTRING = STRING- fromSing SNAT = NAT- fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b)- toSing BOOL = SomeSing SBOOL- toSing STRING = SomeSing SSTRING- toSing NAT = SomeSing SNAT- toSing (VEC (b :: Demote U) (b :: Demote Nat))- = case- ((,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) }- data instance Sing :: AChar -> Type- where- SCA :: Sing CA- SCB :: Sing CB- SCC :: Sing CC- SCD :: Sing CD- SCE :: Sing CE- SCF :: Sing CF- SCG :: Sing CG- SCH :: Sing CH- SCI :: Sing CI- SCJ :: Sing CJ- SCK :: Sing CK- SCL :: Sing CL- SCM :: Sing CM- SCN :: Sing CN- SCO :: Sing CO- SCP :: Sing CP- SCQ :: Sing CQ- SCR :: Sing CR- SCS :: Sing CS- SCT :: Sing CT- SCU :: Sing CU- SCV :: Sing CV- SCW :: Sing CW- SCX :: Sing CX- SCY :: Sing CY- SCZ :: Sing CZ- type SAChar = (Sing :: AChar -> Type)- instance SingKind AChar where- type Demote AChar = AChar- fromSing SCA = CA- fromSing SCB = CB- fromSing SCC = CC- fromSing SCD = CD- fromSing SCE = CE- fromSing SCF = CF- fromSing SCG = CG- fromSing SCH = CH- fromSing SCI = CI- fromSing SCJ = CJ- fromSing SCK = CK- fromSing SCL = CL- fromSing SCM = CM- fromSing SCN = CN- fromSing SCO = CO- fromSing SCP = CP- fromSing SCQ = CQ- fromSing SCR = CR- fromSing SCS = CS- fromSing SCT = CT- fromSing SCU = CU- fromSing SCV = CV- fromSing SCW = CW- fromSing SCX = CX- fromSing SCY = CY- fromSing SCZ = CZ- toSing CA = SomeSing SCA- toSing CB = SomeSing SCB- toSing CC = SomeSing SCC- toSing CD = SomeSing SCD- toSing CE = SomeSing SCE- toSing CF = SomeSing SCF- toSing CG = SomeSing SCG- toSing CH = SomeSing SCH- toSing CI = SomeSing SCI- toSing CJ = SomeSing SCJ- toSing CK = SomeSing SCK- toSing CL = SomeSing SCL- toSing CM = SomeSing SCM- toSing CN = SomeSing SCN- toSing CO = SomeSing SCO- toSing CP = SomeSing SCP- toSing CQ = SomeSing SCQ- toSing CR = SomeSing SCR- toSing CS = SomeSing SCS- toSing CT = SomeSing SCT- toSing CU = SomeSing SCU- toSing CV = SomeSing SCV- toSing CW = SomeSing SCW- toSing CX = SomeSing SCX- toSing CY = SomeSing SCY- toSing CZ = SomeSing SCZ- data instance Sing :: Attribute -> Type- where- SAttr :: forall (n :: [AChar]) (n :: U).- (Sing (n :: [AChar])) -> (Sing (n :: U)) -> Sing (Attr n n)- type SAttribute = (Sing :: Attribute -> Type)- instance SingKind Attribute where- type Demote Attribute = Attribute- fromSing (SAttr b b) = (Attr (fromSing b)) (fromSing b)- toSing (Attr (b :: Demote [AChar]) (b :: Demote U))- = case- ((,) (toSing b :: SomeSing [AChar])) (toSing b :: SomeSing U)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) }- data instance Sing :: Schema -> Type- where- SSch :: forall (n :: [Attribute]).- (Sing (n :: [Attribute])) -> Sing (Sch n)- type SSchema = (Sing :: Schema -> Type)- instance SingKind Schema where- type Demote Schema = Schema- fromSing (SSch b) = Sch (fromSing b)- toSing (Sch (b :: Demote [Attribute]))- = case toSing b :: SomeSing [Attribute] of {- SomeSing c -> SomeSing (SSch c) }- instance (SShow U, SShow Nat) => SShow U where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: U) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) U ((~>) Symbol Symbol))- -> Type) t1) t2) t3)- sShowsPrec- _- SBOOL- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "BOOL")))- sA_0123456789876543210- sShowsPrec- _- SSTRING- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "STRING")))- sA_0123456789876543210- sShowsPrec- _- SNAT- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "NAT")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SVEC (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "VEC "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- instance SShow AChar where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: AChar) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol))- -> Type) t1) t2) t3)- sShowsPrec- _- SCA- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CA")))- sA_0123456789876543210- sShowsPrec- _- SCB- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CB")))- sA_0123456789876543210- sShowsPrec- _- SCC- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CC")))- sA_0123456789876543210- sShowsPrec- _- SCD- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CD")))- sA_0123456789876543210- sShowsPrec- _- SCE- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CE")))- sA_0123456789876543210- sShowsPrec- _- SCF- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CF")))- sA_0123456789876543210- sShowsPrec- _- SCG- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CG")))- sA_0123456789876543210- sShowsPrec- _- SCH- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CH")))- sA_0123456789876543210- sShowsPrec- _- SCI- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CI")))- sA_0123456789876543210- sShowsPrec- _- SCJ- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CJ")))- sA_0123456789876543210- sShowsPrec- _- SCK- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CK")))- sA_0123456789876543210- sShowsPrec- _- SCL- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CL")))- sA_0123456789876543210- sShowsPrec- _- SCM- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CM")))- sA_0123456789876543210- sShowsPrec- _- SCN- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CN")))- sA_0123456789876543210- sShowsPrec- _- SCO- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CO")))- sA_0123456789876543210- sShowsPrec- _- SCP- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CP")))- sA_0123456789876543210- sShowsPrec- _- SCQ- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CQ")))- sA_0123456789876543210- sShowsPrec- _- SCR- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CR")))- sA_0123456789876543210- sShowsPrec- _- SCS- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CS")))- sA_0123456789876543210- sShowsPrec- _- SCT- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CT")))- sA_0123456789876543210- sShowsPrec- _- SCU- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CU")))- sA_0123456789876543210- sShowsPrec- _- SCV- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CV")))- sA_0123456789876543210- sShowsPrec- _- SCW- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CW")))- sA_0123456789876543210- sShowsPrec- _- SCX- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CX")))- sA_0123456789876543210- sShowsPrec- _- SCY- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CY")))- sA_0123456789876543210- sShowsPrec- _- SCZ- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "CZ")))- sA_0123456789876543210- instance (SEq U, SEq Nat) => SEq U where- (%==) SBOOL SBOOL = STrue- (%==) SBOOL SSTRING = SFalse- (%==) SBOOL SNAT = SFalse- (%==) SBOOL (SVEC _ _) = SFalse- (%==) SSTRING SBOOL = SFalse- (%==) SSTRING SSTRING = STrue- (%==) SSTRING SNAT = SFalse- (%==) SSTRING (SVEC _ _) = SFalse- (%==) SNAT SBOOL = SFalse- (%==) SNAT SSTRING = SFalse- (%==) SNAT SNAT = STrue- (%==) SNAT (SVEC _ _) = SFalse- (%==) (SVEC _ _) SBOOL = SFalse- (%==) (SVEC _ _) SSTRING = SFalse- (%==) (SVEC _ _) SNAT = SFalse- (%==) (SVEC a a) (SVEC b b) = ((%&&) (((%==) a) b)) (((%==) a) b)- instance (SDecide U, SDecide Nat) => SDecide U where- (%~) SBOOL SBOOL = Proved Refl- (%~) SBOOL SSTRING = Disproved (\ x -> case x of)- (%~) SBOOL SNAT = Disproved (\ x -> case x of)- (%~) SBOOL (SVEC _ _) = Disproved (\ x -> case x of)- (%~) SSTRING SBOOL = Disproved (\ x -> case x of)- (%~) SSTRING SSTRING = Proved Refl- (%~) SSTRING SNAT = Disproved (\ x -> case x of)- (%~) SSTRING (SVEC _ _) = Disproved (\ x -> case x of)- (%~) SNAT SBOOL = Disproved (\ x -> case x of)- (%~) SNAT SSTRING = Disproved (\ x -> case x of)- (%~) SNAT SNAT = Proved Refl- (%~) SNAT (SVEC _ _) = Disproved (\ x -> case x of)- (%~) (SVEC _ _) SBOOL = Disproved (\ x -> case x of)- (%~) (SVEC _ _) SSTRING = Disproved (\ x -> case x of)- (%~) (SVEC _ _) SNAT = Disproved (\ x -> case x of)- (%~) (SVEC a a) (SVEC b b)- = case ((,) (((%~) a) b)) (((%~) a) b) of- (,) (Proved Refl) (Proved Refl) -> Proved Refl- (,) (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,) _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SEq AChar where- (%==) SCA SCA = STrue- (%==) SCA SCB = SFalse- (%==) SCA SCC = SFalse- (%==) SCA SCD = SFalse- (%==) SCA SCE = SFalse- (%==) SCA SCF = SFalse- (%==) SCA SCG = SFalse- (%==) SCA SCH = SFalse- (%==) SCA SCI = SFalse- (%==) SCA SCJ = SFalse- (%==) SCA SCK = SFalse- (%==) SCA SCL = SFalse- (%==) SCA SCM = SFalse- (%==) SCA SCN = SFalse- (%==) SCA SCO = SFalse- (%==) SCA SCP = SFalse- (%==) SCA SCQ = SFalse- (%==) SCA SCR = SFalse- (%==) SCA SCS = SFalse- (%==) SCA SCT = SFalse- (%==) SCA SCU = SFalse- (%==) SCA SCV = SFalse- (%==) SCA SCW = SFalse- (%==) SCA SCX = SFalse- (%==) SCA SCY = SFalse- (%==) SCA SCZ = SFalse- (%==) SCB SCA = SFalse- (%==) SCB SCB = STrue- (%==) SCB SCC = SFalse- (%==) SCB SCD = SFalse- (%==) SCB SCE = SFalse- (%==) SCB SCF = SFalse- (%==) SCB SCG = SFalse- (%==) SCB SCH = SFalse- (%==) SCB SCI = SFalse- (%==) SCB SCJ = SFalse- (%==) SCB SCK = SFalse- (%==) SCB SCL = SFalse- (%==) SCB SCM = SFalse- (%==) SCB SCN = SFalse- (%==) SCB SCO = SFalse- (%==) SCB SCP = SFalse- (%==) SCB SCQ = SFalse- (%==) SCB SCR = SFalse- (%==) SCB SCS = SFalse- (%==) SCB SCT = SFalse- (%==) SCB SCU = SFalse- (%==) SCB SCV = SFalse- (%==) SCB SCW = SFalse- (%==) SCB SCX = SFalse- (%==) SCB SCY = SFalse- (%==) SCB SCZ = SFalse- (%==) SCC SCA = SFalse- (%==) SCC SCB = SFalse- (%==) SCC SCC = STrue- (%==) SCC SCD = SFalse- (%==) SCC SCE = SFalse- (%==) SCC SCF = SFalse- (%==) SCC SCG = SFalse- (%==) SCC SCH = SFalse- (%==) SCC SCI = SFalse- (%==) SCC SCJ = SFalse- (%==) SCC SCK = SFalse- (%==) SCC SCL = SFalse- (%==) SCC SCM = SFalse- (%==) SCC SCN = SFalse- (%==) SCC SCO = SFalse- (%==) SCC SCP = SFalse- (%==) SCC SCQ = SFalse- (%==) SCC SCR = SFalse- (%==) SCC SCS = SFalse- (%==) SCC SCT = SFalse- (%==) SCC SCU = SFalse- (%==) SCC SCV = SFalse- (%==) SCC SCW = SFalse- (%==) SCC SCX = SFalse- (%==) SCC SCY = SFalse- (%==) SCC SCZ = SFalse- (%==) SCD SCA = SFalse- (%==) SCD SCB = SFalse- (%==) SCD SCC = SFalse- (%==) SCD SCD = STrue- (%==) SCD SCE = SFalse- (%==) SCD SCF = SFalse- (%==) SCD SCG = SFalse- (%==) SCD SCH = SFalse- (%==) SCD SCI = SFalse- (%==) SCD SCJ = SFalse- (%==) SCD SCK = SFalse- (%==) SCD SCL = SFalse- (%==) SCD SCM = SFalse- (%==) SCD SCN = SFalse- (%==) SCD SCO = SFalse- (%==) SCD SCP = SFalse- (%==) SCD SCQ = SFalse- (%==) SCD SCR = SFalse- (%==) SCD SCS = SFalse- (%==) SCD SCT = SFalse- (%==) SCD SCU = SFalse- (%==) SCD SCV = SFalse- (%==) SCD SCW = SFalse- (%==) SCD SCX = SFalse- (%==) SCD SCY = SFalse- (%==) SCD SCZ = SFalse- (%==) SCE SCA = SFalse- (%==) SCE SCB = SFalse- (%==) SCE SCC = SFalse- (%==) SCE SCD = SFalse- (%==) SCE SCE = STrue- (%==) SCE SCF = SFalse- (%==) SCE SCG = SFalse- (%==) SCE SCH = SFalse- (%==) SCE SCI = SFalse- (%==) SCE SCJ = SFalse- (%==) SCE SCK = SFalse- (%==) SCE SCL = SFalse- (%==) SCE SCM = SFalse- (%==) SCE SCN = SFalse- (%==) SCE SCO = SFalse- (%==) SCE SCP = SFalse- (%==) SCE SCQ = SFalse- (%==) SCE SCR = SFalse- (%==) SCE SCS = SFalse- (%==) SCE SCT = SFalse- (%==) SCE SCU = SFalse- (%==) SCE SCV = SFalse- (%==) SCE SCW = SFalse- (%==) SCE SCX = SFalse- (%==) SCE SCY = SFalse- (%==) SCE SCZ = SFalse- (%==) SCF SCA = SFalse- (%==) SCF SCB = SFalse- (%==) SCF SCC = SFalse- (%==) SCF SCD = SFalse- (%==) SCF SCE = SFalse- (%==) SCF SCF = STrue- (%==) SCF SCG = SFalse- (%==) SCF SCH = SFalse- (%==) SCF SCI = SFalse- (%==) SCF SCJ = SFalse- (%==) SCF SCK = SFalse- (%==) SCF SCL = SFalse- (%==) SCF SCM = SFalse- (%==) SCF SCN = SFalse- (%==) SCF SCO = SFalse- (%==) SCF SCP = SFalse- (%==) SCF SCQ = SFalse- (%==) SCF SCR = SFalse- (%==) SCF SCS = SFalse- (%==) SCF SCT = SFalse- (%==) SCF SCU = SFalse- (%==) SCF SCV = SFalse- (%==) SCF SCW = SFalse- (%==) SCF SCX = SFalse- (%==) SCF SCY = SFalse- (%==) SCF SCZ = SFalse- (%==) SCG SCA = SFalse- (%==) SCG SCB = SFalse- (%==) SCG SCC = SFalse- (%==) SCG SCD = SFalse- (%==) SCG SCE = SFalse- (%==) SCG SCF = SFalse- (%==) SCG SCG = STrue- (%==) SCG SCH = SFalse- (%==) SCG SCI = SFalse- (%==) SCG SCJ = SFalse- (%==) SCG SCK = SFalse- (%==) SCG SCL = SFalse- (%==) SCG SCM = SFalse- (%==) SCG SCN = SFalse- (%==) SCG SCO = SFalse- (%==) SCG SCP = SFalse- (%==) SCG SCQ = SFalse- (%==) SCG SCR = SFalse- (%==) SCG SCS = SFalse- (%==) SCG SCT = SFalse- (%==) SCG SCU = SFalse- (%==) SCG SCV = SFalse- (%==) SCG SCW = SFalse- (%==) SCG SCX = SFalse- (%==) SCG SCY = SFalse- (%==) SCG SCZ = SFalse- (%==) SCH SCA = SFalse- (%==) SCH SCB = SFalse- (%==) SCH SCC = SFalse- (%==) SCH SCD = SFalse- (%==) SCH SCE = SFalse- (%==) SCH SCF = SFalse- (%==) SCH SCG = SFalse- (%==) SCH SCH = STrue- (%==) SCH SCI = SFalse- (%==) SCH SCJ = SFalse- (%==) SCH SCK = SFalse- (%==) SCH SCL = SFalse- (%==) SCH SCM = SFalse- (%==) SCH SCN = SFalse- (%==) SCH SCO = SFalse- (%==) SCH SCP = SFalse- (%==) SCH SCQ = SFalse- (%==) SCH SCR = SFalse- (%==) SCH SCS = SFalse- (%==) SCH SCT = SFalse- (%==) SCH SCU = SFalse- (%==) SCH SCV = SFalse- (%==) SCH SCW = SFalse- (%==) SCH SCX = SFalse- (%==) SCH SCY = SFalse- (%==) SCH SCZ = SFalse- (%==) SCI SCA = SFalse- (%==) SCI SCB = SFalse- (%==) SCI SCC = SFalse- (%==) SCI SCD = SFalse- (%==) SCI SCE = SFalse- (%==) SCI SCF = SFalse- (%==) SCI SCG = SFalse- (%==) SCI SCH = SFalse- (%==) SCI SCI = STrue- (%==) SCI SCJ = SFalse- (%==) SCI SCK = SFalse- (%==) SCI SCL = SFalse- (%==) SCI SCM = SFalse- (%==) SCI SCN = SFalse- (%==) SCI SCO = SFalse- (%==) SCI SCP = SFalse- (%==) SCI SCQ = SFalse- (%==) SCI SCR = SFalse- (%==) SCI SCS = SFalse- (%==) SCI SCT = SFalse- (%==) SCI SCU = SFalse- (%==) SCI SCV = SFalse- (%==) SCI SCW = SFalse- (%==) SCI SCX = SFalse- (%==) SCI SCY = SFalse- (%==) SCI SCZ = SFalse- (%==) SCJ SCA = SFalse- (%==) SCJ SCB = SFalse- (%==) SCJ SCC = SFalse- (%==) SCJ SCD = SFalse- (%==) SCJ SCE = SFalse- (%==) SCJ SCF = SFalse- (%==) SCJ SCG = SFalse- (%==) SCJ SCH = SFalse- (%==) SCJ SCI = SFalse- (%==) SCJ SCJ = STrue- (%==) SCJ SCK = SFalse- (%==) SCJ SCL = SFalse- (%==) SCJ SCM = SFalse- (%==) SCJ SCN = SFalse- (%==) SCJ SCO = SFalse- (%==) SCJ SCP = SFalse- (%==) SCJ SCQ = SFalse- (%==) SCJ SCR = SFalse- (%==) SCJ SCS = SFalse- (%==) SCJ SCT = SFalse- (%==) SCJ SCU = SFalse- (%==) SCJ SCV = SFalse- (%==) SCJ SCW = SFalse- (%==) SCJ SCX = SFalse- (%==) SCJ SCY = SFalse- (%==) SCJ SCZ = SFalse- (%==) SCK SCA = SFalse- (%==) SCK SCB = SFalse- (%==) SCK SCC = SFalse- (%==) SCK SCD = SFalse- (%==) SCK SCE = SFalse- (%==) SCK SCF = SFalse- (%==) SCK SCG = SFalse- (%==) SCK SCH = SFalse- (%==) SCK SCI = SFalse- (%==) SCK SCJ = SFalse- (%==) SCK SCK = STrue- (%==) SCK SCL = SFalse- (%==) SCK SCM = SFalse- (%==) SCK SCN = SFalse- (%==) SCK SCO = SFalse- (%==) SCK SCP = SFalse- (%==) SCK SCQ = SFalse- (%==) SCK SCR = SFalse- (%==) SCK SCS = SFalse- (%==) SCK SCT = SFalse- (%==) SCK SCU = SFalse- (%==) SCK SCV = SFalse- (%==) SCK SCW = SFalse- (%==) SCK SCX = SFalse- (%==) SCK SCY = SFalse- (%==) SCK SCZ = SFalse- (%==) SCL SCA = SFalse- (%==) SCL SCB = SFalse- (%==) SCL SCC = SFalse- (%==) SCL SCD = SFalse- (%==) SCL SCE = SFalse- (%==) SCL SCF = SFalse- (%==) SCL SCG = SFalse- (%==) SCL SCH = SFalse- (%==) SCL SCI = SFalse- (%==) SCL SCJ = SFalse- (%==) SCL SCK = SFalse- (%==) SCL SCL = STrue- (%==) SCL SCM = SFalse- (%==) SCL SCN = SFalse- (%==) SCL SCO = SFalse- (%==) SCL SCP = SFalse- (%==) SCL SCQ = SFalse- (%==) SCL SCR = SFalse- (%==) SCL SCS = SFalse- (%==) SCL SCT = SFalse- (%==) SCL SCU = SFalse- (%==) SCL SCV = SFalse- (%==) SCL SCW = SFalse- (%==) SCL SCX = SFalse- (%==) SCL SCY = SFalse- (%==) SCL SCZ = SFalse- (%==) SCM SCA = SFalse- (%==) SCM SCB = SFalse- (%==) SCM SCC = SFalse- (%==) SCM SCD = SFalse- (%==) SCM SCE = SFalse- (%==) SCM SCF = SFalse- (%==) SCM SCG = SFalse- (%==) SCM SCH = SFalse- (%==) SCM SCI = SFalse- (%==) SCM SCJ = SFalse- (%==) SCM SCK = SFalse- (%==) SCM SCL = SFalse- (%==) SCM SCM = STrue- (%==) SCM SCN = SFalse- (%==) SCM SCO = SFalse- (%==) SCM SCP = SFalse- (%==) SCM SCQ = SFalse- (%==) SCM SCR = SFalse- (%==) SCM SCS = SFalse- (%==) SCM SCT = SFalse- (%==) SCM SCU = SFalse- (%==) SCM SCV = SFalse- (%==) SCM SCW = SFalse- (%==) SCM SCX = SFalse- (%==) SCM SCY = SFalse- (%==) SCM SCZ = SFalse- (%==) SCN SCA = SFalse- (%==) SCN SCB = SFalse- (%==) SCN SCC = SFalse- (%==) SCN SCD = SFalse- (%==) SCN SCE = SFalse- (%==) SCN SCF = SFalse- (%==) SCN SCG = SFalse- (%==) SCN SCH = SFalse- (%==) SCN SCI = SFalse- (%==) SCN SCJ = SFalse- (%==) SCN SCK = SFalse- (%==) SCN SCL = SFalse- (%==) SCN SCM = SFalse- (%==) SCN SCN = STrue- (%==) SCN SCO = SFalse- (%==) SCN SCP = SFalse- (%==) SCN SCQ = SFalse- (%==) SCN SCR = SFalse- (%==) SCN SCS = SFalse- (%==) SCN SCT = SFalse- (%==) SCN SCU = SFalse- (%==) SCN SCV = SFalse- (%==) SCN SCW = SFalse- (%==) SCN SCX = SFalse- (%==) SCN SCY = SFalse- (%==) SCN SCZ = SFalse- (%==) SCO SCA = SFalse- (%==) SCO SCB = SFalse- (%==) SCO SCC = SFalse- (%==) SCO SCD = SFalse- (%==) SCO SCE = SFalse- (%==) SCO SCF = SFalse- (%==) SCO SCG = SFalse- (%==) SCO SCH = SFalse- (%==) SCO SCI = SFalse- (%==) SCO SCJ = SFalse- (%==) SCO SCK = SFalse- (%==) SCO SCL = SFalse- (%==) SCO SCM = SFalse- (%==) SCO SCN = SFalse- (%==) SCO SCO = STrue- (%==) SCO SCP = SFalse- (%==) SCO SCQ = SFalse- (%==) SCO SCR = SFalse- (%==) SCO SCS = SFalse- (%==) SCO SCT = SFalse- (%==) SCO SCU = SFalse- (%==) SCO SCV = SFalse- (%==) SCO SCW = SFalse- (%==) SCO SCX = SFalse- (%==) SCO SCY = SFalse- (%==) SCO SCZ = SFalse- (%==) SCP SCA = SFalse- (%==) SCP SCB = SFalse- (%==) SCP SCC = SFalse- (%==) SCP SCD = SFalse- (%==) SCP SCE = SFalse- (%==) SCP SCF = SFalse- (%==) SCP SCG = SFalse- (%==) SCP SCH = SFalse- (%==) SCP SCI = SFalse- (%==) SCP SCJ = SFalse- (%==) SCP SCK = SFalse- (%==) SCP SCL = SFalse- (%==) SCP SCM = SFalse- (%==) SCP SCN = SFalse- (%==) SCP SCO = SFalse- (%==) SCP SCP = STrue- (%==) SCP SCQ = SFalse- (%==) SCP SCR = SFalse- (%==) SCP SCS = SFalse- (%==) SCP SCT = SFalse- (%==) SCP SCU = SFalse- (%==) SCP SCV = SFalse- (%==) SCP SCW = SFalse- (%==) SCP SCX = SFalse- (%==) SCP SCY = SFalse- (%==) SCP SCZ = SFalse- (%==) SCQ SCA = SFalse- (%==) SCQ SCB = SFalse- (%==) SCQ SCC = SFalse- (%==) SCQ SCD = SFalse- (%==) SCQ SCE = SFalse- (%==) SCQ SCF = SFalse- (%==) SCQ SCG = SFalse- (%==) SCQ SCH = SFalse- (%==) SCQ SCI = SFalse- (%==) SCQ SCJ = SFalse- (%==) SCQ SCK = SFalse- (%==) SCQ SCL = SFalse- (%==) SCQ SCM = SFalse- (%==) SCQ SCN = SFalse- (%==) SCQ SCO = SFalse- (%==) SCQ SCP = SFalse- (%==) SCQ SCQ = STrue- (%==) SCQ SCR = SFalse- (%==) SCQ SCS = SFalse- (%==) SCQ SCT = SFalse- (%==) SCQ SCU = SFalse- (%==) SCQ SCV = SFalse- (%==) SCQ SCW = SFalse- (%==) SCQ SCX = SFalse- (%==) SCQ SCY = SFalse- (%==) SCQ SCZ = SFalse- (%==) SCR SCA = SFalse- (%==) SCR SCB = SFalse- (%==) SCR SCC = SFalse- (%==) SCR SCD = SFalse- (%==) SCR SCE = SFalse- (%==) SCR SCF = SFalse- (%==) SCR SCG = SFalse- (%==) SCR SCH = SFalse- (%==) SCR SCI = SFalse- (%==) SCR SCJ = SFalse- (%==) SCR SCK = SFalse- (%==) SCR SCL = SFalse- (%==) SCR SCM = SFalse- (%==) SCR SCN = SFalse- (%==) SCR SCO = SFalse- (%==) SCR SCP = SFalse- (%==) SCR SCQ = SFalse- (%==) SCR SCR = STrue- (%==) SCR SCS = SFalse- (%==) SCR SCT = SFalse- (%==) SCR SCU = SFalse- (%==) SCR SCV = SFalse- (%==) SCR SCW = SFalse- (%==) SCR SCX = SFalse- (%==) SCR SCY = SFalse- (%==) SCR SCZ = SFalse- (%==) SCS SCA = SFalse- (%==) SCS SCB = SFalse- (%==) SCS SCC = SFalse- (%==) SCS SCD = SFalse- (%==) SCS SCE = SFalse- (%==) SCS SCF = SFalse- (%==) SCS SCG = SFalse- (%==) SCS SCH = SFalse- (%==) SCS SCI = SFalse- (%==) SCS SCJ = SFalse- (%==) SCS SCK = SFalse- (%==) SCS SCL = SFalse- (%==) SCS SCM = SFalse- (%==) SCS SCN = SFalse- (%==) SCS SCO = SFalse- (%==) SCS SCP = SFalse- (%==) SCS SCQ = SFalse- (%==) SCS SCR = SFalse- (%==) SCS SCS = STrue- (%==) SCS SCT = SFalse- (%==) SCS SCU = SFalse- (%==) SCS SCV = SFalse- (%==) SCS SCW = SFalse- (%==) SCS SCX = SFalse- (%==) SCS SCY = SFalse- (%==) SCS SCZ = SFalse- (%==) SCT SCA = SFalse- (%==) SCT SCB = SFalse- (%==) SCT SCC = SFalse- (%==) SCT SCD = SFalse- (%==) SCT SCE = SFalse- (%==) SCT SCF = SFalse- (%==) SCT SCG = SFalse- (%==) SCT SCH = SFalse- (%==) SCT SCI = SFalse- (%==) SCT SCJ = SFalse- (%==) SCT SCK = SFalse- (%==) SCT SCL = SFalse- (%==) SCT SCM = SFalse- (%==) SCT SCN = SFalse- (%==) SCT SCO = SFalse- (%==) SCT SCP = SFalse- (%==) SCT SCQ = SFalse- (%==) SCT SCR = SFalse- (%==) SCT SCS = SFalse- (%==) SCT SCT = STrue- (%==) SCT SCU = SFalse- (%==) SCT SCV = SFalse- (%==) SCT SCW = SFalse- (%==) SCT SCX = SFalse- (%==) SCT SCY = SFalse- (%==) SCT SCZ = SFalse- (%==) SCU SCA = SFalse- (%==) SCU SCB = SFalse- (%==) SCU SCC = SFalse- (%==) SCU SCD = SFalse- (%==) SCU SCE = SFalse- (%==) SCU SCF = SFalse- (%==) SCU SCG = SFalse- (%==) SCU SCH = SFalse- (%==) SCU SCI = SFalse- (%==) SCU SCJ = SFalse- (%==) SCU SCK = SFalse- (%==) SCU SCL = SFalse- (%==) SCU SCM = SFalse- (%==) SCU SCN = SFalse- (%==) SCU SCO = SFalse- (%==) SCU SCP = SFalse- (%==) SCU SCQ = SFalse- (%==) SCU SCR = SFalse- (%==) SCU SCS = SFalse- (%==) SCU SCT = SFalse- (%==) SCU SCU = STrue- (%==) SCU SCV = SFalse- (%==) SCU SCW = SFalse- (%==) SCU SCX = SFalse- (%==) SCU SCY = SFalse- (%==) SCU SCZ = SFalse- (%==) SCV SCA = SFalse- (%==) SCV SCB = SFalse- (%==) SCV SCC = SFalse- (%==) SCV SCD = SFalse- (%==) SCV SCE = SFalse- (%==) SCV SCF = SFalse- (%==) SCV SCG = SFalse- (%==) SCV SCH = SFalse- (%==) SCV SCI = SFalse- (%==) SCV SCJ = SFalse- (%==) SCV SCK = SFalse- (%==) SCV SCL = SFalse- (%==) SCV SCM = SFalse- (%==) SCV SCN = SFalse- (%==) SCV SCO = SFalse- (%==) SCV SCP = SFalse- (%==) SCV SCQ = SFalse- (%==) SCV SCR = SFalse- (%==) SCV SCS = SFalse- (%==) SCV SCT = SFalse- (%==) SCV SCU = SFalse- (%==) SCV SCV = STrue- (%==) SCV SCW = SFalse- (%==) SCV SCX = SFalse- (%==) SCV SCY = SFalse- (%==) SCV SCZ = SFalse- (%==) SCW SCA = SFalse- (%==) SCW SCB = SFalse- (%==) SCW SCC = SFalse- (%==) SCW SCD = SFalse- (%==) SCW SCE = SFalse- (%==) SCW SCF = SFalse- (%==) SCW SCG = SFalse- (%==) SCW SCH = SFalse- (%==) SCW SCI = SFalse- (%==) SCW SCJ = SFalse- (%==) SCW SCK = SFalse- (%==) SCW SCL = SFalse- (%==) SCW SCM = SFalse- (%==) SCW SCN = SFalse- (%==) SCW SCO = SFalse- (%==) SCW SCP = SFalse- (%==) SCW SCQ = SFalse- (%==) SCW SCR = SFalse- (%==) SCW SCS = SFalse- (%==) SCW SCT = SFalse- (%==) SCW SCU = SFalse- (%==) SCW SCV = SFalse- (%==) SCW SCW = STrue- (%==) SCW SCX = SFalse- (%==) SCW SCY = SFalse- (%==) SCW SCZ = SFalse- (%==) SCX SCA = SFalse- (%==) SCX SCB = SFalse- (%==) SCX SCC = SFalse- (%==) SCX SCD = SFalse- (%==) SCX SCE = SFalse- (%==) SCX SCF = SFalse- (%==) SCX SCG = SFalse- (%==) SCX SCH = SFalse- (%==) SCX SCI = SFalse- (%==) SCX SCJ = SFalse- (%==) SCX SCK = SFalse- (%==) SCX SCL = SFalse- (%==) SCX SCM = SFalse- (%==) SCX SCN = SFalse- (%==) SCX SCO = SFalse- (%==) SCX SCP = SFalse- (%==) SCX SCQ = SFalse- (%==) SCX SCR = SFalse- (%==) SCX SCS = SFalse- (%==) SCX SCT = SFalse- (%==) SCX SCU = SFalse- (%==) SCX SCV = SFalse- (%==) SCX SCW = SFalse- (%==) SCX SCX = STrue- (%==) SCX SCY = SFalse- (%==) SCX SCZ = SFalse- (%==) SCY SCA = SFalse- (%==) SCY SCB = SFalse- (%==) SCY SCC = SFalse- (%==) SCY SCD = SFalse- (%==) SCY SCE = SFalse- (%==) SCY SCF = SFalse- (%==) SCY SCG = SFalse- (%==) SCY SCH = SFalse- (%==) SCY SCI = SFalse- (%==) SCY SCJ = SFalse- (%==) SCY SCK = SFalse- (%==) SCY SCL = SFalse- (%==) SCY SCM = SFalse- (%==) SCY SCN = SFalse- (%==) SCY SCO = SFalse- (%==) SCY SCP = SFalse- (%==) SCY SCQ = SFalse- (%==) SCY SCR = SFalse- (%==) SCY SCS = SFalse- (%==) SCY SCT = SFalse- (%==) SCY SCU = SFalse- (%==) SCY SCV = SFalse- (%==) SCY SCW = SFalse- (%==) SCY SCX = SFalse- (%==) SCY SCY = STrue- (%==) SCY SCZ = SFalse- (%==) SCZ SCA = SFalse- (%==) SCZ SCB = SFalse- (%==) SCZ SCC = SFalse- (%==) SCZ SCD = SFalse- (%==) SCZ SCE = SFalse- (%==) SCZ SCF = SFalse- (%==) SCZ SCG = SFalse- (%==) SCZ SCH = SFalse- (%==) SCZ SCI = SFalse- (%==) SCZ SCJ = SFalse- (%==) SCZ SCK = SFalse- (%==) SCZ SCL = SFalse- (%==) SCZ SCM = SFalse- (%==) SCZ SCN = SFalse- (%==) SCZ SCO = SFalse- (%==) SCZ SCP = SFalse- (%==) SCZ SCQ = SFalse- (%==) SCZ SCR = SFalse- (%==) SCZ SCS = SFalse- (%==) SCZ SCT = SFalse- (%==) SCZ SCU = SFalse- (%==) SCZ SCV = SFalse- (%==) SCZ SCW = SFalse- (%==) SCZ SCX = SFalse- (%==) SCZ SCY = SFalse- (%==) SCZ SCZ = STrue- instance SDecide AChar where- (%~) SCA SCA = Proved Refl- (%~) SCA SCB = Disproved (\ x -> case x of)- (%~) SCA SCC = Disproved (\ x -> case x of)- (%~) SCA SCD = Disproved (\ x -> case x of)- (%~) SCA SCE = Disproved (\ x -> case x of)- (%~) SCA SCF = Disproved (\ x -> case x of)- (%~) SCA SCG = Disproved (\ x -> case x of)- (%~) SCA SCH = Disproved (\ x -> case x of)- (%~) SCA SCI = Disproved (\ x -> case x of)- (%~) SCA SCJ = Disproved (\ x -> case x of)- (%~) SCA SCK = Disproved (\ x -> case x of)- (%~) SCA SCL = Disproved (\ x -> case x of)- (%~) SCA SCM = Disproved (\ x -> case x of)- (%~) SCA SCN = Disproved (\ x -> case x of)- (%~) SCA SCO = Disproved (\ x -> case x of)- (%~) SCA SCP = Disproved (\ x -> case x of)- (%~) SCA SCQ = Disproved (\ x -> case x of)- (%~) SCA SCR = Disproved (\ x -> case x of)- (%~) SCA SCS = Disproved (\ x -> case x of)- (%~) SCA SCT = Disproved (\ x -> case x of)- (%~) SCA SCU = Disproved (\ x -> case x of)- (%~) SCA SCV = Disproved (\ x -> case x of)- (%~) SCA SCW = Disproved (\ x -> case x of)- (%~) SCA SCX = Disproved (\ x -> case x of)- (%~) SCA SCY = Disproved (\ x -> case x of)- (%~) SCA SCZ = Disproved (\ x -> case x of)- (%~) SCB SCA = Disproved (\ x -> case x of)- (%~) SCB SCB = Proved Refl- (%~) SCB SCC = Disproved (\ x -> case x of)- (%~) SCB SCD = Disproved (\ x -> case x of)- (%~) SCB SCE = Disproved (\ x -> case x of)- (%~) SCB SCF = Disproved (\ x -> case x of)- (%~) SCB SCG = Disproved (\ x -> case x of)- (%~) SCB SCH = Disproved (\ x -> case x of)- (%~) SCB SCI = Disproved (\ x -> case x of)- (%~) SCB SCJ = Disproved (\ x -> case x of)- (%~) SCB SCK = Disproved (\ x -> case x of)- (%~) SCB SCL = Disproved (\ x -> case x of)- (%~) SCB SCM = Disproved (\ x -> case x of)- (%~) SCB SCN = Disproved (\ x -> case x of)- (%~) SCB SCO = Disproved (\ x -> case x of)- (%~) SCB SCP = Disproved (\ x -> case x of)- (%~) SCB SCQ = Disproved (\ x -> case x of)- (%~) SCB SCR = Disproved (\ x -> case x of)- (%~) SCB SCS = Disproved (\ x -> case x of)- (%~) SCB SCT = Disproved (\ x -> case x of)- (%~) SCB SCU = Disproved (\ x -> case x of)- (%~) SCB SCV = Disproved (\ x -> case x of)- (%~) SCB SCW = Disproved (\ x -> case x of)- (%~) SCB SCX = Disproved (\ x -> case x of)- (%~) SCB SCY = Disproved (\ x -> case x of)- (%~) SCB SCZ = Disproved (\ x -> case x of)- (%~) SCC SCA = Disproved (\ x -> case x of)- (%~) SCC SCB = Disproved (\ x -> case x of)- (%~) SCC SCC = Proved Refl- (%~) SCC SCD = Disproved (\ x -> case x of)- (%~) SCC SCE = Disproved (\ x -> case x of)- (%~) SCC SCF = Disproved (\ x -> case x of)- (%~) SCC SCG = Disproved (\ x -> case x of)- (%~) SCC SCH = Disproved (\ x -> case x of)- (%~) SCC SCI = Disproved (\ x -> case x of)- (%~) SCC SCJ = Disproved (\ x -> case x of)- (%~) SCC SCK = Disproved (\ x -> case x of)- (%~) SCC SCL = Disproved (\ x -> case x of)- (%~) SCC SCM = Disproved (\ x -> case x of)- (%~) SCC SCN = Disproved (\ x -> case x of)- (%~) SCC SCO = Disproved (\ x -> case x of)- (%~) SCC SCP = Disproved (\ x -> case x of)- (%~) SCC SCQ = Disproved (\ x -> case x of)- (%~) SCC SCR = Disproved (\ x -> case x of)- (%~) SCC SCS = Disproved (\ x -> case x of)- (%~) SCC SCT = Disproved (\ x -> case x of)- (%~) SCC SCU = Disproved (\ x -> case x of)- (%~) SCC SCV = Disproved (\ x -> case x of)- (%~) SCC SCW = Disproved (\ x -> case x of)- (%~) SCC SCX = Disproved (\ x -> case x of)- (%~) SCC SCY = Disproved (\ x -> case x of)- (%~) SCC SCZ = Disproved (\ x -> case x of)- (%~) SCD SCA = Disproved (\ x -> case x of)- (%~) SCD SCB = Disproved (\ x -> case x of)- (%~) SCD SCC = Disproved (\ x -> case x of)- (%~) SCD SCD = Proved Refl- (%~) SCD SCE = Disproved (\ x -> case x of)- (%~) SCD SCF = Disproved (\ x -> case x of)- (%~) SCD SCG = Disproved (\ x -> case x of)- (%~) SCD SCH = Disproved (\ x -> case x of)- (%~) SCD SCI = Disproved (\ x -> case x of)- (%~) SCD SCJ = Disproved (\ x -> case x of)- (%~) SCD SCK = Disproved (\ x -> case x of)- (%~) SCD SCL = Disproved (\ x -> case x of)- (%~) SCD SCM = Disproved (\ x -> case x of)- (%~) SCD SCN = Disproved (\ x -> case x of)- (%~) SCD SCO = Disproved (\ x -> case x of)- (%~) SCD SCP = Disproved (\ x -> case x of)- (%~) SCD SCQ = Disproved (\ x -> case x of)- (%~) SCD SCR = Disproved (\ x -> case x of)- (%~) SCD SCS = Disproved (\ x -> case x of)- (%~) SCD SCT = Disproved (\ x -> case x of)- (%~) SCD SCU = Disproved (\ x -> case x of)- (%~) SCD SCV = Disproved (\ x -> case x of)- (%~) SCD SCW = Disproved (\ x -> case x of)- (%~) SCD SCX = Disproved (\ x -> case x of)- (%~) SCD SCY = Disproved (\ x -> case x of)- (%~) SCD SCZ = Disproved (\ x -> case x of)- (%~) SCE SCA = Disproved (\ x -> case x of)- (%~) SCE SCB = Disproved (\ x -> case x of)- (%~) SCE SCC = Disproved (\ x -> case x of)- (%~) SCE SCD = Disproved (\ x -> case x of)- (%~) SCE SCE = Proved Refl- (%~) SCE SCF = Disproved (\ x -> case x of)- (%~) SCE SCG = Disproved (\ x -> case x of)- (%~) SCE SCH = Disproved (\ x -> case x of)- (%~) SCE SCI = Disproved (\ x -> case x of)- (%~) SCE SCJ = Disproved (\ x -> case x of)- (%~) SCE SCK = Disproved (\ x -> case x of)- (%~) SCE SCL = Disproved (\ x -> case x of)- (%~) SCE SCM = Disproved (\ x -> case x of)- (%~) SCE SCN = Disproved (\ x -> case x of)- (%~) SCE SCO = Disproved (\ x -> case x of)- (%~) SCE SCP = Disproved (\ x -> case x of)- (%~) SCE SCQ = Disproved (\ x -> case x of)- (%~) SCE SCR = Disproved (\ x -> case x of)- (%~) SCE SCS = Disproved (\ x -> case x of)- (%~) SCE SCT = Disproved (\ x -> case x of)- (%~) SCE SCU = Disproved (\ x -> case x of)- (%~) SCE SCV = Disproved (\ x -> case x of)- (%~) SCE SCW = Disproved (\ x -> case x of)- (%~) SCE SCX = Disproved (\ x -> case x of)- (%~) SCE SCY = Disproved (\ x -> case x of)- (%~) SCE SCZ = Disproved (\ x -> case x of)- (%~) SCF SCA = Disproved (\ x -> case x of)- (%~) SCF SCB = Disproved (\ x -> case x of)- (%~) SCF SCC = Disproved (\ x -> case x of)- (%~) SCF SCD = Disproved (\ x -> case x of)- (%~) SCF SCE = Disproved (\ x -> case x of)- (%~) SCF SCF = Proved Refl- (%~) SCF SCG = Disproved (\ x -> case x of)- (%~) SCF SCH = Disproved (\ x -> case x of)- (%~) SCF SCI = Disproved (\ x -> case x of)- (%~) SCF SCJ = Disproved (\ x -> case x of)- (%~) SCF SCK = Disproved (\ x -> case x of)- (%~) SCF SCL = Disproved (\ x -> case x of)- (%~) SCF SCM = Disproved (\ x -> case x of)- (%~) SCF SCN = Disproved (\ x -> case x of)- (%~) SCF SCO = Disproved (\ x -> case x of)- (%~) SCF SCP = Disproved (\ x -> case x of)- (%~) SCF SCQ = Disproved (\ x -> case x of)- (%~) SCF SCR = Disproved (\ x -> case x of)- (%~) SCF SCS = Disproved (\ x -> case x of)- (%~) SCF SCT = Disproved (\ x -> case x of)- (%~) SCF SCU = Disproved (\ x -> case x of)- (%~) SCF SCV = Disproved (\ x -> case x of)- (%~) SCF SCW = Disproved (\ x -> case x of)- (%~) SCF SCX = Disproved (\ x -> case x of)- (%~) SCF SCY = Disproved (\ x -> case x of)- (%~) SCF SCZ = Disproved (\ x -> case x of)- (%~) SCG SCA = Disproved (\ x -> case x of)- (%~) SCG SCB = Disproved (\ x -> case x of)- (%~) SCG SCC = Disproved (\ x -> case x of)- (%~) SCG SCD = Disproved (\ x -> case x of)- (%~) SCG SCE = Disproved (\ x -> case x of)- (%~) SCG SCF = Disproved (\ x -> case x of)- (%~) SCG SCG = Proved Refl- (%~) SCG SCH = Disproved (\ x -> case x of)- (%~) SCG SCI = Disproved (\ x -> case x of)- (%~) SCG SCJ = Disproved (\ x -> case x of)- (%~) SCG SCK = Disproved (\ x -> case x of)- (%~) SCG SCL = Disproved (\ x -> case x of)- (%~) SCG SCM = Disproved (\ x -> case x of)- (%~) SCG SCN = Disproved (\ x -> case x of)- (%~) SCG SCO = Disproved (\ x -> case x of)- (%~) SCG SCP = Disproved (\ x -> case x of)- (%~) SCG SCQ = Disproved (\ x -> case x of)- (%~) SCG SCR = Disproved (\ x -> case x of)- (%~) SCG SCS = Disproved (\ x -> case x of)- (%~) SCG SCT = Disproved (\ x -> case x of)- (%~) SCG SCU = Disproved (\ x -> case x of)- (%~) SCG SCV = Disproved (\ x -> case x of)- (%~) SCG SCW = Disproved (\ x -> case x of)- (%~) SCG SCX = Disproved (\ x -> case x of)- (%~) SCG SCY = Disproved (\ x -> case x of)- (%~) SCG SCZ = Disproved (\ x -> case x of)- (%~) SCH SCA = Disproved (\ x -> case x of)- (%~) SCH SCB = Disproved (\ x -> case x of)- (%~) SCH SCC = Disproved (\ x -> case x of)- (%~) SCH SCD = Disproved (\ x -> case x of)- (%~) SCH SCE = Disproved (\ x -> case x of)- (%~) SCH SCF = Disproved (\ x -> case x of)- (%~) SCH SCG = Disproved (\ x -> case x of)- (%~) SCH SCH = Proved Refl- (%~) SCH SCI = Disproved (\ x -> case x of)- (%~) SCH SCJ = Disproved (\ x -> case x of)- (%~) SCH SCK = Disproved (\ x -> case x of)- (%~) SCH SCL = Disproved (\ x -> case x of)- (%~) SCH SCM = Disproved (\ x -> case x of)- (%~) SCH SCN = Disproved (\ x -> case x of)- (%~) SCH SCO = Disproved (\ x -> case x of)- (%~) SCH SCP = Disproved (\ x -> case x of)- (%~) SCH SCQ = Disproved (\ x -> case x of)- (%~) SCH SCR = Disproved (\ x -> case x of)- (%~) SCH SCS = Disproved (\ x -> case x of)- (%~) SCH SCT = Disproved (\ x -> case x of)- (%~) SCH SCU = Disproved (\ x -> case x of)- (%~) SCH SCV = Disproved (\ x -> case x of)- (%~) SCH SCW = Disproved (\ x -> case x of)- (%~) SCH SCX = Disproved (\ x -> case x of)- (%~) SCH SCY = Disproved (\ x -> case x of)- (%~) SCH SCZ = Disproved (\ x -> case x of)- (%~) SCI SCA = Disproved (\ x -> case x of)- (%~) SCI SCB = Disproved (\ x -> case x of)- (%~) SCI SCC = Disproved (\ x -> case x of)- (%~) SCI SCD = Disproved (\ x -> case x of)- (%~) SCI SCE = Disproved (\ x -> case x of)- (%~) SCI SCF = Disproved (\ x -> case x of)- (%~) SCI SCG = Disproved (\ x -> case x of)- (%~) SCI SCH = Disproved (\ x -> case x of)- (%~) SCI SCI = Proved Refl- (%~) SCI SCJ = Disproved (\ x -> case x of)- (%~) SCI SCK = Disproved (\ x -> case x of)- (%~) SCI SCL = Disproved (\ x -> case x of)- (%~) SCI SCM = Disproved (\ x -> case x of)- (%~) SCI SCN = Disproved (\ x -> case x of)- (%~) SCI SCO = Disproved (\ x -> case x of)- (%~) SCI SCP = Disproved (\ x -> case x of)- (%~) SCI SCQ = Disproved (\ x -> case x of)- (%~) SCI SCR = Disproved (\ x -> case x of)- (%~) SCI SCS = Disproved (\ x -> case x of)- (%~) SCI SCT = Disproved (\ x -> case x of)- (%~) SCI SCU = Disproved (\ x -> case x of)- (%~) SCI SCV = Disproved (\ x -> case x of)- (%~) SCI SCW = Disproved (\ x -> case x of)- (%~) SCI SCX = Disproved (\ x -> case x of)- (%~) SCI SCY = Disproved (\ x -> case x of)- (%~) SCI SCZ = Disproved (\ x -> case x of)- (%~) SCJ SCA = Disproved (\ x -> case x of)- (%~) SCJ SCB = Disproved (\ x -> case x of)- (%~) SCJ SCC = Disproved (\ x -> case x of)- (%~) SCJ SCD = Disproved (\ x -> case x of)- (%~) SCJ SCE = Disproved (\ x -> case x of)- (%~) SCJ SCF = Disproved (\ x -> case x of)- (%~) SCJ SCG = Disproved (\ x -> case x of)- (%~) SCJ SCH = Disproved (\ x -> case x of)- (%~) SCJ SCI = Disproved (\ x -> case x of)- (%~) SCJ SCJ = Proved Refl- (%~) SCJ SCK = Disproved (\ x -> case x of)- (%~) SCJ SCL = Disproved (\ x -> case x of)- (%~) SCJ SCM = Disproved (\ x -> case x of)- (%~) SCJ SCN = Disproved (\ x -> case x of)- (%~) SCJ SCO = Disproved (\ x -> case x of)- (%~) SCJ SCP = Disproved (\ x -> case x of)- (%~) SCJ SCQ = Disproved (\ x -> case x of)- (%~) SCJ SCR = Disproved (\ x -> case x of)- (%~) SCJ SCS = Disproved (\ x -> case x of)- (%~) SCJ SCT = Disproved (\ x -> case x of)- (%~) SCJ SCU = Disproved (\ x -> case x of)- (%~) SCJ SCV = Disproved (\ x -> case x of)- (%~) SCJ SCW = Disproved (\ x -> case x of)- (%~) SCJ SCX = Disproved (\ x -> case x of)- (%~) SCJ SCY = Disproved (\ x -> case x of)- (%~) SCJ SCZ = Disproved (\ x -> case x of)- (%~) SCK SCA = Disproved (\ x -> case x of)- (%~) SCK SCB = Disproved (\ x -> case x of)- (%~) SCK SCC = Disproved (\ x -> case x of)- (%~) SCK SCD = Disproved (\ x -> case x of)- (%~) SCK SCE = Disproved (\ x -> case x of)- (%~) SCK SCF = Disproved (\ x -> case x of)- (%~) SCK SCG = Disproved (\ x -> case x of)- (%~) SCK SCH = Disproved (\ x -> case x of)- (%~) SCK SCI = Disproved (\ x -> case x of)- (%~) SCK SCJ = Disproved (\ x -> case x of)- (%~) SCK SCK = Proved Refl- (%~) SCK SCL = Disproved (\ x -> case x of)- (%~) SCK SCM = Disproved (\ x -> case x of)- (%~) SCK SCN = Disproved (\ x -> case x of)- (%~) SCK SCO = Disproved (\ x -> case x of)- (%~) SCK SCP = Disproved (\ x -> case x of)- (%~) SCK SCQ = Disproved (\ x -> case x of)- (%~) SCK SCR = Disproved (\ x -> case x of)- (%~) SCK SCS = Disproved (\ x -> case x of)- (%~) SCK SCT = Disproved (\ x -> case x of)- (%~) SCK SCU = Disproved (\ x -> case x of)- (%~) SCK SCV = Disproved (\ x -> case x of)- (%~) SCK SCW = Disproved (\ x -> case x of)- (%~) SCK SCX = Disproved (\ x -> case x of)- (%~) SCK SCY = Disproved (\ x -> case x of)- (%~) SCK SCZ = Disproved (\ x -> case x of)- (%~) SCL SCA = Disproved (\ x -> case x of)- (%~) SCL SCB = Disproved (\ x -> case x of)- (%~) SCL SCC = Disproved (\ x -> case x of)- (%~) SCL SCD = Disproved (\ x -> case x of)- (%~) SCL SCE = Disproved (\ x -> case x of)- (%~) SCL SCF = Disproved (\ x -> case x of)- (%~) SCL SCG = Disproved (\ x -> case x of)- (%~) SCL SCH = Disproved (\ x -> case x of)- (%~) SCL SCI = Disproved (\ x -> case x of)- (%~) SCL SCJ = Disproved (\ x -> case x of)- (%~) SCL SCK = Disproved (\ x -> case x of)- (%~) SCL SCL = Proved Refl- (%~) SCL SCM = Disproved (\ x -> case x of)- (%~) SCL SCN = Disproved (\ x -> case x of)- (%~) SCL SCO = Disproved (\ x -> case x of)- (%~) SCL SCP = Disproved (\ x -> case x of)- (%~) SCL SCQ = Disproved (\ x -> case x of)- (%~) SCL SCR = Disproved (\ x -> case x of)- (%~) SCL SCS = Disproved (\ x -> case x of)- (%~) SCL SCT = Disproved (\ x -> case x of)- (%~) SCL SCU = Disproved (\ x -> case x of)- (%~) SCL SCV = Disproved (\ x -> case x of)- (%~) SCL SCW = Disproved (\ x -> case x of)- (%~) SCL SCX = Disproved (\ x -> case x of)- (%~) SCL SCY = Disproved (\ x -> case x of)- (%~) SCL SCZ = Disproved (\ x -> case x of)- (%~) SCM SCA = Disproved (\ x -> case x of)- (%~) SCM SCB = Disproved (\ x -> case x of)- (%~) SCM SCC = Disproved (\ x -> case x of)- (%~) SCM SCD = Disproved (\ x -> case x of)- (%~) SCM SCE = Disproved (\ x -> case x of)- (%~) SCM SCF = Disproved (\ x -> case x of)- (%~) SCM SCG = Disproved (\ x -> case x of)- (%~) SCM SCH = Disproved (\ x -> case x of)- (%~) SCM SCI = Disproved (\ x -> case x of)- (%~) SCM SCJ = Disproved (\ x -> case x of)- (%~) SCM SCK = Disproved (\ x -> case x of)- (%~) SCM SCL = Disproved (\ x -> case x of)- (%~) SCM SCM = Proved Refl- (%~) SCM SCN = Disproved (\ x -> case x of)- (%~) SCM SCO = Disproved (\ x -> case x of)- (%~) SCM SCP = Disproved (\ x -> case x of)- (%~) SCM SCQ = Disproved (\ x -> case x of)- (%~) SCM SCR = Disproved (\ x -> case x of)- (%~) SCM SCS = Disproved (\ x -> case x of)- (%~) SCM SCT = Disproved (\ x -> case x of)- (%~) SCM SCU = Disproved (\ x -> case x of)- (%~) SCM SCV = Disproved (\ x -> case x of)- (%~) SCM SCW = Disproved (\ x -> case x of)- (%~) SCM SCX = Disproved (\ x -> case x of)- (%~) SCM SCY = Disproved (\ x -> case x of)- (%~) SCM SCZ = Disproved (\ x -> case x of)- (%~) SCN SCA = Disproved (\ x -> case x of)- (%~) SCN SCB = Disproved (\ x -> case x of)- (%~) SCN SCC = Disproved (\ x -> case x of)- (%~) SCN SCD = Disproved (\ x -> case x of)- (%~) SCN SCE = Disproved (\ x -> case x of)- (%~) SCN SCF = Disproved (\ x -> case x of)- (%~) SCN SCG = Disproved (\ x -> case x of)- (%~) SCN SCH = Disproved (\ x -> case x of)- (%~) SCN SCI = Disproved (\ x -> case x of)- (%~) SCN SCJ = Disproved (\ x -> case x of)- (%~) SCN SCK = Disproved (\ x -> case x of)- (%~) SCN SCL = Disproved (\ x -> case x of)- (%~) SCN SCM = Disproved (\ x -> case x of)- (%~) SCN SCN = Proved Refl- (%~) SCN SCO = Disproved (\ x -> case x of)- (%~) SCN SCP = Disproved (\ x -> case x of)- (%~) SCN SCQ = Disproved (\ x -> case x of)- (%~) SCN SCR = Disproved (\ x -> case x of)- (%~) SCN SCS = Disproved (\ x -> case x of)- (%~) SCN SCT = Disproved (\ x -> case x of)- (%~) SCN SCU = Disproved (\ x -> case x of)- (%~) SCN SCV = Disproved (\ x -> case x of)- (%~) SCN SCW = Disproved (\ x -> case x of)- (%~) SCN SCX = Disproved (\ x -> case x of)- (%~) SCN SCY = Disproved (\ x -> case x of)- (%~) SCN SCZ = Disproved (\ x -> case x of)- (%~) SCO SCA = Disproved (\ x -> case x of)- (%~) SCO SCB = Disproved (\ x -> case x of)- (%~) SCO SCC = Disproved (\ x -> case x of)- (%~) SCO SCD = Disproved (\ x -> case x of)- (%~) SCO SCE = Disproved (\ x -> case x of)- (%~) SCO SCF = Disproved (\ x -> case x of)- (%~) SCO SCG = Disproved (\ x -> case x of)- (%~) SCO SCH = Disproved (\ x -> case x of)- (%~) SCO SCI = Disproved (\ x -> case x of)- (%~) SCO SCJ = Disproved (\ x -> case x of)- (%~) SCO SCK = Disproved (\ x -> case x of)- (%~) SCO SCL = Disproved (\ x -> case x of)- (%~) SCO SCM = Disproved (\ x -> case x of)- (%~) SCO SCN = Disproved (\ x -> case x of)- (%~) SCO SCO = Proved Refl- (%~) SCO SCP = Disproved (\ x -> case x of)- (%~) SCO SCQ = Disproved (\ x -> case x of)- (%~) SCO SCR = Disproved (\ x -> case x of)- (%~) SCO SCS = Disproved (\ x -> case x of)- (%~) SCO SCT = Disproved (\ x -> case x of)- (%~) SCO SCU = Disproved (\ x -> case x of)- (%~) SCO SCV = Disproved (\ x -> case x of)- (%~) SCO SCW = Disproved (\ x -> case x of)- (%~) SCO SCX = Disproved (\ x -> case x of)- (%~) SCO SCY = Disproved (\ x -> case x of)- (%~) SCO SCZ = Disproved (\ x -> case x of)- (%~) SCP SCA = Disproved (\ x -> case x of)- (%~) SCP SCB = Disproved (\ x -> case x of)- (%~) SCP SCC = Disproved (\ x -> case x of)- (%~) SCP SCD = Disproved (\ x -> case x of)- (%~) SCP SCE = Disproved (\ x -> case x of)- (%~) SCP SCF = Disproved (\ x -> case x of)- (%~) SCP SCG = Disproved (\ x -> case x of)- (%~) SCP SCH = Disproved (\ x -> case x of)- (%~) SCP SCI = Disproved (\ x -> case x of)- (%~) SCP SCJ = Disproved (\ x -> case x of)- (%~) SCP SCK = Disproved (\ x -> case x of)- (%~) SCP SCL = Disproved (\ x -> case x of)- (%~) SCP SCM = Disproved (\ x -> case x of)- (%~) SCP SCN = Disproved (\ x -> case x of)- (%~) SCP SCO = Disproved (\ x -> case x of)- (%~) SCP SCP = Proved Refl- (%~) SCP SCQ = Disproved (\ x -> case x of)- (%~) SCP SCR = Disproved (\ x -> case x of)- (%~) SCP SCS = Disproved (\ x -> case x of)- (%~) SCP SCT = Disproved (\ x -> case x of)- (%~) SCP SCU = Disproved (\ x -> case x of)- (%~) SCP SCV = Disproved (\ x -> case x of)- (%~) SCP SCW = Disproved (\ x -> case x of)- (%~) SCP SCX = Disproved (\ x -> case x of)- (%~) SCP SCY = Disproved (\ x -> case x of)- (%~) SCP SCZ = Disproved (\ x -> case x of)- (%~) SCQ SCA = Disproved (\ x -> case x of)- (%~) SCQ SCB = Disproved (\ x -> case x of)- (%~) SCQ SCC = Disproved (\ x -> case x of)- (%~) SCQ SCD = Disproved (\ x -> case x of)- (%~) SCQ SCE = Disproved (\ x -> case x of)- (%~) SCQ SCF = Disproved (\ x -> case x of)- (%~) SCQ SCG = Disproved (\ x -> case x of)- (%~) SCQ SCH = Disproved (\ x -> case x of)- (%~) SCQ SCI = Disproved (\ x -> case x of)- (%~) SCQ SCJ = Disproved (\ x -> case x of)- (%~) SCQ SCK = Disproved (\ x -> case x of)- (%~) SCQ SCL = Disproved (\ x -> case x of)- (%~) SCQ SCM = Disproved (\ x -> case x of)- (%~) SCQ SCN = Disproved (\ x -> case x of)- (%~) SCQ SCO = Disproved (\ x -> case x of)- (%~) SCQ SCP = Disproved (\ x -> case x of)- (%~) SCQ SCQ = Proved Refl- (%~) SCQ SCR = Disproved (\ x -> case x of)- (%~) SCQ SCS = Disproved (\ x -> case x of)- (%~) SCQ SCT = Disproved (\ x -> case x of)- (%~) SCQ SCU = Disproved (\ x -> case x of)- (%~) SCQ SCV = Disproved (\ x -> case x of)- (%~) SCQ SCW = Disproved (\ x -> case x of)- (%~) SCQ SCX = Disproved (\ x -> case x of)- (%~) SCQ SCY = Disproved (\ x -> case x of)- (%~) SCQ SCZ = Disproved (\ x -> case x of)- (%~) SCR SCA = Disproved (\ x -> case x of)- (%~) SCR SCB = Disproved (\ x -> case x of)- (%~) SCR SCC = Disproved (\ x -> case x of)- (%~) SCR SCD = Disproved (\ x -> case x of)- (%~) SCR SCE = Disproved (\ x -> case x of)- (%~) SCR SCF = Disproved (\ x -> case x of)- (%~) SCR SCG = Disproved (\ x -> case x of)- (%~) SCR SCH = Disproved (\ x -> case x of)- (%~) SCR SCI = Disproved (\ x -> case x of)- (%~) SCR SCJ = Disproved (\ x -> case x of)- (%~) SCR SCK = Disproved (\ x -> case x of)- (%~) SCR SCL = Disproved (\ x -> case x of)- (%~) SCR SCM = Disproved (\ x -> case x of)- (%~) SCR SCN = Disproved (\ x -> case x of)- (%~) SCR SCO = Disproved (\ x -> case x of)- (%~) SCR SCP = Disproved (\ x -> case x of)- (%~) SCR SCQ = Disproved (\ x -> case x of)- (%~) SCR SCR = Proved Refl- (%~) SCR SCS = Disproved (\ x -> case x of)- (%~) SCR SCT = Disproved (\ x -> case x of)- (%~) SCR SCU = Disproved (\ x -> case x of)- (%~) SCR SCV = Disproved (\ x -> case x of)- (%~) SCR SCW = Disproved (\ x -> case x of)- (%~) SCR SCX = Disproved (\ x -> case x of)- (%~) SCR SCY = Disproved (\ x -> case x of)- (%~) SCR SCZ = Disproved (\ x -> case x of)- (%~) SCS SCA = Disproved (\ x -> case x of)- (%~) SCS SCB = Disproved (\ x -> case x of)- (%~) SCS SCC = Disproved (\ x -> case x of)- (%~) SCS SCD = Disproved (\ x -> case x of)- (%~) SCS SCE = Disproved (\ x -> case x of)- (%~) SCS SCF = Disproved (\ x -> case x of)- (%~) SCS SCG = Disproved (\ x -> case x of)- (%~) SCS SCH = Disproved (\ x -> case x of)- (%~) SCS SCI = Disproved (\ x -> case x of)- (%~) SCS SCJ = Disproved (\ x -> case x of)- (%~) SCS SCK = Disproved (\ x -> case x of)- (%~) SCS SCL = Disproved (\ x -> case x of)- (%~) SCS SCM = Disproved (\ x -> case x of)- (%~) SCS SCN = Disproved (\ x -> case x of)- (%~) SCS SCO = Disproved (\ x -> case x of)- (%~) SCS SCP = Disproved (\ x -> case x of)- (%~) SCS SCQ = Disproved (\ x -> case x of)- (%~) SCS SCR = Disproved (\ x -> case x of)- (%~) SCS SCS = Proved Refl- (%~) SCS SCT = Disproved (\ x -> case x of)- (%~) SCS SCU = Disproved (\ x -> case x of)- (%~) SCS SCV = Disproved (\ x -> case x of)- (%~) SCS SCW = Disproved (\ x -> case x of)- (%~) SCS SCX = Disproved (\ x -> case x of)- (%~) SCS SCY = Disproved (\ x -> case x of)- (%~) SCS SCZ = Disproved (\ x -> case x of)- (%~) SCT SCA = Disproved (\ x -> case x of)- (%~) SCT SCB = Disproved (\ x -> case x of)- (%~) SCT SCC = Disproved (\ x -> case x of)- (%~) SCT SCD = Disproved (\ x -> case x of)- (%~) SCT SCE = Disproved (\ x -> case x of)- (%~) SCT SCF = Disproved (\ x -> case x of)- (%~) SCT SCG = Disproved (\ x -> case x of)- (%~) SCT SCH = Disproved (\ x -> case x of)- (%~) SCT SCI = Disproved (\ x -> case x of)- (%~) SCT SCJ = Disproved (\ x -> case x of)- (%~) SCT SCK = Disproved (\ x -> case x of)- (%~) SCT SCL = Disproved (\ x -> case x of)- (%~) SCT SCM = Disproved (\ x -> case x of)- (%~) SCT SCN = Disproved (\ x -> case x of)- (%~) SCT SCO = Disproved (\ x -> case x of)- (%~) SCT SCP = Disproved (\ x -> case x of)- (%~) SCT SCQ = Disproved (\ x -> case x of)- (%~) SCT SCR = Disproved (\ x -> case x of)- (%~) SCT SCS = Disproved (\ x -> case x of)- (%~) SCT SCT = Proved Refl- (%~) SCT SCU = Disproved (\ x -> case x of)- (%~) SCT SCV = Disproved (\ x -> case x of)- (%~) SCT SCW = Disproved (\ x -> case x of)- (%~) SCT SCX = Disproved (\ x -> case x of)- (%~) SCT SCY = Disproved (\ x -> case x of)- (%~) SCT SCZ = Disproved (\ x -> case x of)- (%~) SCU SCA = Disproved (\ x -> case x of)- (%~) SCU SCB = Disproved (\ x -> case x of)- (%~) SCU SCC = Disproved (\ x -> case x of)- (%~) SCU SCD = Disproved (\ x -> case x of)- (%~) SCU SCE = Disproved (\ x -> case x of)- (%~) SCU SCF = Disproved (\ x -> case x of)- (%~) SCU SCG = Disproved (\ x -> case x of)- (%~) SCU SCH = Disproved (\ x -> case x of)- (%~) SCU SCI = Disproved (\ x -> case x of)- (%~) SCU SCJ = Disproved (\ x -> case x of)- (%~) SCU SCK = Disproved (\ x -> case x of)- (%~) SCU SCL = Disproved (\ x -> case x of)- (%~) SCU SCM = Disproved (\ x -> case x of)- (%~) SCU SCN = Disproved (\ x -> case x of)- (%~) SCU SCO = Disproved (\ x -> case x of)- (%~) SCU SCP = Disproved (\ x -> case x of)- (%~) SCU SCQ = Disproved (\ x -> case x of)- (%~) SCU SCR = Disproved (\ x -> case x of)- (%~) SCU SCS = Disproved (\ x -> case x of)- (%~) SCU SCT = Disproved (\ x -> case x of)- (%~) SCU SCU = Proved Refl- (%~) SCU SCV = Disproved (\ x -> case x of)- (%~) SCU SCW = Disproved (\ x -> case x of)- (%~) SCU SCX = Disproved (\ x -> case x of)- (%~) SCU SCY = Disproved (\ x -> case x of)- (%~) SCU SCZ = Disproved (\ x -> case x of)- (%~) SCV SCA = Disproved (\ x -> case x of)- (%~) SCV SCB = Disproved (\ x -> case x of)- (%~) SCV SCC = Disproved (\ x -> case x of)- (%~) SCV SCD = Disproved (\ x -> case x of)- (%~) SCV SCE = Disproved (\ x -> case x of)- (%~) SCV SCF = Disproved (\ x -> case x of)- (%~) SCV SCG = Disproved (\ x -> case x of)- (%~) SCV SCH = Disproved (\ x -> case x of)- (%~) SCV SCI = Disproved (\ x -> case x of)- (%~) SCV SCJ = Disproved (\ x -> case x of)- (%~) SCV SCK = Disproved (\ x -> case x of)- (%~) SCV SCL = Disproved (\ x -> case x of)- (%~) SCV SCM = Disproved (\ x -> case x of)- (%~) SCV SCN = Disproved (\ x -> case x of)- (%~) SCV SCO = Disproved (\ x -> case x of)- (%~) SCV SCP = Disproved (\ x -> case x of)- (%~) SCV SCQ = Disproved (\ x -> case x of)- (%~) SCV SCR = Disproved (\ x -> case x of)- (%~) SCV SCS = Disproved (\ x -> case x of)- (%~) SCV SCT = Disproved (\ x -> case x of)- (%~) SCV SCU = Disproved (\ x -> case x of)- (%~) SCV SCV = Proved Refl- (%~) SCV SCW = Disproved (\ x -> case x of)- (%~) SCV SCX = Disproved (\ x -> case x of)- (%~) SCV SCY = Disproved (\ x -> case x of)- (%~) SCV SCZ = Disproved (\ x -> case x of)- (%~) SCW SCA = Disproved (\ x -> case x of)- (%~) SCW SCB = Disproved (\ x -> case x of)- (%~) SCW SCC = Disproved (\ x -> case x of)- (%~) SCW SCD = Disproved (\ x -> case x of)- (%~) SCW SCE = Disproved (\ x -> case x of)- (%~) SCW SCF = Disproved (\ x -> case x of)- (%~) SCW SCG = Disproved (\ x -> case x of)- (%~) SCW SCH = Disproved (\ x -> case x of)- (%~) SCW SCI = Disproved (\ x -> case x of)- (%~) SCW SCJ = Disproved (\ x -> case x of)- (%~) SCW SCK = Disproved (\ x -> case x of)- (%~) SCW SCL = Disproved (\ x -> case x of)- (%~) SCW SCM = Disproved (\ x -> case x of)- (%~) SCW SCN = Disproved (\ x -> case x of)- (%~) SCW SCO = Disproved (\ x -> case x of)- (%~) SCW SCP = Disproved (\ x -> case x of)- (%~) SCW SCQ = Disproved (\ x -> case x of)- (%~) SCW SCR = Disproved (\ x -> case x of)- (%~) SCW SCS = Disproved (\ x -> case x of)- (%~) SCW SCT = Disproved (\ x -> case x of)- (%~) SCW SCU = Disproved (\ x -> case x of)- (%~) SCW SCV = Disproved (\ x -> case x of)- (%~) SCW SCW = Proved Refl- (%~) SCW SCX = Disproved (\ x -> case x of)- (%~) SCW SCY = Disproved (\ x -> case x of)- (%~) SCW SCZ = Disproved (\ x -> case x of)- (%~) SCX SCA = Disproved (\ x -> case x of)- (%~) SCX SCB = Disproved (\ x -> case x of)- (%~) SCX SCC = Disproved (\ x -> case x of)- (%~) SCX SCD = Disproved (\ x -> case x of)- (%~) SCX SCE = Disproved (\ x -> case x of)- (%~) SCX SCF = Disproved (\ x -> case x of)- (%~) SCX SCG = Disproved (\ x -> case x of)- (%~) SCX SCH = Disproved (\ x -> case x of)- (%~) SCX SCI = Disproved (\ x -> case x of)- (%~) SCX SCJ = Disproved (\ x -> case x of)- (%~) SCX SCK = Disproved (\ x -> case x of)- (%~) SCX SCL = Disproved (\ x -> case x of)- (%~) SCX SCM = Disproved (\ x -> case x of)- (%~) SCX SCN = Disproved (\ x -> case x of)- (%~) SCX SCO = Disproved (\ x -> case x of)- (%~) SCX SCP = Disproved (\ x -> case x of)- (%~) SCX SCQ = Disproved (\ x -> case x of)- (%~) SCX SCR = Disproved (\ x -> case x of)- (%~) SCX SCS = Disproved (\ x -> case x of)- (%~) SCX SCT = Disproved (\ x -> case x of)- (%~) SCX SCU = Disproved (\ x -> case x of)- (%~) SCX SCV = Disproved (\ x -> case x of)- (%~) SCX SCW = Disproved (\ x -> case x of)- (%~) SCX SCX = Proved Refl- (%~) SCX SCY = Disproved (\ x -> case x of)- (%~) SCX SCZ = Disproved (\ x -> case x of)- (%~) SCY SCA = Disproved (\ x -> case x of)- (%~) SCY SCB = Disproved (\ x -> case x of)- (%~) SCY SCC = Disproved (\ x -> case x of)- (%~) SCY SCD = Disproved (\ x -> case x of)- (%~) SCY SCE = Disproved (\ x -> case x of)- (%~) SCY SCF = Disproved (\ x -> case x of)- (%~) SCY SCG = Disproved (\ x -> case x of)- (%~) SCY SCH = Disproved (\ x -> case x of)- (%~) SCY SCI = Disproved (\ x -> case x of)- (%~) SCY SCJ = Disproved (\ x -> case x of)- (%~) SCY SCK = Disproved (\ x -> case x of)- (%~) SCY SCL = Disproved (\ x -> case x of)- (%~) SCY SCM = Disproved (\ x -> case x of)- (%~) SCY SCN = Disproved (\ x -> case x of)- (%~) SCY SCO = Disproved (\ x -> case x of)- (%~) SCY SCP = Disproved (\ x -> case x of)- (%~) SCY SCQ = Disproved (\ x -> case x of)- (%~) SCY SCR = Disproved (\ x -> case x of)- (%~) SCY SCS = Disproved (\ x -> case x of)- (%~) SCY SCT = Disproved (\ x -> case x of)- (%~) SCY SCU = Disproved (\ x -> case x of)- (%~) SCY SCV = Disproved (\ x -> case x of)- (%~) SCY SCW = Disproved (\ x -> case x of)- (%~) SCY SCX = Disproved (\ x -> case x of)- (%~) SCY SCY = Proved Refl- (%~) SCY SCZ = Disproved (\ x -> case x of)- (%~) SCZ SCA = Disproved (\ x -> case x of)- (%~) SCZ SCB = Disproved (\ x -> case x of)- (%~) SCZ SCC = Disproved (\ x -> case x of)- (%~) SCZ SCD = Disproved (\ x -> case x of)- (%~) SCZ SCE = Disproved (\ x -> case x of)- (%~) SCZ SCF = Disproved (\ x -> case x of)- (%~) SCZ SCG = Disproved (\ x -> case x of)- (%~) SCZ SCH = Disproved (\ x -> case x of)- (%~) SCZ SCI = Disproved (\ x -> case x of)- (%~) SCZ SCJ = Disproved (\ x -> case x of)- (%~) SCZ SCK = Disproved (\ x -> case x of)- (%~) SCZ SCL = Disproved (\ x -> case x of)- (%~) SCZ SCM = Disproved (\ x -> case x of)- (%~) SCZ SCN = Disproved (\ x -> case x of)- (%~) SCZ SCO = Disproved (\ x -> case x of)- (%~) SCZ SCP = Disproved (\ x -> case x of)- (%~) SCZ SCQ = Disproved (\ x -> case x of)- (%~) SCZ SCR = Disproved (\ x -> case x of)- (%~) SCZ SCS = Disproved (\ x -> case x of)- (%~) SCZ SCT = Disproved (\ x -> case x of)- (%~) SCZ SCU = Disproved (\ x -> case x of)- (%~) SCZ SCV = Disproved (\ x -> case x of)- (%~) SCZ SCW = Disproved (\ x -> case x of)- (%~) SCZ SCX = Disproved (\ x -> case x of)- (%~) SCZ SCY = Disproved (\ x -> case x of)- (%~) SCZ SCZ = Proved Refl- deriving instance (Data.Singletons.ShowSing.ShowSing U,- Data.Singletons.ShowSing.ShowSing Nat) =>- Show (Sing (z :: U))- deriving instance Show (Sing (z :: AChar))- instance SingI BOOL where- sing = SBOOL- instance SingI STRING where- sing = SSTRING- instance SingI NAT where- sing = SNAT- instance (SingI n, SingI n) =>- SingI (VEC (n :: U) (n :: Nat)) where- sing = (SVEC sing) sing- instance SingI (VECSym0 :: (~>) U ((~>) Nat U)) where- sing = (singFun2 @VECSym0) SVEC- instance SingI (TyCon2 VEC :: (~>) U ((~>) Nat U)) where- sing = (singFun2 @(TyCon2 VEC)) SVEC- instance SingI d => SingI (VECSym1 (d :: U) :: (~>) Nat U) where- sing = (singFun1 @(VECSym1 (d :: U))) (SVEC (sing @d))- instance SingI d =>- SingI (TyCon1 (VEC (d :: U)) :: (~>) Nat U) where- sing = (singFun1 @(TyCon1 (VEC (d :: U)))) (SVEC (sing @d))- instance SingI CA where- sing = SCA- instance SingI CB where- sing = SCB- instance SingI CC where- sing = SCC- instance SingI CD where- sing = SCD- instance SingI CE where- sing = SCE- instance SingI CF where- sing = SCF- instance SingI CG where- sing = SCG- instance SingI CH where- sing = SCH- instance SingI CI where- sing = SCI- instance SingI CJ where- sing = SCJ- instance SingI CK where- sing = SCK- instance SingI CL where- sing = SCL- instance SingI CM where- sing = SCM- instance SingI CN where- sing = SCN- instance SingI CO where- sing = SCO- instance SingI CP where- sing = SCP- instance SingI CQ where- sing = SCQ- instance SingI CR where- sing = SCR- instance SingI CS where- sing = SCS- instance SingI CT where- sing = SCT- instance SingI CU where- sing = SCU- instance SingI CV where- sing = SCV- instance SingI CW where- sing = SCW- instance SingI CX where- sing = SCX- instance SingI CY where- sing = SCY- instance SingI CZ where- sing = SCZ- instance (SingI n, SingI n) =>- SingI (Attr (n :: [AChar]) (n :: U)) where- sing = (SAttr sing) sing- instance SingI (AttrSym0 :: (~>) [AChar] ((~>) U Attribute)) where- sing = (singFun2 @AttrSym0) SAttr- instance SingI (TyCon2 Attr :: (~>) [AChar] ((~>) U Attribute)) where- sing = (singFun2 @(TyCon2 Attr)) SAttr- instance SingI d =>- SingI (AttrSym1 (d :: [AChar]) :: (~>) U Attribute) where- sing = (singFun1 @(AttrSym1 (d :: [AChar]))) (SAttr (sing @d))- instance SingI d =>- SingI (TyCon1 (Attr (d :: [AChar])) :: (~>) U Attribute) where- sing = (singFun1 @(TyCon1 (Attr (d :: [AChar])))) (SAttr (sing @d))- instance SingI n => SingI (Sch (n :: [Attribute])) where- sing = SSch sing- instance SingI (SchSym0 :: (~>) [Attribute] Schema) where- sing = (singFun1 @SchSym0) SSch- instance SingI (TyCon1 Sch :: (~>) [Attribute] Schema) where- sing = (singFun1 @(TyCon1 Sch)) SSch-GradingClient/Database.hs:0:0:: Splicing declarations- return [] ======>-GradingClient/Database.hs:(0,0)-(0,0): Splicing expression- cases ''Row [| r |] [| changeId (n ++ (getId r)) r |]- ======>- case r of- EmptyRow _ -> (changeId (((++) n) (getId r))) r- ConsRow _ _ -> (changeId (((++) n) (getId r))) r
− tests/compile-and-dump/GradingClient/Database.hs
@@ -1,552 +0,0 @@-{- Database.hs--(c) Richard Eisenberg 2012-rae@cs.brynmawr.edu--This file contains the full code for the database interface example-presented in /Dependently typed programming with singletons/---}--{-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies,- GADTs, TypeOperators, RankNTypes, FlexibleContexts, UndecidableInstances,- FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses,- ConstraintKinds, InstanceSigs #-}-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}---- The OverlappingInstances is needed only to allow the InC and SubsetC classes.--- This is simply a convenience so that GHC can infer the necessary proofs of--- schema inclusion. The library could easily be designed without this flag,--- but it would require a client to explicity build proof terms from--- InProof and Subset.--module GradingClient.Database where--import Prelude hiding ( tail, id )-import Data.Singletons.Prelude hiding ( Lookup, sLookup )-import Data.Singletons.Prelude.Show-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Control.Monad-import Control.Monad.Except ( throwError )-import Data.List hiding ( tail )-import Data.Kind (Type)--$(singletons [d|- -- Basic Nat type- data Nat = Zero | Succ Nat deriving (Eq, Ord)- |])---- Conversions to any from Integers-fromNat :: Nat -> Integer-fromNat Zero = 0-fromNat (Succ n) = (fromNat n) + 1--toNat :: Integer -> Nat-toNat 0 = Zero-toNat n | n > 0 = Succ (toNat (n - 1))-toNat _ = error "Converting negative to Nat"---- Display and read Nats using decimal digits-instance Show Nat where- show = show . fromNat-instance Read Nat where- readsPrec n s = map (\(a,rest) -> (toNat a,rest)) $ readsPrec n s--$(singletons [d|- -- Our "U"niverse of types. These types can be stored in our database.- data U = BOOL- | STRING- | NAT- | VEC U Nat deriving (Read, Eq, Show)-- -- A re-definition of Char as an algebraic data type.- -- This is necessary to allow for promotion and type-level Strings.- data AChar = CA | CB | CC | CD | CE | CF | CG | CH | CI- | CJ | CK | CL | CM | CN | CO | CP | CQ | CR- | CS | CT | CU | CV | CW | CX | CY | CZ- deriving (Read, Show, Eq)-- -- A named attribute in our database- data Attribute = Attr [AChar] U-- -- A schema is an ordered list of named attributes- data Schema = Sch [Attribute]-- -- append two schemas- append :: Schema -> Schema -> Schema- append (Sch s1) (Sch s2) = Sch (s1 ++ s2)-- -- predicate to check that a schema is free of a certain attribute- attrNotIn :: Attribute -> Schema -> Bool- attrNotIn _ (Sch []) = True- attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) =- (name /= name') && (attrNotIn (Attr name u) (Sch t))-- -- predicate to check that two schemas are disjoint- disjoint :: Schema -> Schema -> Bool- disjoint (Sch []) _ = True- disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s)-- -- predicate to check if a name occurs in a schema- occurs :: [AChar] -> Schema -> Bool- occurs _ (Sch []) = False- occurs name (Sch ((Attr name' _) : attrs)) =- name == name' || occurs name (Sch attrs)-- -- looks up an element type from a schema- lookup :: [AChar] -> Schema -> U- lookup _ (Sch []) = undefined- lookup name (Sch ((Attr name' u) : attrs)) =- if name == name' then u else lookup name (Sch attrs)- |])---- The El type family gives us the type associated with a constructor--- of U:-type family El (u :: U) :: Type-type instance El BOOL = Bool-type instance El STRING = String-type instance El NAT = Nat-type instance El (VEC u n) = Vec (El u) n---- Length-indexed vectors-data Vec :: Type -> Nat -> Type where- VNil :: Vec a Zero- VCons :: a -> Vec a n -> Vec a (Succ n)---- Read instances are keyed by the index of the vector to aid in parsing-instance Read (Vec a Zero) where- readsPrec _ s = [(VNil, s)]-instance (Read a, Read (Vec a n)) => Read (Vec a (Succ n)) where- readsPrec n s = do- (a, rest) <- readsPrec n s- (tail, restrest) <- readsPrec n rest- return (VCons a tail, restrest)---- Because the Read instances are keyed by the length of the vector,--- it is not obvious to the compiler that all Vecs have a Read instance.--- We must make a short inductive proof of this fact.---- First, we define a datatype to store the resulting instance, keyed--- by the parameters to Vec:-data VecReadInstance a n where- VecReadInstance :: Read (Vec a n) => VecReadInstance a n---- Then, we make a function that produces an instance of Read for a--- Vec, given the datatype it is over and its length, both encoded--- using singleton types:-vecReadInstance :: Read (El u) => SU u -> SNat n -> VecReadInstance (El u) n-vecReadInstance _ SZero = VecReadInstance-vecReadInstance u (SSucc n) = case vecReadInstance u n of- VecReadInstance -> VecReadInstance---- The Show instance can be straightforwardly defined:-instance Show a => Show (Vec a n) where- show VNil = ""- show (VCons h t) = (show h) ++ " " ++ (show t)---- We need to be able to Read and Show elements of our database, so--- we must know that any type of the form (El u) for some (u :: U)--- has a Read and Show instance. Because we can't declare this instance--- directly (as, in general, declaring an instance of a type family--- would be unsound), we provide inductive proofs that these instances--- exist:-data ElUReadInstance u where- ElUReadInstance :: Read (El u) => ElUReadInstance u--elUReadInstance :: Sing u -> ElUReadInstance u-elUReadInstance SBOOL = ElUReadInstance-elUReadInstance SSTRING = ElUReadInstance-elUReadInstance SNAT = ElUReadInstance-elUReadInstance (SVEC u n) = case elUReadInstance u of- ElUReadInstance -> case vecReadInstance u n of- VecReadInstance -> ElUReadInstance--data ElUShowInstance u where- ElUShowInstance :: Show (El u) => ElUShowInstance u--elUShowInstance :: Sing u -> ElUShowInstance u-elUShowInstance SBOOL = ElUShowInstance-elUShowInstance SSTRING = ElUShowInstance-elUShowInstance SNAT = ElUShowInstance-elUShowInstance (SVEC u _) = case elUShowInstance u of- ElUShowInstance -> ElUShowInstance--showAttrProof :: Sing (Attr nm u) -> ElUShowInstance u-showAttrProof (SAttr _ u) = elUShowInstance u---- A Row is one row of our database table, keyed by its schema.-data Row :: Schema -> Type where- EmptyRow :: [Int] -> Row (Sch '[]) -- the Ints are the unique id of the row- ConsRow :: El u -> Row (Sch s) -> Row (Sch ((Attr name u) ': s))---- We build Show instances for a Row element by element:-instance Show (Row (Sch '[])) where- show (EmptyRow n) = "(id=" ++ (show n) ++ ")"-instance (Show (El u), Show (Row (Sch attrs))) =>- Show (Row (Sch ((Attr name u) ': attrs))) where- show (ConsRow h t) = case t of- EmptyRow n -> (show h) ++ " (id=" ++ (show n) ++ ")"- _ -> (show h) ++ ", " ++ (show t)---- A Handle in our system is an abstract handle to a loaded table.--- The constructor is not exported. In our simplistic case, we--- just store the list of rows. A more sophisticated implementation--- could store some identifier to the connection to an external database.-data Handle :: Schema -> Type where- Handle :: [Row s] -> Handle s---- The following functions parse our very simple flat file database format.---- The file, with a name ending in ".dat", consists of a sequence of lines,--- where each line contains one entry in the table. There is no row separator;--- if a row contains n pieces of data, that row is represented in n lines in--- the file.---- A schema is stored in a file of the same name, except ending in ".schema".--- Each line in the file is a constructor of U indicating the type of the--- corresponding row element.---- Use Either for error handling in parsing functions-type ErrorM = Either String---- This function is relatively uninteresting except for its use of--- pattern matching to introduce the instances of Read and Show for--- elements-readRow :: Int -> SSchema s -> [String] -> ErrorM (Row s, [String])-readRow id (SSch SNil) strs =- return (EmptyRow [id], strs)-readRow _ (SSch (SCons _ _)) [] =- throwError "Ran out of data while processing row"-readRow id (SSch (SCons (SAttr _ u) at)) (sh:st) = do- (rowTail, strTail) <- readRow id (SSch at) st- case elUReadInstance u of- ElUReadInstance ->- let results = readsPrec 0 sh in- if null results- then throwError $ "No parse of " ++ sh ++ " as a " ++- (show (fromSing u))- else- let item = fst $ head results in- case elUShowInstance u of- ElUShowInstance -> return (ConsRow item rowTail, strTail)--readRows :: SSchema s -> [String] -> [Row s] -> ErrorM [Row s]-readRows _ [] soFar = return soFar-readRows sch lst soFar = do- (row, rest) <- readRow (length soFar) sch lst- readRows sch rest (row : soFar)---- Given the name of a database and its schema, return a handle to the--- database.-connect :: String -> SSchema s -> IO (Handle s)-connect name schema = do- schString <- readFile (name ++ ".schema")- let schEntries = lines schString- usFound = map read schEntries -- load schema just using "read"- (Sch attrs) = fromSing schema- usExpected = map (\(Attr _ u) -> u) attrs- unless (usFound == usExpected) -- compare found schema with expected- (fail "Expected schema does not match found schema")- dataString <- readFile (name ++ ".dat")- let dataEntries = lines dataString- result = readRows schema dataEntries [] -- read actual data- case result of- Left errorMsg -> fail errorMsg- Right rows -> return $ Handle rows---- In order to define strongly-typed projection from a row, we need to have a notion--- that one schema is a subset of another. We permit the schemas to have their columns--- in different orders. We define this subset relation via two inductively defined--- propositions. In Haskell, these inductively defined propositions take the form of--- GADTs. In their original form, they would look like this:-{--data InProof :: Attribute -> Schema -> Type where- InElt :: InProof attr (Sch (attr ': schTail))- InTail :: InProof attr (Sch attrs) -> InProof attr (Sch (a ': attrs))--data SubsetProof :: Schema -> Schema -> Type where- SubsetEmpty :: SubsetProof (Sch '[]) s'- SubsetCons :: InProof attr s' -> SubsetProof (Sch attrs) s' ->- SubsetProof (Sch (attr ': attrs)) s'--}--- However, it would be convenient to users of the database library not to require--- building these proofs manually. So, we define type classes so that the compiler--- builds the proofs automatically. To make everything work well together, we also--- make the parameters to the proof GADT constructors implicit -- i.e. in the form--- of type class constraints.--data InProof :: Attribute -> Schema -> Type where- InElt :: InProof attr (Sch (attr ': schTail))- InTail :: InC name u (Sch attrs) => InProof (Attr name u) (Sch (a ': attrs))--class InC (name :: [AChar]) (u :: U) (sch :: Schema) where- inProof :: InProof (Attr name u) sch-instance InC name u (Sch ((Attr name u) ': schTail)) where- inProof = InElt-instance InC name u (Sch attrs) => InC name u (Sch (a ': attrs)) where- inProof = InTail--data SubsetProof :: Schema -> Schema -> Type where- SubsetEmpty :: SubsetProof (Sch '[]) s'- SubsetCons :: (InC name u s', SubsetC (Sch attrs) s') =>- SubsetProof (Sch ((Attr name u) ': attrs)) s'--class SubsetC (s :: Schema) (s' :: Schema) where- subset :: SubsetProof s s'--instance SubsetC (Sch '[]) s' where- subset = SubsetEmpty-instance (InC name u s', SubsetC (Sch attrs) s') =>- SubsetC (Sch ((Attr name u) ': attrs)) s' where- subset = SubsetCons---- To access the data in a structured (and well-typed!) way, we use--- an RA (short for Relational Algebra). An RA is indexed by the schema--- of the data it produces.-data RA :: Schema -> Type where- -- The RA includes all data represented by the handle.- Read :: Handle s -> RA s-- -- The RA is a union of the rows represented by the two RAs provided.- -- Note that the schemas of the two RAs must be the same for this- -- constructor use to type-check.- Union :: RA s -> RA s -> RA s-- -- The RA is the list of rows in the first RA, omitting those in the- -- second. Once again, the schemas must match.- Diff :: RA s -> RA s -> RA s-- -- The RA is a Cartesian product of the two RAs provided. Note that- -- the schemas of the two provided RAs must be disjoint.- Product :: (Disjoint s s' ~ True, SingI s, SingI s') =>- RA s -> RA s' -> RA (Append s s')-- -- The RA is a projection conforming to the schema provided. The- -- type-checker ensures that this schema is a subset of the data- -- included in the provided RA.- Project :: (SubsetC s' s, SingI s) =>- SSchema s' -> RA s -> RA s'-- -- The RA contains only those rows of the provided RA for which- -- the provided expression evaluates to True. Note that the- -- schema of the provided RA and the resultant RA are the same- -- because the columns of data are the same. Also note that- -- the expression must return a Bool for this to type-check.- Select :: Expr s BOOL -> RA s -> RA s---- Other constructors would be added in a more robust database--- implementation.---- An Expr is used with the Select constructor to choose some--- subset of rows from a table. Expressions are indexed by the--- schema over which they operate and the return value they--- produce.-data Expr :: Schema -> U -> Type where- -- Equality among two elements- Equal :: Eq (El u) => Expr s u -> Expr s u -> Expr s BOOL-- -- A less-than comparison among two Nats- LessThan :: Expr s NAT -> Expr s NAT -> Expr s BOOL-- -- A literal number- LiteralNat :: Integer -> Expr s NAT-- -- Projection in an expression -- evaluates to the value- -- of the named attribute.- Element :: (Occurs nm s ~ True) =>- SSchema s -> Sing nm -> Expr s (Lookup nm s)-- -- A more robust implementation would include more constructors---- Retrieves the id from a row. Ids are used when computing unions and--- differences.-getId :: Row s -> [Int]-getId (EmptyRow n) = n-getId (ConsRow _ t) = getId t---- Changes the id of a row to a new value-changeId :: [Int] -> Row s -> Row s-changeId n (EmptyRow _) = EmptyRow n-changeId n (ConsRow h t) = ConsRow h (changeId n t)---- Equality for rows based on ids.-eqRow :: Row s -> Row s -> Bool-eqRow r1 r2 = getId r1 == getId r2---- Equality for attributes based on names-eqAttr :: Attribute -> Attribute -> Bool-eqAttr (Attr nm _) (Attr nm' _) = nm == nm'---- Appends two rows. There are three suspicious case statements -- they are--- suspicious in that the different branches are all exactly identical. Here--- is why they are needed:---- The two case statements on r are necessary to deconstruct the index in the--- type of r; GHC does not use the fact that s' must be (Sch a') for some a'.--- By doing a case analysis on r, GHC uses the types given in the different--- constructors for Row, both of which give the form of s' as (Sch a'). This--- deconstruction is necessary for the type family Append to compute, because--- Append is defined only when its second argument is of the form (Sch a').---- The case statement on rowAppend t r is necessary to avoid potential--- overlapping instances for the SingRep class; the instances are needed for--- the call to ConsRow. The potential for overlapping instances comes from--- ambiguity in the component types of (Append s s'). By doing case analysis--- on rowAppend t r, these variables become fixed, and the potential for--- overlapping instances disappears.---- We use the "cases" Singletons library operation to produce the case--- analysis in the first clause. This "cases" operation produces a case--- statement where each branch is identical and each constructor parameter--- is ignored. The "cases" operation does not work for the second clause--- because the code in the clause depends on definitions generated earlier.--- Template Haskell restricts certain dependencies between auto-generated--- code blocks to prevent the possibility of circular dependencies.--- In this case, if the $(singletons ...) blocks above were in a different--- module, the "cases" operation would be applicable here.--$( return [] )--rowAppend :: Row s -> Row s' -> Row (Append s s')-rowAppend (EmptyRow n) r = $(cases ''Row [| r |]- [| changeId (n ++ (getId r)) r |])-rowAppend (ConsRow h t) r = case r of- EmptyRow _ ->- case rowAppend t r of- EmptyRow _ -> ConsRow h (rowAppend t r)- ConsRow _ _ -> ConsRow h (rowAppend t r)- ConsRow _ _ ->- case rowAppend t r of- EmptyRow _ -> ConsRow h (rowAppend t r)- ConsRow _ _ -> ConsRow h (rowAppend t r)---- Choose the elements of one list based on truth values in another-choose :: [Bool] -> [a] -> [a]-choose [] _ = []-choose (False : btail) (_ : t) = choose btail t-choose (True : btail) (h : t) = h : (choose btail t)-choose _ [] = []---- The query function is the eliminator for an RA. It returns a list of--- rows containing the data produced by the RA.-query :: forall s. SingI s => RA s -> IO [Row s]-query (Read (Handle rows)) = return rows-query (Union ra rb) = do- rowsa <- query ra- rowsb <- query rb- return $ unionBy eqRow rowsa rowsb-query (Diff ra rb) = do- rowsa <- query ra- rowsb <- query rb- return $ deleteFirstsBy eqRow rowsa rowsb-query (Product ra rb) = do- rowsa <- query ra- rowsb <- query rb- return $ do -- entering the [] Monad- rowa <- rowsa- rowb <- rowsb- return $ rowAppend rowa rowb-query (Project sch ra) = do- rows <- query ra- return $ map (projectRow sch) rows- where -- The projectRow function uses the relationship encoded in the Subset- -- relation to project the requested columns of data in a type-safe manner.-- -- It recurs on the structure of the provided schema, creating the output- -- row to be in the same order as the input schema. This is necessary for- -- the output to type-check, as it is indexed by the input schema.-- -- We use explicit quantification to get access to scoped type variables.- projectRow :: forall (sch :: Schema) (s' :: Schema).- SubsetC sch s' => SSchema sch -> Row s' -> Row sch-- -- Base case: empty schema- projectRow (SSch SNil) r = EmptyRow (getId r)-- -- In the recursive case, we need to pattern-match on the proof that- -- the provided schema is a subset of the provided RA. We extract this- -- proof (of type SubsetProof s s') from the SubsetC instance using the- -- subset method.- projectRow (SSch (SCons attr tail)) r =- case subset :: SubsetProof sch s' of-- -- Because we know that the schema is non-empty, the only possibility- -- here is SubsetCons:- SubsetCons ->- let rtail = projectRow (SSch tail) r in- case attr of- SAttr _ u -> case elUShowInstance u of- ElUShowInstance -> ConsRow (extractElt attr r) rtail-- -- GHC correctly determines that this case is impossible if it is- -- not commented.- -- SubsetEmpty -> undefined <== IMPOSSIBLE-- -- However, the current version of GHC (7.5) does not suppress warnings- -- for incomplete pattern matches when the remaining cases are impossible.- -- So, we include this case (impossible to reach for any terminated value)- -- to suppress the warning.-- -- Retrieves the element, looked up by the name of the provided attribute,- -- from a row. The explicit quantification is necessary to create the scoped- -- type variables to use in the return type of <<inProof>>- extractElt :: forall nm u sch. InC nm u sch =>- Sing (Attr nm u) -> Row sch -> El u- extractElt attr r = case inProof :: InProof (Attr nm u) sch of- InElt -> case r of- ConsRow h _ -> h- -- EmptyRow _ -> undefined <== IMPOSSIBLE- InTail -> case r of- ConsRow _ t -> extractElt attr t- -- EmptyRow _ -> undefined <== IMPOSSBLE--query (Select expr r) = do- rows <- query r- let vals = map (eval expr) rows- return $ choose vals rows- where -- Evaluates an expression- eval :: forall s' u. SingI s' => Expr s' u -> Row s' -> El u- eval (Element _ (name :: Sing name)) row =- case row of- -- EmptyRow _ -> undefined <== IMPOSSIBLE- ConsRow h t -> case row of- (ConsRow _ _ :: Row (Sch ((Attr name' u') ': attrs))) ->- case sing :: Sing s' of- -- SSch SNil -> undefined <== IMPOSSIBLE- SSch (SCons (SAttr name' _) stail) ->- case name %== name' of- STrue -> h- SFalse -> withSingI stail (eval (Element (SSch stail) name) t)-- eval (Equal (e1 :: Expr s' u') e2) row =- let v1 = eval e1 row- v2 = eval e2 row in- v1 == v2-- -- Note that the types really help us here: the LessThan constructor is- -- defined only over Expr s NAT, so we know that evaluating e1 and e2 will- -- yield Nats, which are a member of the Ord type class.- eval (LessThan e1 e2) row =- let v1 = eval e1 row- v2 = eval e2 row in- v1 < v2-- eval (LiteralNat x) _ = toNat x--data G a where- GCons :: G ('Sch (a ': b))--data H a where- HCons :: H ('Sch (a ': b))- HNil :: H ('Sch '[])--data J a where- JCons :: J (a ': b)- JNil :: J '[]--eval :: G s -> Sing s -> ()-eval GCons s =- case s of- -- SSch SNil -> undefined -- <== IMPOSSIBLE- SSch (SCons _ _) -> undefined
− tests/compile-and-dump/GradingClient/Main.ghc86.template
@@ -1,123 +0,0 @@-GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| lastName, firstName, yearName, gradeName, majorName :: [AChar]- lastName = [CL, CA, CS, CT]- firstName = [CF, CI, CR, CS, CT]- yearName = [CY, CE, CA, CR]- gradeName = [CG, CR, CA, CD, CE]- majorName = [CM, CA, CJ, CO, CR]- gradingSchema :: Schema- gradingSchema- = Sch- [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT,- Attr gradeName NAT, Attr majorName BOOL]- names :: Schema- names = Sch [Attr firstName STRING, Attr lastName STRING] |]- ======>- lastName :: [AChar]- firstName :: [AChar]- yearName :: [AChar]- gradeName :: [AChar]- majorName :: [AChar]- lastName = [CL, CA, CS, CT]- firstName = [CF, CI, CR, CS, CT]- yearName = [CY, CE, CA, CR]- gradeName = [CG, CR, CA, CD, CE]- majorName = [CM, CA, CJ, CO, CR]- gradingSchema :: Schema- gradingSchema- = Sch- [(Attr lastName) STRING, (Attr firstName) STRING,- (Attr yearName) NAT, (Attr gradeName) NAT, (Attr majorName) BOOL]- names :: Schema- names = Sch [(Attr firstName) STRING, (Attr lastName) STRING]- type MajorNameSym0 = MajorName- type GradeNameSym0 = GradeName- type YearNameSym0 = YearName- type FirstNameSym0 = FirstName- type LastNameSym0 = LastName- type GradingSchemaSym0 = GradingSchema- type NamesSym0 = Names- type family MajorName :: [AChar] where- MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) '[]))))- type family GradeName :: [AChar] where- GradeName = Apply (Apply (:@#@$) CGSym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CDSym0) (Apply (Apply (:@#@$) CESym0) '[]))))- type family YearName :: [AChar] where- YearName = Apply (Apply (:@#@$) CYSym0) (Apply (Apply (:@#@$) CESym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CRSym0) '[])))- type family FirstName :: [AChar] where- FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[]))))- type family LastName :: [AChar] where- LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[])))- type family GradingSchema :: Schema where- GradingSchema = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 YearNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 GradeNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 MajorNameSym0) BOOLSym0)) '[])))))- type family Names :: Schema where- Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[]))- sMajorName :: Sing (MajorNameSym0 :: [AChar])- sGradeName :: Sing (GradeNameSym0 :: [AChar])- sYearName :: Sing (YearNameSym0 :: [AChar])- sFirstName :: Sing (FirstNameSym0 :: [AChar])- sLastName :: Sing (LastNameSym0 :: [AChar])- sGradingSchema :: Sing (GradingSchemaSym0 :: Schema)- sNames :: Sing (NamesSym0 :: Schema)- sMajorName- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCM))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCJ))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCO))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil))))- sGradeName- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCG))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCD))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE)) SNil))))- sYearName- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCY))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil)))- sFirstName- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCF))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCI))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil))))- sLastName- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCL))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil)))- sGradingSchema- = (applySing ((singFun1 @SchSym0) SSch))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName))- SSTRING)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName))- SSTRING)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName))- SNAT)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName))- SNAT)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName))- SBOOL)))- SNil)))))- sNames- = (applySing ((singFun1 @SchSym0) SSch))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName))- SSTRING)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName))- SSTRING)))- SNil))
− tests/compile-and-dump/GradingClient/Main.hs
@@ -1,54 +0,0 @@-{- GradingClient.hs--(c) Richard Eisenberg 2012-rae@cs.brynmawr.edu--This file accesses the database described in Database.hs and performs-some basic queries on it.---}--{-# LANGUAGE TemplateHaskell, DataKinds #-}--module Main where--import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude.List-import GradingClient.Database--$(singletons [d|- lastName, firstName, yearName, gradeName, majorName :: [AChar]- lastName = [CL, CA, CS, CT]- firstName = [CF, CI, CR, CS, CT]- yearName = [CY, CE, CA, CR]- gradeName = [CG, CR, CA, CD, CE]- majorName = [CM, CA, CJ, CO, CR]-- gradingSchema :: Schema- gradingSchema = Sch [Attr lastName STRING,- Attr firstName STRING,- Attr yearName NAT,- Attr gradeName NAT,- Attr majorName BOOL]-- names :: Schema- names = Sch [Attr firstName STRING,- Attr lastName STRING]- |])--main :: IO ()-main = do- h <- connect "grades" sGradingSchema- let ra = Read h-- allStudents <- query $ Project sNames ra- putStrLn $ "Names of all students: " ++ (show allStudents) ++ "\n"-- majors <- query $ Select (Element sGradingSchema sMajorName) ra- putStrLn $ "Students in major: " ++ (show majors) ++ "\n"-- b_students <-- query $ Project sNames $- Select (LessThan (Element sGradingSchema sGradeName) (LiteralNat 90)) ra- putStrLn $ "Names of students with grade < 90: " ++ (show b_students) ++ "\n"
− tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template
@@ -1,212 +0,0 @@-InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations- singletons [d| data Nat = Zero | Succ Nat |]- ======>- data Nat = Zero | Succ Nat- type ZeroSym0 = Zero- type SuccSym1 (t0123456789876543210 :: Nat) =- Succ t0123456789876543210- instance SuppressUnusedWarnings SuccSym0 where- suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ())- data SuccSym0 :: (~>) Nat Nat- where- SuccSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>- SuccSym0 t0123456789876543210- type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210- data instance Sing :: Nat -> Type- where- SZero :: Sing Zero- SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n)- type SNat = (Sing :: Nat -> Type)- instance SingKind Nat where- type Demote Nat = Nat- fromSing SZero = Zero- fromSing (SSucc b) = Succ (fromSing b)- toSing Zero = SomeSing SZero- toSing (Succ (b :: Demote Nat))- = case toSing b :: SomeSing Nat of {- SomeSing c -> SomeSing (SSucc c) }- instance SingI Zero where- sing = SZero- instance SingI n => SingI (Succ (n :: Nat)) where- sing = SSucc sing- instance SingI (SuccSym0 :: (~>) Nat Nat) where- sing = (singFun1 @SuccSym0) SSucc- instance SingI (TyCon1 Succ :: (~>) Nat Nat) where- sing = (singFun1 @(TyCon1 Succ)) SSucc-InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| leq :: Nat -> Nat -> Bool- leq Zero _ = True- leq (Succ _) Zero = False- leq (Succ a) (Succ b) = leq a b- insert :: Nat -> [Nat] -> [Nat]- insert n [] = [n]- insert n (h : t)- = if leq n h then (n : h : t) else h : (insert n t)- insertionSort :: [Nat] -> [Nat]- insertionSort [] = []- insertionSort (h : t) = insert h (insertionSort t) |]- ======>- leq :: Nat -> Nat -> Bool- leq Zero _ = True- leq (Succ _) Zero = False- leq (Succ a) (Succ b) = (leq a) b- insert :: Nat -> [Nat] -> [Nat]- insert n [] = [n]- insert n (h : t)- = if (leq n) h then (n : (h : t)) else (h : (insert n) t)- insertionSort :: [Nat] -> [Nat]- insertionSort [] = []- insertionSort (h : t) = (insert h) (insertionSort t)- type Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall n0123456789876543210- h0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 h0123456789876543210 n0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall n0123456789876543210- h0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) h0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall n0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where- Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h- type family Case_0123456789876543210 n h t t where- Case_0123456789876543210 n h t 'True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t)- Case_0123456789876543210 n h t 'False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t)- type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Leq a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ())- data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool- where- LeqSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) =>- LeqSym1 a0123456789876543210 a0123456789876543210- type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings LeqSym0 where- suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ())- data LeqSym0 :: (~>) Nat ((~>) Nat Bool)- where- LeqSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) =>- LeqSym0 a0123456789876543210- type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210- type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) =- Insert a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) InsertSym1KindInference) ())- data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat]- where- InsertSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) =>- InsertSym1 a0123456789876543210 a0123456789876543210- type instance Apply (InsertSym1 a0123456789876543210) a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings InsertSym0 where- suppressUnusedWarnings = snd (((,) InsertSym0KindInference) ())- data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])- where- InsertSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) =>- InsertSym0 a0123456789876543210- type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210- type InsertionSortSym1 (a0123456789876543210 :: [Nat]) =- InsertionSort a0123456789876543210- instance SuppressUnusedWarnings InsertionSortSym0 where- suppressUnusedWarnings- = snd (((,) InsertionSortSym0KindInference) ())- data InsertionSortSym0 :: (~>) [Nat] [Nat]- where- InsertionSortSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) =>- InsertionSortSym0 a0123456789876543210- type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210- type family Leq (a :: Nat) (a :: Nat) :: Bool where- Leq 'Zero _ = TrueSym0- Leq ( 'Succ _) 'Zero = FalseSym0- Leq ( 'Succ a) ( 'Succ b) = Apply (Apply LeqSym0 a) b- type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where- Insert n '[] = Apply (Apply (:@#@$) n) '[]- Insert n ( '(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t)- type family InsertionSort (a :: [Nat]) :: [Nat] where- InsertionSort '[] = '[]- InsertionSort ( '(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t)- sLeq ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool)- sInsert ::- forall (t :: Nat) (t :: [Nat]).- Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat])- sInsertionSort ::- forall (t :: [Nat]).- Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat])- sLeq SZero _ = STrue- sLeq (SSucc _) SZero = SFalse- sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b))- = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB- sInsert (sN :: Sing n) SNil- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) SNil- sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t))- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t)- sScrutinee_0123456789876543210- = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sN)) sH- in (case sScrutinee_0123456789876543210 of- STrue- -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) sT)- SFalse- -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH))- ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN))- sT)) ::- Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) :: [Nat])- sInsertionSort SNil = SNil- sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t))- = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH))- ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT)- instance SingI (LeqSym0 :: (~>) Nat ((~>) Nat Bool)) where- sing = (singFun2 @LeqSym0) sLeq- instance SingI d =>- SingI (LeqSym1 (d :: Nat) :: (~>) Nat Bool) where- sing = (singFun1 @(LeqSym1 (d :: Nat))) (sLeq (sing @d))- instance SingI (InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])) where- sing = (singFun2 @InsertSym0) sInsert- instance SingI d =>- SingI (InsertSym1 (d :: Nat) :: (~>) [Nat] [Nat]) where- sing = (singFun1 @(InsertSym1 (d :: Nat))) (sInsert (sing @d))- instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where- sing = (singFun1 @InsertionSortSym0) sInsertionSort
− tests/compile-and-dump/InsertionSort/InsertionSortImp.hs
@@ -1,205 +0,0 @@-{- InsertionSortImp.hs--(c) Richard Eisenberg 2012-rae@cs.brynmawr.edu--This file contains an implementation of insertion sort over natural numbers,-along with a Haskell proof that the sort algorithm is correct. The code below-uses a combination of GADTs and class instances to record the progress and-result of the proof.--Ideally, the GADTs would be defined so that the constructors take no explicit-parameters --- the information would all be encoded in the constraints to the-constructors. However, due to the nature of the permutation relation, a class-instance definition corresponding to the constructor PermIns would require-existentially-quantified type variables (the l2 variable in the declaration of-PermIns). Type variables in an instance constraint but not mentioned in the-instance head are inherently ambiguous. The compiler would never be able to-infer the value of the variables. Thus, it is not possible to make a class-PermutationC analogous to PermutationProof in the way that AscendingC is-analogous to AscendingProof. (Note that it may be possible to fundamentally-rewrite the inductive definition of the permutation relation to avoid-existentially-quantified variables. We have not attempted that here.)--If there were a way to offer an explicit dictionary when satisfying a constraint,-this problem could be avoided, as the variable in question could be made-unambiguous.---}--{-# LANGUAGE IncoherentInstances, ConstraintKinds, TypeFamilies,- TemplateHaskell, RankNTypes, ScopedTypeVariables, GADTs,- TypeOperators, DataKinds, PolyKinds, MultiParamTypeClasses,- FlexibleContexts, FlexibleInstances, UndecidableInstances #-}--module InsertionSort.InsertionSortImp where--import Data.Kind (Type)-import Data.Singletons.Prelude-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH--data Dict c where- Dict :: c => Dict c---- Natural numbers, defined with singleton counterparts-$(singletons [d|- data Nat = Zero | Succ Nat- |])---- convenience functions for testing purposes-toNat :: Int -> Nat-toNat 0 = Zero-toNat n | n > 0 = Succ (toNat (n - 1))-toNat _ = error "Converting negative to Nat"--fromNat :: Nat -> Int-fromNat Zero = 0-fromNat (Succ n) = 1 + (fromNat n)---- A less-than-or-equal relation among naturals-class (a :: Nat) :<=: (b :: Nat)-instance Zero :<=: a-instance (a :<=: b) => (Succ a) :<=: (Succ b)---- A proof term asserting that a list of naturals is in ascending order-data AscendingProof :: [Nat] -> Type where- AscEmpty :: AscendingProof '[]- AscOne :: AscendingProof '[n]- AscCons :: (a :<=: b, AscendingC (b ': rest)) => AscendingProof (a ': b ': rest)---- The class constraint (implicit parameter definition) corresponding to--- AscendingProof-class AscendingC (lst :: [Nat]) where- ascendingProof :: AscendingProof lst---- The instances correspond to the constructors of AscendingProof-instance AscendingC '[] where- ascendingProof = AscEmpty-instance AscendingC '[n] where- ascendingProof = AscOne-instance (a :<=: b, AscendingC (b ': rest)) => AscendingC (a ': b ': rest) where- ascendingProof = AscCons---- A proof term asserting that l2 is the list produced when x is inserted--- (anywhere) into list l1-data InsertionProof (x :: k) (l1 :: [k]) (l2 :: [k]) where- InsHere :: InsertionProof x l (x ': l)- InsLater :: InsertionC x l1 l2 => InsertionProof x (y ': l1) (y ': l2)---- The class constraint corresponding to InsertionProof-class InsertionC (x :: k) (l1 :: [k]) (l2 :: [k]) where- insertionProof :: InsertionProof x l1 l2--instance InsertionC x l (x ': l) where- insertionProof = InsHere-instance InsertionC x l1 l2 => InsertionC x (y ': l1) (y ': l2) where- insertionProof = InsLater---- A proof term asserting that l1 and l2 are permutations of each other-data PermutationProof (l1 :: [k]) (l2 :: [k]) where- PermId :: PermutationProof l l- PermIns :: InsertionC x l2 l2' => PermutationProof l1 l2 ->- PermutationProof (x ': l1) l2'---- Here is the definition of insertion sort about which we will be reasoning:-$(singletons [d|- leq :: Nat -> Nat -> Bool- leq Zero _ = True- leq (Succ _) Zero = False- leq (Succ a) (Succ b) = leq a b-- insert :: Nat -> [Nat] -> [Nat]- insert n [] = [n]- insert n (h:t) = if leq n h then (n:h:t) else h:(insert n t)-- insertionSort :: [Nat] -> [Nat]- insertionSort [] = []- insertionSort (h:t) = insert h (insertionSort t)- |])---- A lemma that states if sLeq a b is STrue, then (a :<=: b)--- This is necessary to convert from the boolean definition of <= to the--- corresponding constraint-sLeq_true__le :: (Leq a b ~ True) => SNat a -> SNat b -> Dict (a :<=: b)-sLeq_true__le a b = case (a, b) of- (SZero, SZero) -> Dict- (SZero, SSucc _) -> Dict- -- (SSucc _, SZero) -> undefined <== IMPOSSIBLE- (SSucc a', SSucc b') -> case sLeq_true__le a' b' of- Dict -> Dict---- A lemma that states if sLeq a b is SFalse, then (b :<=: a)-sLeq_false__nle :: (Leq a b ~ False) => SNat a -> SNat b -> Dict (b :<=: a)-sLeq_false__nle a b = case (a, b) of- -- (SZero, SZero) -> undefined <== IMPOSSIBLE- -- (SZero, SSucc _) -> undefined <== IMPOSSIBLE- (SSucc _, SZero) -> Dict- (SSucc a', SSucc b') -> case sLeq_false__nle a' b' of- Dict -> Dict---- A lemma that states that inserting into an ascending list produces an--- ascending list-insert_ascending :: forall n lst.- AscendingC lst => SNat n -> SList lst -> Dict (AscendingC (Insert n lst))-insert_ascending n lst =- case ascendingProof :: AscendingProof lst of- AscEmpty -> Dict -- If lst is empty, then we're done- AscOne -> case lst of -- If lst has one element...- -- SNil -> undefined <== IMPOSSIBLE- SCons h _ -> case sLeq n h of -- then check if n is <= h- STrue -> case sLeq_true__le n h of Dict -> Dict -- if so, we're done- SFalse -> case sLeq_false__nle n h of Dict -> Dict -- if not, we're done- AscCons -> case lst of -- Otherwise, if lst is more than one element...- -- SNil -> undefined <== IMPOSSIBLE- SCons h t -> case sLeq n h of -- then check if n is <= h- STrue -> case sLeq_true__le n h of Dict -> Dict -- if so, we're done- SFalse -> case sLeq_false__nle n h of -- if not, things are harder...- Dict -> case t of -- destruct t: lst is (h : h2 : t2)- -- SNil -> undefined <== IMPOSSIBLE- SCons h2 _ -> case sLeq n h2 of -- is n <= h2?- STrue -> -- if so, we're done- case sLeq_true__le n h2 of Dict -> Dict- SFalse -> -- otherwise, show that (Insert n t) is sorted- case insert_ascending n t of Dict -> Dict -- and we're done---- A lemma that states that inserting n into lst produces a new list with n--- inserted into lst.-insert_insertion :: SNat n -> SList lst -> Dict (InsertionC n lst (Insert n lst))-insert_insertion n lst =- case lst of- SNil -> Dict -- if lst is empty, we're done- SCons h t -> case sLeq n h of -- otherwise, is n <= h?- STrue -> Dict -- if so, we're done- SFalse -> case insert_insertion n t of Dict -> Dict -- otherwise, recur---- A lemma that states that the result of an insertion sort is in ascending order-insertionSort_ascending :: SList lst -> Dict (AscendingC (InsertionSort lst))-insertionSort_ascending lst = case lst of- SNil -> Dict -- if the list is empty, we're done-- -- otherwise, we recur to find that insertionSort on t produces an ascending list,- -- and then we use the fact that inserting into an ascending list produces an- -- ascending list- SCons h t -> case insertionSort_ascending t of- Dict -> case insert_ascending h (sInsertionSort t) of Dict -> Dict---- A lemma that states that the result of an insertion sort is a permutation--- of its input-insertionSort_permutes :: SList lst -> PermutationProof lst (InsertionSort lst)-insertionSort_permutes lst = case lst of- SNil -> PermId -- if the list is empty, we're done-- -- otherwise, we wish to use PermIns. We must know that t is a permutation of- -- the insertion sort of t and that inserting h into the insertion sort of t- -- works correctly:- SCons h t ->- case insert_insertion h (sInsertionSort t) of- Dict -> PermIns (insertionSort_permutes t)---- A theorem that states that the insertion sort of a list is both ascending--- and a permutation of the original-insertionSort_correct :: SList lst -> (Dict (AscendingC (InsertionSort lst)),- PermutationProof lst (InsertionSort lst))-insertionSort_correct lst = (insertionSort_ascending lst,- insertionSort_permutes lst)
− tests/compile-and-dump/Promote/Constructors.ghc86.template
@@ -1,79 +0,0 @@-Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations- promote- [d| data Foo = Foo | Foo :+ Foo- data Bar = Bar Bar Bar Bar Bar Foo |]- ======>- data Foo = Foo | Foo :+ Foo- data Bar = Bar Bar Bar Bar Bar Foo- type FooSym0 = Foo- type (:+@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) =- (:+) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:+@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ())- data (:+@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo- where- (::+@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:+@#@$$) t0123456789876543210) arg) ((:+@#@$$$) t0123456789876543210 arg) =>- (:+@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:+@#@$$) t0123456789876543210) t0123456789876543210 = (:+) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (:+@#@$) where- suppressUnusedWarnings = snd (((,) (::+@#@$###)) ())- data (:+@#@$) :: (~>) Foo ((~>) Foo Foo)- where- (::+@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>- (:+@#@$) t0123456789876543210- type instance Apply (:+@#@$) t0123456789876543210 = (:+@#@$$) t0123456789876543210- type BarSym5 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Foo) =- Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BarSym4KindInference) ())- data BarSym4 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Foo Bar- where- BarSym4KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BarSym3KindInference) ())- data BarSym3 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar)- where- BarSym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BarSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BarSym2KindInference) ())- data BarSym2 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar))- where- BarSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BarSym2 t0123456789876543210 t0123456789876543210) arg) (BarSym3 t0123456789876543210 t0123456789876543210 arg) =>- BarSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BarSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BarSym1KindInference) ())- data BarSym1 (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))- where- BarSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) =>- BarSym1 t0123456789876543210 t0123456789876543210- type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))))- where- BarSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 t0123456789876543210- type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210
− tests/compile-and-dump/Promote/Constructors.hs
@@ -1,13 +0,0 @@-module Promote.Constructors where--import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH---- Tests defunctionalization symbol generation for :--- * infix constructors--- * constructors with arity > 2--$(promote [d|- data Foo = Foo | Foo :+ Foo- data Bar = Bar Bar Bar Bar Bar Foo- |])
− tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template
@@ -1,54 +0,0 @@-Promote/GenDefunSymbols.hs:0:0:: Splicing declarations- genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)]- ======>- type LiftMaybeSym2 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) =- LiftMaybe f0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings (LiftMaybeSym1 f0123456789876543210) where- suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ())- data LiftMaybeSym1 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)- where- LiftMaybeSym1KindInference :: forall f0123456789876543210- x0123456789876543210- arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 f0123456789876543210) arg) (LiftMaybeSym2 f0123456789876543210 arg) =>- LiftMaybeSym1 f0123456789876543210 x0123456789876543210- type instance Apply (LiftMaybeSym1 f0123456789876543210) x0123456789876543210 = LiftMaybe f0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings LiftMaybeSym0 where- suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ())- data LiftMaybeSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210))- where- LiftMaybeSym0KindInference :: forall f0123456789876543210- arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>- LiftMaybeSym0 f0123456789876543210- type instance Apply LiftMaybeSym0 f0123456789876543210 = LiftMaybeSym1 f0123456789876543210- type ZeroSym0 = 'Zero- type SuccSym1 (t0123456789876543210 :: NatT) =- 'Succ t0123456789876543210- instance SuppressUnusedWarnings SuccSym0 where- suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ())- data SuccSym0 :: (~>) NatT NatT- where- SuccSym0KindInference :: forall t0123456789876543210- arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>- SuccSym0 t0123456789876543210- type instance Apply SuccSym0 t0123456789876543210 = 'Succ t0123456789876543210- type (:+@#@$$$) (a0123456789876543210 :: Nat) (b0123456789876543210 :: Nat) =- (:+) a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ())- data (:+@#@$$) (a0123456789876543210 :: Nat) b0123456789876543210- where- (::+@#@$$###) :: forall a0123456789876543210- b0123456789876543210- arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) =>- (:+@#@$$) a0123456789876543210 b0123456789876543210- type instance Apply ((:+@#@$$) a0123456789876543210) b0123456789876543210 = (:+) a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings (:+@#@$) where- suppressUnusedWarnings = snd (((,) (::+@#@$###)) ())- data (:+@#@$) a0123456789876543210- where- (::+@#@$###) :: forall a0123456789876543210- arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>- (:+@#@$) a0123456789876543210- type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210
− tests/compile-and-dump/Promote/GenDefunSymbols.hs
@@ -1,17 +0,0 @@-module Promote.GenDefunSymbols where--import Data.Singletons (Apply, type (~>))-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH (genDefunSymbols)-import GHC.TypeLits hiding (type (*))-import Data.Kind (Type)--type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where- LiftMaybe f Nothing = Nothing- LiftMaybe f (Just a) = Just (Apply f a)--data NatT = Zero | Succ NatT--type a :+ b = a + b--$(genDefunSymbols [ ''LiftMaybe, ''NatT, ''(:+) ])
− tests/compile-and-dump/Promote/Newtypes.ghc86.template
@@ -1,48 +0,0 @@-Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations- promote- [d| newtype Foo- = Foo Nat- deriving Eq- newtype Bar = Bar {unBar :: Nat} |]- ======>- newtype Foo- = Foo Nat- deriving Eq- newtype Bar = Bar {unBar :: Nat}- type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where- Equals_0123456789876543210 (Foo a) (Foo b) = (==) a b- Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0- instance PEq Foo where- type (==) a b = Equals_0123456789876543210 a b- type UnBarSym1 (a0123456789876543210 :: Bar) =- UnBar a0123456789876543210- instance SuppressUnusedWarnings UnBarSym0 where- suppressUnusedWarnings = snd (((,) UnBarSym0KindInference) ())- data UnBarSym0 :: (~>) Bar Nat- where- UnBarSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) =>- UnBarSym0 a0123456789876543210- type instance Apply UnBarSym0 a0123456789876543210 = UnBar a0123456789876543210- type family UnBar (a :: Bar) :: Nat where- UnBar (Bar field) = field- type FooSym1 (t0123456789876543210 :: Nat) =- Foo t0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) Nat Foo- where- FooSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 t0123456789876543210- type instance Apply FooSym0 t0123456789876543210 = Foo t0123456789876543210- type BarSym1 (t0123456789876543210 :: Nat) =- Bar t0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) Nat Bar- where- BarSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 t0123456789876543210- type instance Apply BarSym0 t0123456789876543210 = Bar t0123456789876543210
− tests/compile-and-dump/Promote/Newtypes.hs
@@ -1,10 +0,0 @@-module Promote.Newtypes where--import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Singletons.Nat--$(promote [d|- newtype Foo = Foo Nat deriving (Eq)- newtype Bar = Bar { unBar :: Nat }- |])
− tests/compile-and-dump/Promote/Pragmas.ghc86.template
@@ -1,12 +0,0 @@-Promote/Pragmas.hs:(0,0)-(0,0): Splicing declarations- promote- [d| {-# INLINE foo #-}- foo :: Bool- foo = True |]- ======>- {-# INLINE foo #-}- foo :: Bool- foo = True- type FooSym0 = Foo- type family Foo :: Bool where- Foo = TrueSym0
− tests/compile-and-dump/Promote/Pragmas.hs
@@ -1,10 +0,0 @@-module Promote.Pragmas where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(promote [d|- {-# INLINE foo #-}- foo :: Bool- foo = True- |])
− tests/compile-and-dump/Promote/Prelude.ghc86.template
@@ -1,19 +0,0 @@-Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations- promoteOnly- [d| odd :: Nat -> Bool- odd 0 = False- odd n = not . odd $ n - 1 |]- ======>- type OddSym1 (a0123456789876543210 :: Nat) =- Odd a0123456789876543210- instance SuppressUnusedWarnings OddSym0 where- suppressUnusedWarnings = snd (((,) OddSym0KindInference) ())- data OddSym0 :: (~>) Nat Bool- where- OddSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply OddSym0 arg) (OddSym1 arg) =>- OddSym0 a0123456789876543210- type instance Apply OddSym0 a0123456789876543210 = Odd a0123456789876543210- type family Odd (a :: Nat) :: Bool where- Odd 0 = FalseSym0- Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1))
− tests/compile-and-dump/Promote/Prelude.hs
@@ -1,132 +0,0 @@-module Promote.Prelude where--import Data.Singletons.TH-import Data.Singletons.Prelude-import Data.Singletons.Prelude.List-import GHC.TypeLits--lengthTest1a :: Proxy (Length '[True, True, True, True])-lengthTest1a = Proxy--lengthTest1b :: Proxy 4-lengthTest1b = lengthTest1a--lengthTest2a :: Proxy (Length '[])-lengthTest2a = Proxy--lengthTest2b :: Proxy 0-lengthTest2b = lengthTest2a--sumTest1a :: Proxy (Sum '[1, 2, 3, 4])-sumTest1a = Proxy--sumTest1b :: Proxy 10-sumTest1b = sumTest1a--sumTest2a :: Proxy (Sum '[])-sumTest2a = Proxy--sumTest2b :: Proxy 0-sumTest2b = sumTest2a--productTest1a :: Proxy (Product '[1, 2, 3, 4])-productTest1a = Proxy--productTest1b :: Proxy 24-productTest1b = productTest1a--productTest2a :: Proxy (Product '[])-productTest2a = Proxy--productTest2b :: Proxy 1-productTest2b = productTest2a--takeTest1a :: Proxy (Take 2 '[1, 2, 3, 4])-takeTest1a = Proxy--takeTest1b :: Proxy '[1, 2]-takeTest1b = takeTest1a--takeTest2a :: Proxy (Take 2 '[])-takeTest2a = Proxy--takeTest2b :: Proxy '[]-takeTest2b = takeTest2a--dropTest1a :: Proxy (Drop 2 '[1, 2, 3, 4])-dropTest1a = Proxy--dropTest1b :: Proxy '[3, 4]-dropTest1b = dropTest1a--dropTest2a :: Proxy (Drop 2 '[])-dropTest2a = Proxy--dropTest2b :: Proxy '[]-dropTest2b = dropTest2a--splitAtTest1a :: Proxy (SplitAt 2 '[1, 2, 3, 4])-splitAtTest1a = Proxy--splitAtTest1b :: Proxy ( '( '[1,2], '[3, 4] ) )-splitAtTest1b = splitAtTest1a--splitAtTest2a :: Proxy (SplitAt 2 '[])-splitAtTest2a = splitAtTest2b--splitAtTest2b :: Proxy ( '( '[], '[] ) )-splitAtTest2b = Proxy--indexingTest1a :: Proxy ('[4, 3, 2, 1] !! 1)-indexingTest1a = Proxy--indexingTest1b :: Proxy 3-indexingTest1b = indexingTest1a--indexingTest2a :: Proxy ('[] !! 0)-indexingTest2a = Proxy--indexingTest2b :: Proxy (Error "Data.Singletons.List.!!: index too large")-indexingTest2b = indexingTest2a--replicateTest1a :: Proxy (Replicate 2 True)-replicateTest1a = Proxy--replicateTest1b :: Proxy '[True, True]-replicateTest1b = replicateTest1a--replicateTest2a :: Proxy (Replicate 0 True)-replicateTest2a = replicateTest2b--replicateTest2b :: Proxy '[]-replicateTest2b = Proxy--$(promoteOnly [d|- odd :: Nat -> Bool- odd 0 = False- odd n = not . odd $ n - 1- |])--findIndexTest1a :: Proxy (FindIndex OddSym0 '[2,4,6,7])-findIndexTest1a = Proxy--findIndexTest1b :: Proxy (Just 3)-findIndexTest1b = findIndexTest1a--findIndicesTest1a :: Proxy (FindIndices OddSym0 '[1,3,5,2,4,6,7])-findIndicesTest1a = Proxy--findIndicesTest1b :: Proxy '[0,1,2,6]-findIndicesTest1b = findIndicesTest1a--transposeTest1a :: Proxy (Transpose '[[1,2,3]])-transposeTest1a = Proxy--transposeTest1b :: Proxy ('[ '[1], '[2], '[3]])-transposeTest1b = transposeTest1a--transposeTest2a :: Proxy (Transpose '[ '[1], '[2], '[3]])-transposeTest2a = Proxy--transposeTest2b :: Proxy ('[ '[1,2,3]])-transposeTest2b = transposeTest2a
− tests/compile-and-dump/Promote/T180.ghc86.template
@@ -1,54 +0,0 @@-Promote/T180.hs:(0,0)-(0,0): Splicing declarations- promote- [d| z (X1 x) = x- z (X2 x) = x- - data X = X1 {y :: Symbol} | X2 {y :: Symbol} |]- ======>- data X = X1 {y :: Symbol} | X2 {y :: Symbol}- z (X1 x) = x- z (X2 x) = x- type ZSym1 a0123456789876543210 = Z a0123456789876543210- instance SuppressUnusedWarnings ZSym0 where- suppressUnusedWarnings = snd (((,) ZSym0KindInference) ())- data ZSym0 a0123456789876543210- where- ZSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) =>- ZSym0 a0123456789876543210- type instance Apply ZSym0 a0123456789876543210 = Z a0123456789876543210- type family Z a where- Z (X1 x) = x- Z (X2 x) = x- type YSym1 (a0123456789876543210 :: X) = Y a0123456789876543210- instance SuppressUnusedWarnings YSym0 where- suppressUnusedWarnings = snd (((,) YSym0KindInference) ())- data YSym0 :: (~>) X Symbol- where- YSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply YSym0 arg) (YSym1 arg) =>- YSym0 a0123456789876543210- type instance Apply YSym0 a0123456789876543210 = Y a0123456789876543210- type family Y (a :: X) :: Symbol where- Y (X1 field) = field- Y (X2 field) = field- type X1Sym1 (t0123456789876543210 :: Symbol) =- X1 t0123456789876543210- instance SuppressUnusedWarnings X1Sym0 where- suppressUnusedWarnings = snd (((,) X1Sym0KindInference) ())- data X1Sym0 :: (~>) Symbol X- where- X1Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) =>- X1Sym0 t0123456789876543210- type instance Apply X1Sym0 t0123456789876543210 = X1 t0123456789876543210- type X2Sym1 (t0123456789876543210 :: Symbol) =- X2 t0123456789876543210- instance SuppressUnusedWarnings X2Sym0 where- suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ())- data X2Sym0 :: (~>) Symbol X- where- X2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) =>- X2Sym0 t0123456789876543210- type instance Apply X2Sym0 t0123456789876543210 = X2 t0123456789876543210
− tests/compile-and-dump/Promote/T180.hs
@@ -1,10 +0,0 @@-module T180 where--import Data.Singletons.TH-import Data.Singletons.Prelude--promote [d|- data X = X1 {y :: Symbol} | X2 {y :: Symbol}- z (X1 x) = x- z (X2 x) = x- |]
− tests/compile-and-dump/Promote/T361.ghc86.template
@@ -1,21 +0,0 @@-Promote/T361.hs:0:0:: Splicing declarations- genDefunSymbols [''Proxy] ======> type ProxySym0 = 'Proxy-Promote/T361.hs:(0,0)-(0,0): Splicing declarations- promote- [d| f :: Proxy 1 -> Proxy 2- f Proxy = Proxy |]- ======>- f :: Proxy 1 -> Proxy 2- f Proxy = Proxy- type FSym1 (a0123456789876543210 :: Proxy 1) =- F a0123456789876543210- instance SuppressUnusedWarnings FSym0 where- suppressUnusedWarnings = snd (((,) FSym0KindInference) ())- data FSym0 :: (~>) (Proxy 1) (Proxy 2)- where- FSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>- FSym0 a0123456789876543210- type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210- type family F (a :: Proxy 1) :: Proxy 2 where- F 'Proxy = ProxySym0
− tests/compile-and-dump/Promote/T361.hs
@@ -1,11 +0,0 @@-module T361 where--import Data.Proxy-import Data.Singletons.TH--$(genDefunSymbols [''Proxy])--$(promote [d|- f :: Proxy 1 -> Proxy 2- f Proxy = Proxy- |])
− tests/compile-and-dump/Singletons/AsPattern.ghc86.template
@@ -1,405 +0,0 @@-Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| maybePlus :: Maybe Nat -> Maybe Nat- maybePlus (Just n) = Just (plus (Succ Zero) n)- maybePlus p@Nothing = p- bar :: Maybe Nat -> Maybe Nat- bar x@(Just _) = x- bar Nothing = Nothing- baz_ :: Maybe Baz -> Maybe Baz- baz_ p@Nothing = p- baz_ p@(Just (Baz _ _ _)) = p- tup :: (Nat, Nat) -> (Nat, Nat)- tup p@(_, _) = p- foo :: [Nat] -> [Nat]- foo p@[] = p- foo p@[_] = p- foo p@(_ : _ : _) = p- - data Baz = Baz Nat Nat Nat |]- ======>- maybePlus :: Maybe Nat -> Maybe Nat- maybePlus (Just n) = Just ((plus (Succ Zero)) n)- maybePlus p@Nothing = p- bar :: Maybe Nat -> Maybe Nat- bar x@(Just _) = x- bar Nothing = Nothing- data Baz = Baz Nat Nat Nat- baz_ :: Maybe Baz -> Maybe Baz- baz_ p@Nothing = p- baz_ p@(Just (Baz _ _ _)) = p- tup :: (Nat, Nat) -> (Nat, Nat)- tup p@(_, _) = p- foo :: [Nat] -> [Nat]- foo p@[] = p- foo p@[_] = p- foo p@(_ : (_ : _)) = p- type BazSym3 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) =- Baz t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BazSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BazSym2KindInference) ())- data BazSym2 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) :: (~>) Nat Baz- where- BazSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BazSym2 t0123456789876543210 t0123456789876543210) arg) (BazSym3 t0123456789876543210 t0123456789876543210 arg) =>- BazSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BazSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Baz t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BazSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BazSym1KindInference) ())- data BazSym1 (t0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz)- where- BazSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BazSym1 t0123456789876543210) arg) (BazSym2 t0123456789876543210 arg) =>- BazSym1 t0123456789876543210 t0123456789876543210- type instance Apply (BazSym1 t0123456789876543210) t0123456789876543210 = BazSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings BazSym0 where- suppressUnusedWarnings = snd (((,) BazSym0KindInference) ())- data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))- where- BazSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) =>- BazSym0 t0123456789876543210- type instance Apply BazSym0 t0123456789876543210 = BazSym1 t0123456789876543210- type Let0123456789876543210PSym0 = Let0123456789876543210P- type family Let0123456789876543210P where- Let0123456789876543210P = '[]- type Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 =- Let0123456789876543210P wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210PSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym0KindInference) ())- data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>- Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210- type family Let0123456789876543210P wild_0123456789876543210 where- Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[]- type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 =- Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym2KindInference) ())- data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym1KindInference) ())- data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210PSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym0KindInference) ())- data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>- Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210- type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where- Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210)- type Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 =- Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym1KindInference) ())- data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210PSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym0KindInference) ())- data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>- Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210- type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where- Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210- type Let0123456789876543210PSym0 = Let0123456789876543210P- type family Let0123456789876543210P where- Let0123456789876543210P = NothingSym0- type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 =- Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym2KindInference) ())- data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym1KindInference) ())- data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210- wild_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210PSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210PSym0KindInference) ())- data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>- Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210- type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where- Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210)- type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 =- Let0123456789876543210X wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210XSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210XSym0KindInference) ())- data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) =>- Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210- type family Let0123456789876543210X wild_0123456789876543210 where- Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210- type Let0123456789876543210PSym0 = Let0123456789876543210P- type family Let0123456789876543210P where- Let0123456789876543210P = NothingSym0- type FooSym1 (a0123456789876543210 :: [Nat]) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) [Nat] [Nat]- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type TupSym1 (a0123456789876543210 :: (Nat, Nat)) =- Tup a0123456789876543210- instance SuppressUnusedWarnings TupSym0 where- suppressUnusedWarnings = snd (((,) TupSym0KindInference) ())- data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)- where- TupSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) =>- TupSym0 a0123456789876543210- type instance Apply TupSym0 a0123456789876543210 = Tup a0123456789876543210- type Baz_Sym1 (a0123456789876543210 :: Maybe Baz) =- Baz_ a0123456789876543210- instance SuppressUnusedWarnings Baz_Sym0 where- suppressUnusedWarnings = snd (((,) Baz_Sym0KindInference) ())- data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)- where- Baz_Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) =>- Baz_Sym0 a0123456789876543210- type instance Apply Baz_Sym0 a0123456789876543210 = Baz_ a0123456789876543210- type BarSym1 (a0123456789876543210 :: Maybe Nat) =- Bar a0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)- where- BarSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 a0123456789876543210- type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210- type MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) =- MaybePlus a0123456789876543210- instance SuppressUnusedWarnings MaybePlusSym0 where- suppressUnusedWarnings = snd (((,) MaybePlusSym0KindInference) ())- data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)- where- MaybePlusSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) =>- MaybePlusSym0 a0123456789876543210- type instance Apply MaybePlusSym0 a0123456789876543210 = MaybePlus a0123456789876543210- type family Foo (a :: [Nat]) :: [Nat] where- Foo '[] = Let0123456789876543210PSym0- Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210- Foo ( '(:) wild_0123456789876543210 ( '(:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210- type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where- Tup '(wild_0123456789876543210,- wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210- type family Baz_ (a :: Maybe Baz) :: Maybe Baz where- Baz_ 'Nothing = Let0123456789876543210PSym0- Baz_ ( 'Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210- type family Bar (a :: Maybe Nat) :: Maybe Nat where- Bar ( 'Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210- Bar 'Nothing = NothingSym0- type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where- MaybePlus ( 'Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n)- MaybePlus 'Nothing = Let0123456789876543210PSym0- sFoo ::- forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat])- sTup ::- forall (t :: (Nat, Nat)).- Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat))- sBaz_ ::- forall (t :: Maybe Baz).- Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz)- sBar ::- forall (t :: Maybe Nat).- Sing t -> Sing (Apply BarSym0 t :: Maybe Nat)- sMaybePlus ::- forall (t :: Maybe Nat).- Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat)- sFoo SNil- = let- sP :: Sing Let0123456789876543210PSym0- sP = SNil- in sP- sFoo- (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- SNil)- = let- sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210)- sP- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- sWild_0123456789876543210))- SNil- in sP- sFoo- (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- (sWild_0123456789876543210 :: Sing wild_0123456789876543210)))- = let- sP ::- Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)- sP- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- sWild_0123456789876543210))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- sWild_0123456789876543210))- sWild_0123456789876543210)- in sP- sTup- (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- (sWild_0123456789876543210 :: Sing wild_0123456789876543210))- = let- sP ::- Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210)- sP- = (applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2))- sWild_0123456789876543210))- sWild_0123456789876543210- in sP- sBaz_ SNothing- = let- sP :: Sing Let0123456789876543210PSym0- sP = SNothing- in sP- sBaz_- (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- (sWild_0123456789876543210 :: Sing wild_0123456789876543210)))- = let- sP ::- Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)- sP- = (applySing ((singFun1 @JustSym0) SJust))- ((applySing- ((applySing- ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210))- sWild_0123456789876543210))- sWild_0123456789876543210)- in sP- sBar- (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210))- = let- sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210)- sX- = (applySing ((singFun1 @JustSym0) SJust))- sWild_0123456789876543210- in sX- sBar SNothing = SNothing- sMaybePlus (SJust (sN :: Sing n))- = (applySing ((singFun1 @JustSym0) SJust))- ((applySing- ((applySing ((singFun2 @PlusSym0) sPlus))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- sN)- sMaybePlus SNothing- = let- sP :: Sing Let0123456789876543210PSym0- sP = SNothing- in sP- instance SingI (FooSym0 :: (~>) [Nat] [Nat]) where- sing = (singFun1 @FooSym0) sFoo- instance SingI (TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)) where- sing = (singFun1 @TupSym0) sTup- instance SingI (Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)) where- sing = (singFun1 @Baz_Sym0) sBaz_- instance SingI (BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where- sing = (singFun1 @BarSym0) sBar- instance SingI (MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where- sing = (singFun1 @MaybePlusSym0) sMaybePlus- data instance Sing :: Baz -> GHC.Types.Type- where- SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat).- (Sing (n :: Nat))- -> (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> Sing (Baz n n n)- type SBaz = (Sing :: Baz -> GHC.Types.Type)- instance SingKind Baz where- type Demote Baz = Baz- fromSing (SBaz b b b)- = ((Baz (fromSing b)) (fromSing b)) (fromSing b)- toSing (Baz (b :: Demote Nat) (b :: Demote Nat) (b :: Demote Nat))- = case- (((,,) (toSing b :: SomeSing Nat)) (toSing b :: SomeSing Nat))- (toSing b :: SomeSing Nat)- of {- (,,) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing (((SBaz c) c) c) }- instance (SingI n, SingI n, SingI n) =>- SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where- sing = ((SBaz sing) sing) sing- instance SingI (BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where- sing = (singFun3 @BazSym0) SBaz- instance SingI (TyCon3 Baz :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where- sing = (singFun3 @(TyCon3 Baz)) SBaz- instance SingI d =>- SingI (BazSym1 (d :: Nat) :: (~>) Nat ((~>) Nat Baz)) where- sing = (singFun2 @(BazSym1 (d :: Nat))) (SBaz (sing @d))- instance SingI d =>- SingI (TyCon2 (Baz (d :: Nat)) :: (~>) Nat ((~>) Nat Baz)) where- sing = (singFun2 @(TyCon2 (Baz (d :: Nat)))) (SBaz (sing @d))- instance (SingI d, SingI d) =>- SingI (BazSym2 (d :: Nat) (d :: Nat) :: (~>) Nat Baz) where- sing- = (singFun1 @(BazSym2 (d :: Nat) (d :: Nat)))- ((SBaz (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon1 (Baz (d :: Nat) (d :: Nat)) :: (~>) Nat Baz) where- sing- = (singFun1 @(TyCon1 (Baz (d :: Nat) (d :: Nat))))- ((SBaz (sing @d)) (sing @d))
− tests/compile-and-dump/Singletons/AsPattern.hs
@@ -1,32 +0,0 @@-module Singletons.AsPattern where--import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.List-import Singletons.Nat-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- maybePlus :: Maybe Nat -> Maybe Nat- maybePlus (Just n) = Just (plus (Succ Zero) n)- maybePlus p@Nothing = p-- bar :: Maybe Nat -> Maybe Nat- bar x@(Just _) = x- bar Nothing = Nothing-- data Baz = Baz Nat Nat Nat-- baz_ :: Maybe Baz -> Maybe Baz- baz_ p@Nothing = p- baz_ p@(Just (Baz _ _ _)) = p-- tup :: (Nat, Nat) -> (Nat, Nat)- tup p@(_, _) = p-- foo :: [Nat] -> [Nat]- foo p@[] = p- foo p@[_] = p- foo p@(_:_:_) = p- |])
− tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.template
@@ -1,6 +0,0 @@--Singletons/BadBoundedDeriving.hs:0:0: error:- Can't derive Bounded instance for Foo_0 a_1.- |-5 | $(singletons [d|- | ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/BadBoundedDeriving.hs
@@ -1,7 +0,0 @@-module Singletons.BadBoundedDeriving where--import Data.Singletons.TH--$(singletons [d|- data Foo a = Foo | Bar a deriving (Bounded)- |])
− tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.template
@@ -1,6 +0,0 @@--Singletons/BadEnumDeriving.hs:0:0: error:- Can't derive Enum instance for Foo_0 a_1.- |-5 | $(singletons [d|- | ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/BadEnumDeriving.hs
@@ -1,8 +0,0 @@-module Singletons.BadEnumDeriving where--import Data.Singletons.TH--$(singletons [d|- data Foo a = Foo a- deriving Enum- |])
− tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template
@@ -1,249 +0,0 @@-Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Foo1- = Foo1- deriving Bounded- data Foo2- = A | B | C | D | E- deriving Bounded- data Foo3 a- = Foo3 a- deriving Bounded- data Foo4 (a :: Type) (b :: Type)- = Foo41 | Foo42- deriving Bounded- data Pair- = Pair Bool Bool- deriving Bounded |]- ======>- data Foo1- = Foo1- deriving Bounded- data Foo2- = A | B | C | D | E- deriving Bounded- data Foo3 a- = Foo3 a- deriving Bounded- data Foo4 (a :: Type) (b :: Type)- = Foo41 | Foo42- deriving Bounded- data Pair- = Pair Bool Bool- deriving Bounded- type Foo1Sym0 = Foo1- type ASym0 = A- type BSym0 = B- type CSym0 = C- type DSym0 = D- type ESym0 = E- type Foo3Sym1 (t0123456789876543210 :: a0123456789876543210) =- Foo3 t0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 (Foo3 a0123456789876543210)- where- Foo3Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 t0123456789876543210- type instance Apply Foo3Sym0 t0123456789876543210 = Foo3 t0123456789876543210- type Foo41Sym0 = Foo41- type Foo42Sym0 = Foo42- type PairSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) =- Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) PairSym1KindInference) ())- data PairSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Pair- where- PairSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) =>- PairSym1 t0123456789876543210 t0123456789876543210- type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings PairSym0 where- suppressUnusedWarnings = snd (((,) PairSym0KindInference) ())- data PairSym0 :: (~>) Bool ((~>) Bool Pair)- where- PairSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>- PairSym0 t0123456789876543210- type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210- type family MinBound_0123456789876543210 :: Foo1 where- MinBound_0123456789876543210 = Foo1Sym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: Foo1 where- MaxBound_0123456789876543210 = Foo1Sym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded Foo1 where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family MinBound_0123456789876543210 :: Foo2 where- MinBound_0123456789876543210 = ASym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: Foo2 where- MaxBound_0123456789876543210 = ESym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded Foo2 where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family MinBound_0123456789876543210 :: Foo3 a where- MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: Foo3 a where- MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded (Foo3 a) where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family MinBound_0123456789876543210 :: Foo4 a b where- MinBound_0123456789876543210 = Foo41Sym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: Foo4 a b where- MaxBound_0123456789876543210 = Foo42Sym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded (Foo4 a b) where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family MinBound_0123456789876543210 :: Pair where- MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: Pair where- MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded Pair where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- data instance Sing :: Foo1 -> Type where SFoo1 :: Sing Foo1- type SFoo1 = (Sing :: Foo1 -> Type)- instance SingKind Foo1 where- type Demote Foo1 = Foo1- fromSing SFoo1 = Foo1- toSing Foo1 = SomeSing SFoo1- data instance Sing :: Foo2 -> Type- where- SA :: Sing A- SB :: Sing B- SC :: Sing C- SD :: Sing D- SE :: Sing E- type SFoo2 = (Sing :: Foo2 -> Type)- instance SingKind Foo2 where- type Demote Foo2 = Foo2- fromSing SA = A- fromSing SB = B- fromSing SC = C- fromSing SD = D- fromSing SE = E- toSing A = SomeSing SA- toSing B = SomeSing SB- toSing C = SomeSing SC- toSing D = SomeSing SD- toSing E = SomeSing SE- data instance Sing :: Foo3 a -> Type- where SFoo3 :: forall a (n :: a). (Sing (n :: a)) -> Sing (Foo3 n)- type SFoo3 = (Sing :: Foo3 a -> Type)- instance SingKind a => SingKind (Foo3 a) where- type Demote (Foo3 a) = Foo3 (Demote a)- fromSing (SFoo3 b) = Foo3 (fromSing b)- toSing (Foo3 (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SFoo3 c) }- data instance Sing :: Foo4 a b -> Type- where- SFoo41 :: Sing Foo41- SFoo42 :: Sing Foo42- type SFoo4 = (Sing :: Foo4 a b -> Type)- instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where- type Demote (Foo4 a b) = Foo4 (Demote a) (Demote b)- fromSing SFoo41 = Foo41- fromSing SFoo42 = Foo42- toSing Foo41 = SomeSing SFoo41- toSing Foo42 = SomeSing SFoo42- data instance Sing :: Pair -> Type- where- SPair :: forall (n :: Bool) (n :: Bool).- (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Pair n n)- type SPair = (Sing :: Pair -> Type)- instance SingKind Pair where- type Demote Pair = Pair- fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b)- toSing (Pair (b :: Demote Bool) (b :: Demote Bool))- = case- ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) }- instance SBounded Foo1 where- sMinBound :: Sing (MinBoundSym0 :: Foo1)- sMaxBound :: Sing (MaxBoundSym0 :: Foo1)- sMinBound = SFoo1- sMaxBound = SFoo1- instance SBounded Foo2 where- sMinBound :: Sing (MinBoundSym0 :: Foo2)- sMaxBound :: Sing (MaxBoundSym0 :: Foo2)- sMinBound = SA- sMaxBound = SE- instance SBounded a => SBounded (Foo3 a) where- sMinBound :: Sing (MinBoundSym0 :: Foo3 a)- sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a)- sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound- sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound- instance SBounded (Foo4 a b) where- sMinBound :: Sing (MinBoundSym0 :: Foo4 a b)- sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b)- sMinBound = SFoo41- sMaxBound = SFoo42- instance SBounded Bool => SBounded Pair where- sMinBound :: Sing (MinBoundSym0 :: Pair)- sMaxBound :: Sing (MaxBoundSym0 :: Pair)- sMinBound- = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound))- sMinBound- sMaxBound- = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound))- sMaxBound- instance SingI Foo1 where- sing = SFoo1- instance SingI A where- sing = SA- instance SingI B where- sing = SB- instance SingI C where- sing = SC- instance SingI D where- sing = SD- instance SingI E where- sing = SE- instance SingI n => SingI (Foo3 (n :: a)) where- sing = SFoo3 sing- instance SingI (Foo3Sym0 :: (~>) a (Foo3 a)) where- sing = (singFun1 @Foo3Sym0) SFoo3- instance SingI (TyCon1 Foo3 :: (~>) a (Foo3 a)) where- sing = (singFun1 @(TyCon1 Foo3)) SFoo3- instance SingI Foo41 where- sing = SFoo41- instance SingI Foo42 where- sing = SFoo42- instance (SingI n, SingI n) =>- SingI (Pair (n :: Bool) (n :: Bool)) where- sing = (SPair sing) sing- instance SingI (PairSym0 :: (~>) Bool ((~>) Bool Pair)) where- sing = (singFun2 @PairSym0) SPair- instance SingI (TyCon2 Pair :: (~>) Bool ((~>) Bool Pair)) where- sing = (singFun2 @(TyCon2 Pair)) SPair- instance SingI d =>- SingI (PairSym1 (d :: Bool) :: (~>) Bool Pair) where- sing = (singFun1 @(PairSym1 (d :: Bool))) (SPair (sing @d))- instance SingI d =>- SingI (TyCon1 (Pair (d :: Bool)) :: (~>) Bool Pair) where- sing = (singFun1 @(TyCon1 (Pair (d :: Bool)))) (SPair (sing @d))
− tests/compile-and-dump/Singletons/BoundedDeriving.hs
@@ -1,52 +0,0 @@-module Singletons.BoundedDeriving where--import Data.Singletons.Prelude-import Data.Singletons.TH-import Data.Kind (Type)--$(singletons [d|- data Foo1 = Foo1 deriving (Bounded)- data Foo2 = A | B | C | D | E deriving (Bounded)- data Foo3 a = Foo3 a deriving (Bounded)- data Foo4 (a :: Type) (b :: Type) = Foo41 | Foo42 deriving Bounded-- data Pair = Pair Bool Bool- deriving Bounded-- |])--foo1a :: Proxy (MinBound :: Foo1)-foo1a = Proxy--foo1b :: Proxy 'Foo1-foo1b = foo1a--foo1c :: Proxy (MaxBound :: Foo1)-foo1c = Proxy--foo1d :: Proxy 'Foo1-foo1d = foo1c--foo2a :: Proxy (MinBound :: Foo2)-foo2a = Proxy--foo2b :: Proxy 'A-foo2b = foo2a--foo2c :: Proxy (MaxBound :: Foo2)-foo2c = Proxy--foo2d :: Proxy 'E-foo2d = foo2c--foo3a :: Proxy (MinBound :: Foo3 Bool)-foo3a = Proxy--foo3b :: Proxy ('Foo3 False)-foo3b = foo3a--foo3c :: Proxy (MaxBound :: Foo3 Bool)-foo3c = Proxy--foo3d :: Proxy ('Foo3 True)-foo3d = foo3c
− tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template
@@ -1,54 +0,0 @@-Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| unBox :: Box a -> a- unBox (FBox a) = a- - data Box a = FBox a |]- ======>- data Box a = FBox a- unBox :: Box a -> a- unBox (FBox a) = a- type FBoxSym1 (t0123456789876543210 :: a0123456789876543210) =- FBox t0123456789876543210- instance SuppressUnusedWarnings FBoxSym0 where- suppressUnusedWarnings = snd (((,) FBoxSym0KindInference) ())- data FBoxSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 (Box a0123456789876543210)- where- FBoxSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) =>- FBoxSym0 t0123456789876543210- type instance Apply FBoxSym0 t0123456789876543210 = FBox t0123456789876543210- type UnBoxSym1 (a0123456789876543210 :: Box a0123456789876543210) =- UnBox a0123456789876543210- instance SuppressUnusedWarnings UnBoxSym0 where- suppressUnusedWarnings = snd (((,) UnBoxSym0KindInference) ())- data UnBoxSym0 :: forall a0123456789876543210.- (~>) (Box a0123456789876543210) a0123456789876543210- where- UnBoxSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) =>- UnBoxSym0 a0123456789876543210- type instance Apply UnBoxSym0 a0123456789876543210 = UnBox a0123456789876543210- type family UnBox (a :: Box a) :: a where- UnBox (FBox a) = a- sUnBox ::- forall a (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a)- sUnBox (SFBox (sA :: Sing a)) = sA- instance SingI (UnBoxSym0 :: (~>) (Box a) a) where- sing = (singFun1 @UnBoxSym0) sUnBox- data instance Sing :: Box a -> GHC.Types.Type- where SFBox :: forall a (n :: a). (Sing (n :: a)) -> Sing (FBox n)- type SBox = (Sing :: Box a -> GHC.Types.Type)- instance SingKind a => SingKind (Box a) where- type Demote (Box a) = Box (Demote a)- fromSing (SFBox b) = FBox (fromSing b)- toSing (FBox (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SFBox c) }- instance SingI n => SingI (FBox (n :: a)) where- sing = SFBox sing- instance SingI (FBoxSym0 :: (~>) a (Box a)) where- sing = (singFun1 @FBoxSym0) SFBox- instance SingI (TyCon1 FBox :: (~>) a (Box a)) where- sing = (singFun1 @(TyCon1 FBox)) SFBox
− tests/compile-and-dump/Singletons/BoxUnBox.hs
@@ -1,10 +0,0 @@-module Singletons.BoxUnBox where--import Data.Singletons.TH-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- data Box a = FBox a- unBox :: Box a -> a- unBox (FBox a) = a- |])
− tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template
@@ -1,319 +0,0 @@-Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo1 :: a -> Maybe a -> a- foo1 d x- = case x of- Just y -> y- Nothing -> d- foo2 :: a -> Maybe a -> a- foo2 d _ = case (Just d) of { Just y -> y }- foo3 :: a -> b -> a- foo3 a b = case (a, b) of { (p, _) -> p }- foo4 :: forall a. a -> a- foo4 x- = case x of {- y -> let- z :: a- z = y- in z }- foo5 :: a -> a- foo5 x = case x of { y -> (\ _ -> x) y } |]- ======>- foo1 :: a -> Maybe a -> a- foo1 d x- = case x of- Just y -> y- Nothing -> d- foo2 :: a -> Maybe a -> a- foo2 d _ = case Just d of { Just y -> y }- foo3 :: a -> b -> a- foo3 a b = case (a, b) of { (p, _) -> p }- foo4 :: forall a. a -> a- foo4 x- = case x of {- y -> let- z :: a- z = y- in z }- foo5 :: a -> a- foo5 x = case x of { y -> (\ _ -> x) y }- type family Case_0123456789876543210 x y arg_0123456789876543210 t where- Case_0123456789876543210 x y arg_0123456789876543210 _ = x- type family Lambda_0123456789876543210 x y t where- Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y- type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 =- Let0123456789876543210Z x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym1KindInference) ())- data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210- where- Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) =>- Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210- type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210- type family Let0123456789876543210Z x y :: a where- Let0123456789876543210Z x y = y- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y- type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall a0123456789876543210- b0123456789876543210- arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 a b where- Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b- type family Case_0123456789876543210 a b t where- Case_0123456789876543210 a b '(p, _) = p- type Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall d0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 d where- Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d- type family Case_0123456789876543210 d t where- Case_0123456789876543210 d ( 'Just y) = y- type family Case_0123456789876543210 d x t where- Case_0123456789876543210 d x ( 'Just y) = y- Case_0123456789876543210 d x 'Nothing = d- type Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo5 a0123456789876543210- instance SuppressUnusedWarnings Foo5Sym0 where- suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ())- data Foo5Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo5Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>- Foo5Sym0 a0123456789876543210- type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210- type Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo4 a0123456789876543210- instance SuppressUnusedWarnings Foo4Sym0 where- suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ())- data Foo4Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>- Foo4Sym0 a0123456789876543210- type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210- type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo3 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ())- data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo3Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) =>- Foo3Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 a0123456789876543210- type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210- type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ())- data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo2Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>- Foo2Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo2Sym0 where- suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ())- data Foo2Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210)- where- Foo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>- Foo2Sym0 a0123456789876543210- type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210- type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ())- data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo1Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>- Foo1Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210)- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210- type family Foo5 (a :: a) :: a where- Foo5 x = Case_0123456789876543210 x x- type family Foo4 (a :: a) :: a where- Foo4 x = Case_0123456789876543210 x x- type family Foo3 (a :: a) (a :: b) :: a where- Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b)- type family Foo2 (a :: a) (a :: Maybe a) :: a where- Foo2 d _ = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d)- type family Foo1 (a :: a) (a :: Maybe a) :: a where- Foo1 d x = Case_0123456789876543210 d x x- sFoo5 :: forall a (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a)- sFoo4 :: forall a (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a)- sFoo3 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a)- sFoo2 ::- forall a (t :: a) (t :: Maybe a).- Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)- sFoo1 ::- forall a (t :: a) (t :: Maybe a).- Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a)- sFoo5 (sX :: Sing x)- = (case sX of {- (sY :: Sing y)- -> (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sX }) ::- Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) })))- sY }) ::- Sing (Case_0123456789876543210 x x :: a)- sFoo4 (sX :: Sing x)- = (case sX of {- (sY :: Sing y)- -> let- sZ :: Sing (Let0123456789876543210ZSym2 x y :: a)- sZ = sY- in sZ }) ::- Sing (Case_0123456789876543210 x x :: a)- sFoo3 (sA :: Sing a) (sB :: Sing b)- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b)- sScrutinee_0123456789876543210- = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB- in (case sScrutinee_0123456789876543210 of {- STuple2 (sP :: Sing p) _ -> sP }) ::- Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) :: a)- sFoo2 (sD :: Sing d) _- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d)- sScrutinee_0123456789876543210- = (applySing ((singFun1 @JustSym0) SJust)) sD- in (case sScrutinee_0123456789876543210 of {- SJust (sY :: Sing y) -> sY }) ::- Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) :: a)- sFoo1 (sD :: Sing d) (sX :: Sing x)- = (case sX of- SJust (sY :: Sing y) -> sY- SNothing -> sD) ::- Sing (Case_0123456789876543210 d x x :: a)- instance SingI (Foo5Sym0 :: (~>) a a) where- sing = (singFun1 @Foo5Sym0) sFoo5- instance SingI (Foo4Sym0 :: (~>) a a) where- sing = (singFun1 @Foo4Sym0) sFoo4- instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo3Sym0) sFoo3- instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d))- instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where- sing = (singFun2 @Foo2Sym0) sFoo2- instance SingI d =>- SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where- sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d))- instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where- sing = (singFun2 @Foo1Sym0) sFoo1- instance SingI d =>- SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where- sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d))
− tests/compile-and-dump/Singletons/CaseExpressions.hs
@@ -1,66 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}--module Singletons.CaseExpressions where--import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude.Maybe-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- foo1 :: a -> Maybe a -> a- foo1 d x = case x of- Just y -> y- Nothing -> d-- foo2 :: a -> Maybe a -> a- foo2 d _ = case (Just d) of- Just y -> y--- Nothing -> d--- the above line causes an "inaccessible code" error. w00t.-- foo3 :: a -> b -> a- foo3 a b = case (a, b) of- (p, _) -> p--- foo4 :: forall a. a -> a- foo4 x = case x of- y -> let z :: a- z = y- in z-- foo5 :: a -> a- foo5 x = case x of- y -> (\_ -> x) y- |])--foo1a :: Proxy (Foo1 Int (Just Char))-foo1a = Proxy--foo1b :: Proxy Char-foo1b = foo1a--foo2a :: Proxy (Foo2 Char Nothing)-foo2a = Proxy--foo2b :: Proxy Char-foo2b = foo2a--foo3a :: Proxy (Foo3 Int Char)-foo3a = Proxy--foo3b :: Proxy Int-foo3b = foo3a--foo4a :: Proxy (Foo4 Int)-foo4a = Proxy--foo4b :: Proxy Int-foo4b = foo4a--foo5a :: Proxy (Foo5 Int)-foo5a = Proxy--foo5b :: Proxy Int-foo5b = foo5a
− tests/compile-and-dump/Singletons/Classes.ghc86.template
@@ -1,577 +0,0 @@-Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infix 4 <=>- - const :: a -> b -> a- const x _ = x- fooCompare :: Foo -> Foo -> Ordering- fooCompare A A = EQ- fooCompare A B = LT- fooCompare B B = GT- fooCompare B A = EQ- - class MyOrd a where- mycompare :: a -> a -> Ordering- (<=>) :: a -> a -> Ordering- (<=>) = mycompare- infix 4 <=>- data Foo = A | B- data Foo2 = F | G- - instance MyOrd () where- mycompare _ = const EQ- instance MyOrd Nat where- Zero `mycompare` Zero = EQ- Zero `mycompare` (Succ _) = LT- (Succ _) `mycompare` Zero = GT- (Succ n) `mycompare` (Succ m) = m `mycompare` n- instance MyOrd Foo where- mycompare = fooCompare- instance Eq Foo2 where- F == F = True- G == G = True- F == G = False- G == F = False |]- ======>- const :: a -> b -> a- const x _ = x- class MyOrd a where- mycompare :: a -> a -> Ordering- (<=>) :: a -> a -> Ordering- (<=>) = mycompare- infix 4 <=>- instance MyOrd Nat where- mycompare Zero Zero = EQ- mycompare Zero (Succ _) = LT- mycompare (Succ _) Zero = GT- mycompare (Succ n) (Succ m) = (m `mycompare` n)- instance MyOrd () where- mycompare _ = const EQ- data Foo = A | B- fooCompare :: Foo -> Foo -> Ordering- fooCompare A A = EQ- fooCompare A B = LT- fooCompare B B = GT- fooCompare B A = EQ- instance MyOrd Foo where- mycompare = fooCompare- data Foo2 = F | G- instance Eq Foo2 where- (==) F F = True- (==) G G = True- (==) F G = False- (==) G F = False- type ASym0 = A- type BSym0 = B- type FSym0 = F- type GSym0 = G- type FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) =- FooCompare a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) FooCompareSym1KindInference) ())- data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering- where- FooCompareSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) =>- FooCompareSym1 a0123456789876543210 a0123456789876543210- type instance Apply (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FooCompareSym0 where- suppressUnusedWarnings = snd (((,) FooCompareSym0KindInference) ())- data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)- where- FooCompareSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) =>- FooCompareSym0 a0123456789876543210- type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210- type ConstSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Const a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) ConstSym1KindInference) ())- data ConstSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- ConstSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) =>- ConstSym1 a0123456789876543210 a0123456789876543210- type instance Apply (ConstSym1 a0123456789876543210) a0123456789876543210 = Const a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ConstSym0 where- suppressUnusedWarnings = snd (((,) ConstSym0KindInference) ())- data ConstSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- ConstSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) =>- ConstSym0 a0123456789876543210- type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210- type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where- FooCompare A A = EQSym0- FooCompare A B = LTSym0- FooCompare B B = GTSym0- FooCompare B A = EQSym0- type family Const (a :: a) (a :: b) :: a where- Const x _ = x- type MycompareSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) =- Mycompare arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (MycompareSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) MycompareSym1KindInference) ())- data MycompareSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering- where- MycompareSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (MycompareSym1 arg0123456789876543210) arg) (MycompareSym2 arg0123456789876543210 arg) =>- MycompareSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (MycompareSym1 arg0123456789876543210) arg0123456789876543210 = Mycompare arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings MycompareSym0 where- suppressUnusedWarnings = snd (((,) MycompareSym0KindInference) ())- data MycompareSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering)- where- MycompareSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) =>- MycompareSym0 arg0123456789876543210- type instance Apply MycompareSym0 arg0123456789876543210 = MycompareSym1 arg0123456789876543210- type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) =- (<=>) arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ())- data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering- where- (:<=>@#@$$###) :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) =>- (<=>@#@$$) arg0123456789876543210 arg0123456789876543210- type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210- infix 4 <=>@#@$$- instance SuppressUnusedWarnings (<=>@#@$) where- suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ())- data (<=>@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering)- where- (:<=>@#@$###) :: forall arg0123456789876543210- arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>- (<=>@#@$) arg0123456789876543210- type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210- infix 4 <=>@#@$- type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where- TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210- type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) =- TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ())- data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering- where- TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) =>- TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ())- data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering)- where- TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>- TFHelper_0123456789876543210Sym0 a0123456789876543210- type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210- class PMyOrd (a :: GHC.Types.Type) where- type Mycompare (arg :: a) (arg :: a) :: Ordering- type (<=>) (arg :: a) (arg :: a) :: Ordering- type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a- type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where- Mycompare_0123456789876543210 'Zero 'Zero = EQSym0- Mycompare_0123456789876543210 'Zero ( 'Succ _) = LTSym0- Mycompare_0123456789876543210 ( 'Succ _) 'Zero = GTSym0- Mycompare_0123456789876543210 ( 'Succ n) ( 'Succ m) = Apply (Apply MycompareSym0 m) n- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd Nat where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where- Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: ()) :: (~>) () Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd () where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where- Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd Foo where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where- TFHelper_0123456789876543210 F F = TrueSym0- TFHelper_0123456789876543210 G G = TrueSym0- TFHelper_0123456789876543210 F G = FalseSym0- TFHelper_0123456789876543210 G F = FalseSym0- type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) =- TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ())- data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Bool- where- TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) =>- TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ())- data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool)- where- TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>- TFHelper_0123456789876543210Sym0 a0123456789876543210- type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210- instance PEq Foo2 where- type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a- infix 4 %<=>- sFooCompare ::- forall (t :: Foo) (t :: Foo).- Sing t- -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering)- sConst ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a)- sFooCompare SA SA = SEQ- sFooCompare SA SB = SLT- sFooCompare SB SB = SGT- sFooCompare SB SA = SEQ- sConst (sX :: Sing x) _ = sX- instance SingI (FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)) where- sing = (singFun2 @FooCompareSym0) sFooCompare- instance SingI d =>- SingI (FooCompareSym1 (d :: Foo) :: (~>) Foo Ordering) where- sing- = (singFun1 @(FooCompareSym1 (d :: Foo))) (sFooCompare (sing @d))- instance SingI (ConstSym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @ConstSym0) sConst- instance SingI d => SingI (ConstSym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(ConstSym1 (d :: a))) (sConst (sing @d))- data instance Sing :: Foo -> GHC.Types.Type- where- SA :: Sing A- SB :: Sing B- type SFoo = (Sing :: Foo -> GHC.Types.Type)- instance SingKind Foo where- type Demote Foo = Foo- fromSing SA = A- fromSing SB = B- toSing A = SomeSing SA- toSing B = SomeSing SB- data instance Sing :: Foo2 -> GHC.Types.Type- where- SF :: Sing F- SG :: Sing G- type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type)- instance SingKind Foo2 where- type Demote Foo2 = Foo2- fromSing SF = F- fromSing SG = G- toSing F = SomeSing SF- toSing G = SomeSing SG- class SMyOrd a where- sMycompare ::- forall (t :: a) (t :: a).- Sing t- -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)- (%<=>) ::- forall (t :: a) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering)- default (%<=>) ::- forall (t :: a) (t :: a).- (Apply (Apply (<=>@#@$) t) t :: Ordering)- ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t =>- Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering)- (%<=>)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @MycompareSym0) sMycompare))- sA_0123456789876543210))- sA_0123456789876543210- instance SMyOrd Nat where- sMycompare ::- forall (t :: Nat) (t :: Nat).- Sing t- -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)- sMycompare SZero SZero = SEQ- sMycompare SZero (SSucc _) = SLT- sMycompare (SSucc _) SZero = SGT- sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m))- = (applySing- ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM))- sN- instance SMyOrd () where- sMycompare ::- forall (t :: ()) (t :: ()).- Sing t- -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)- sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ))- sA_0123456789876543210- instance SMyOrd Foo where- sMycompare ::- forall (t :: Foo) (t :: Foo).- Sing t- -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering)- sMycompare- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @FooCompareSym0) sFooCompare))- sA_0123456789876543210))- sA_0123456789876543210- instance SEq Foo2 where- (%==) ::- forall (a :: Foo2) (b :: Foo2). Sing a -> Sing b -> Sing ((==) a b)- (%==) SF SF = STrue- (%==) SG SG = STrue- (%==) SF SG = SFalse- (%==) SG SF = SFalse- instance SingI A where- sing = SA- instance SingI B where- sing = SB- instance SingI F where- sing = SF- instance SingI G where- sing = SG- instance SMyOrd a =>- SingI (MycompareSym0 :: (~>) a ((~>) a Ordering)) where- sing = (singFun2 @MycompareSym0) sMycompare- instance (SMyOrd a, SingI d) =>- SingI (MycompareSym1 (d :: a) :: (~>) a Ordering) where- sing = (singFun1 @(MycompareSym1 (d :: a))) (sMycompare (sing @d))- instance SMyOrd a =>- SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where- sing = (singFun2 @(<=>@#@$)) (%<=>)- instance (SMyOrd a, SingI d) =>- SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where- sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d))-Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations- promote- [d| instance Ord Foo2 where- F `compare` F = EQ- F `compare` _ = LT- _ `compare` _ = GT- instance MyOrd Foo2 where- F `mycompare` F = EQ- F `mycompare` _ = LT- _ `mycompare` _ = GT |]- ======>- instance MyOrd Foo2 where- mycompare F F = EQ- mycompare F _ = LT- mycompare _ _ = GT- instance Ord Foo2 where- compare F F = EQ- compare F _ = LT- compare _ _ = GT- type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where- Mycompare_0123456789876543210 'F 'F = EQSym0- Mycompare_0123456789876543210 'F _ = LTSym0- Mycompare_0123456789876543210 _ _ = GTSym0- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd Foo2 where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where- Compare_0123456789876543210 'F 'F = EQSym0- Compare_0123456789876543210 'F _ = LTSym0- Compare_0123456789876543210 _ _ = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Foo2 where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a-Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Nat' = Zero' | Succ' Nat'- - instance MyOrd Nat' where- Zero' `mycompare` Zero' = EQ- Zero' `mycompare` (Succ' _) = LT- (Succ' _) `mycompare` Zero' = GT- (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |]- ======>- data Nat' = Zero' | Succ' Nat'- instance MyOrd Nat' where- mycompare Zero' Zero' = EQ- mycompare Zero' (Succ' _) = LT- mycompare (Succ' _) Zero' = GT- mycompare (Succ' n) (Succ' m) = (m `mycompare` n)- type Zero'Sym0 = Zero'- type Succ'Sym1 (t0123456789876543210 :: Nat') =- Succ' t0123456789876543210- instance SuppressUnusedWarnings Succ'Sym0 where- suppressUnusedWarnings = snd (((,) Succ'Sym0KindInference) ())- data Succ'Sym0 :: (~>) Nat' Nat'- where- Succ'Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) =>- Succ'Sym0 t0123456789876543210- type instance Apply Succ'Sym0 t0123456789876543210 = Succ' t0123456789876543210- type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where- Mycompare_0123456789876543210 Zero' Zero' = EQSym0- Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0- Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0- Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat') :: (~>) Nat' Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd Nat' where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- data instance Sing :: Nat' -> GHC.Types.Type- where- SZero' :: Sing Zero'- SSucc' :: forall (n :: Nat'). (Sing (n :: Nat')) -> Sing (Succ' n)- type SNat' = (Sing :: Nat' -> GHC.Types.Type)- instance SingKind Nat' where- type Demote Nat' = Nat'- fromSing SZero' = Zero'- fromSing (SSucc' b) = Succ' (fromSing b)- toSing Zero' = SomeSing SZero'- toSing (Succ' (b :: Demote Nat'))- = case toSing b :: SomeSing Nat' of {- SomeSing c -> SomeSing (SSucc' c) }- instance SMyOrd Nat' where- sMycompare ::- forall (t :: Nat') (t :: Nat').- Sing t- -> Sing t- -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' ((~>) Nat' Ordering)- -> GHC.Types.Type) t) t)- sMycompare SZero' SZero' = SEQ- sMycompare SZero' (SSucc' _) = SLT- sMycompare (SSucc' _) SZero' = SGT- sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m))- = (applySing- ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM))- sN- instance SingI Zero' where- sing = SZero'- instance SingI n => SingI (Succ' (n :: Nat')) where- sing = SSucc' sing- instance SingI (Succ'Sym0 :: (~>) Nat' Nat') where- sing = (singFun1 @Succ'Sym0) SSucc'- instance SingI (TyCon1 Succ' :: (~>) Nat' Nat') where- sing = (singFun1 @(TyCon1 Succ')) SSucc'
− tests/compile-and-dump/Singletons/Classes.hs
@@ -1,98 +0,0 @@-module Singletons.Classes where--import Prelude hiding (const)-import Singletons.Nat-import Data.Singletons-import Data.Singletons.TH-import Language.Haskell.TH.Desugar-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Eq--$(singletons [d|- const :: a -> b -> a- const x _ = x-- class MyOrd a where- mycompare :: a -> a -> Ordering- (<=>) :: a -> a -> Ordering- (<=>) = mycompare- infix 4 <=>-- instance MyOrd Nat where- Zero `mycompare` Zero = EQ- Zero `mycompare` (Succ _) = LT- (Succ _) `mycompare` Zero = GT- (Succ n) `mycompare` (Succ m) = m `mycompare` n-- -- test eta-expansion- instance MyOrd () where- mycompare _ = const EQ-- data Foo = A | B-- fooCompare :: Foo -> Foo -> Ordering- fooCompare A A = EQ- fooCompare A B = LT- fooCompare B B = GT- fooCompare B A = EQ-- instance MyOrd Foo where- -- test that values in instance definitions are eta-expanded- mycompare = fooCompare-- data Foo2 = F | G-- instance Eq Foo2 where- F == F = True- G == G = True- F == G = False- G == F = False- |])--$(promote [d|- -- instance with overlaping equations. Tests #56- instance MyOrd Foo2 where- F `mycompare` F = EQ- F `mycompare` _ = LT- _ `mycompare` _ = GT-- instance Ord Foo2 where- F `compare` F = EQ- F `compare` _ = LT- _ `compare` _ = GT-- |])---- check promotion across different splices (#55)-$(singletons [d|- data Nat' = Zero' | Succ' Nat'- instance MyOrd Nat' where- Zero' `mycompare` Zero' = EQ- Zero' `mycompare` (Succ' _) = LT- (Succ' _) `mycompare` Zero' = GT- (Succ' n) `mycompare` (Succ' m) = m `mycompare` n- |])--foo1a :: Proxy (Zero `Mycompare` (Succ Zero))-foo1a = Proxy--foo1b :: Proxy LT-foo1b = foo1a--foo2a :: Proxy (A `Mycompare` A)-foo2a = Proxy--foo2b :: Proxy EQ-foo2b = foo2a--foo3a :: Proxy ('() `Mycompare` '())-foo3a = Proxy--foo3b :: Proxy EQ-foo3b = foo3a--foo4a :: Proxy (Succ' Zero' <=> Zero')-foo4a = Proxy--foo4b :: Proxy GT-foo4b = foo4a
− tests/compile-and-dump/Singletons/Classes2.ghc86.template
@@ -1,91 +0,0 @@-Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data NatFoo = ZeroFoo | SuccFoo NatFoo- - instance MyOrd NatFoo where- ZeroFoo `mycompare` ZeroFoo = EQ- ZeroFoo `mycompare` (SuccFoo _) = LT- (SuccFoo _) `mycompare` ZeroFoo = GT- (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |]- ======>- data NatFoo = ZeroFoo | SuccFoo NatFoo- instance MyOrd NatFoo where- mycompare ZeroFoo ZeroFoo = EQ- mycompare ZeroFoo (SuccFoo _) = LT- mycompare (SuccFoo _) ZeroFoo = GT- mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n)- type ZeroFooSym0 = ZeroFoo- type SuccFooSym1 (t0123456789876543210 :: NatFoo) =- SuccFoo t0123456789876543210- instance SuppressUnusedWarnings SuccFooSym0 where- suppressUnusedWarnings = snd (((,) SuccFooSym0KindInference) ())- data SuccFooSym0 :: (~>) NatFoo NatFoo- where- SuccFooSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) =>- SuccFooSym0 t0123456789876543210- type instance Apply SuccFooSym0 t0123456789876543210 = SuccFoo t0123456789876543210- type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where- Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0- Mycompare_0123456789876543210 ZeroFoo (SuccFoo _) = LTSym0- Mycompare_0123456789876543210 (SuccFoo _) ZeroFoo = GTSym0- Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n- type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) =- Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ())- data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: NatFoo) :: (~>) NatFoo Ordering- where- Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ())- data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering)- where- Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>- Mycompare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210- instance PMyOrd NatFoo where- type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a- data instance Sing :: NatFoo -> GHC.Types.Type- where- SZeroFoo :: Sing ZeroFoo- SSuccFoo :: forall (n :: NatFoo).- (Sing (n :: NatFoo)) -> Sing (SuccFoo n)- type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type)- instance SingKind NatFoo where- type Demote NatFoo = NatFoo- fromSing SZeroFoo = ZeroFoo- fromSing (SSuccFoo b) = SuccFoo (fromSing b)- toSing ZeroFoo = SomeSing SZeroFoo- toSing (SuccFoo (b :: Demote NatFoo))- = case toSing b :: SomeSing NatFoo of {- SomeSing c -> SomeSing (SSuccFoo c) }- instance SMyOrd NatFoo where- sMycompare ::- forall (t1 :: NatFoo) (t2 :: NatFoo).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo ((~>) NatFoo Ordering)- -> GHC.Types.Type) t1) t2)- sMycompare SZeroFoo SZeroFoo = SEQ- sMycompare SZeroFoo (SSuccFoo _) = SLT- sMycompare (SSuccFoo _) SZeroFoo = SGT- sMycompare (SSuccFoo (sN :: Sing n)) (SSuccFoo (sM :: Sing m))- = (applySing- ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM))- sN- instance SingI ZeroFoo where- sing = SZeroFoo- instance SingI n => SingI (SuccFoo (n :: NatFoo)) where- sing = SSuccFoo sing- instance SingI (SuccFooSym0 :: (~>) NatFoo NatFoo) where- sing = (singFun1 @SuccFooSym0) SSuccFoo- instance SingI (TyCon1 SuccFoo :: (~>) NatFoo NatFoo) where- sing = (singFun1 @(TyCon1 SuccFoo)) SSuccFoo
− tests/compile-and-dump/Singletons/Classes2.hs
@@ -1,22 +0,0 @@-module Singletons.Classes2 where--import Prelude hiding (const)-import Singletons.Nat-import Singletons.Classes-import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude.Ord (EQSym0, LTSym0, GTSym0, Sing(..))-import Language.Haskell.TH.Desugar---$(singletons [d|- -- tests promotion of class instances when the class was declared- -- in a different source file than the instance.- data NatFoo = ZeroFoo | SuccFoo NatFoo-- instance MyOrd NatFoo where- ZeroFoo `mycompare` ZeroFoo = EQ- ZeroFoo `mycompare` (SuccFoo _) = LT- (SuccFoo _) `mycompare` ZeroFoo = GT- (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n- |])
− tests/compile-and-dump/Singletons/Contains.ghc86.template
@@ -1,50 +0,0 @@-Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| contains :: Eq a => a -> [a] -> Bool- contains _ [] = False- contains elt (h : t) = (elt == h) || (contains elt t) |]- ======>- contains :: Eq a => a -> [a] -> Bool- contains _ [] = False- contains elt (h : t) = ((elt == h) || (contains elt) t)- type ContainsSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) =- Contains a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) ContainsSym1KindInference) ())- data ContainsSym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [a0123456789876543210] Bool- where- ContainsSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) =>- ContainsSym1 a0123456789876543210 a0123456789876543210- type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ContainsSym0 where- suppressUnusedWarnings = snd (((,) ContainsSym0KindInference) ())- data ContainsSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) [a0123456789876543210] Bool)- where- ContainsSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) =>- ContainsSym0 a0123456789876543210- type instance Apply ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210- type family Contains (a :: a) (a :: [a]) :: Bool where- Contains _ '[] = FalseSym0- Contains elt ( '(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t)- sContains ::- forall a (t :: a) (t :: [a]).- SEq a =>- Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool)- sContains _ SNil = SFalse- sContains (sElt :: Sing elt) (SCons (sH :: Sing h) (sT :: Sing t))- = (applySing- ((applySing ((singFun2 @(||@#@$)) (%||)))- ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sElt)) sH)))- ((applySing- ((applySing ((singFun2 @ContainsSym0) sContains)) sElt))- sT)- instance SEq a =>- SingI (ContainsSym0 :: (~>) a ((~>) [a] Bool)) where- sing = (singFun2 @ContainsSym0) sContains- instance (SEq a, SingI d) =>- SingI (ContainsSym1 (d :: a) :: (~>) [a] Bool) where- sing = (singFun1 @(ContainsSym1 (d :: a))) (sContains (sing @d))
− tests/compile-and-dump/Singletons/Contains.hs
@@ -1,13 +0,0 @@-module Singletons.Contains where--import Data.Singletons.TH-import Data.Singletons.Prelude-import Data.Singletons.SuppressUnusedWarnings---- polymorphic function with context--$(singletons [d|- contains :: Eq a => a -> [a] -> Bool- contains _ [] = False- contains elt (h:t) = (elt == h) || (contains elt t)- |])
− tests/compile-and-dump/Singletons/DataValues.ghc86.template
@@ -1,186 +0,0 @@-Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| pr = Pair (Succ Zero) ([Zero])- complex = Pair (Pair (Just Zero) Zero) False- tuple = (False, Just Zero, True)- aList = [Zero, Succ Zero, Succ (Succ Zero)]- - data Pair a b- = Pair a b- deriving Show |]- ======>- data Pair a b- = Pair a b- deriving Show- pr = (Pair (Succ Zero)) [Zero]- complex = (Pair ((Pair (Just Zero)) Zero)) False- tuple = (False, Just Zero, True)- aList = [Zero, Succ Zero, Succ (Succ Zero)]- type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) PairSym1KindInference) ())- data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)- where- PairSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) =>- PairSym1 t0123456789876543210 t0123456789876543210- type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings PairSym0 where- suppressUnusedWarnings = snd (((,) PairSym0KindInference) ())- data PairSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))- where- PairSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>- PairSym0 t0123456789876543210- type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210- type AListSym0 = AList- type TupleSym0 = Tuple- type ComplexSym0 = Complex- type PrSym0 = Pr- type family AList where- AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[]))- type family Tuple where- Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0- type family Complex where- Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0- type family Pr where- Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[])- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210- b0123456789876543210.- (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (Pair a b) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- sAList :: Sing AListSym0- sTuple :: Sing TupleSym0- sComplex :: Sing ComplexSym0- sPr :: Sing PrSym0- sAList- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))))- SNil))- sTuple- = (applySing- ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse))- ((applySing ((singFun1 @JustSym0) SJust)) SZero)))- STrue- sComplex- = (applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing ((singFun1 @JustSym0) SJust)) SZero)))- SZero)))- SFalse- sPr- = (applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil)- data instance Sing :: Pair a b -> GHC.Types.Type- where- SPair :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n)- type SPair = (Sing :: Pair a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (Pair a b) where- type Demote (Pair a b) = Pair (Demote a) (Demote b)- fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b)- toSing (Pair (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) }- instance (SShow a, SShow b) => SShow (Pair a b) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Pair "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- deriving instance (Data.Singletons.ShowSing.ShowSing a,- Data.Singletons.ShowSing.ShowSing b) =>- Show (Sing (z :: Pair a b))- instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where- sing = (SPair sing) sing- instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @PairSym0) SPair- instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @(TyCon2 Pair)) SPair- instance SingI d =>- SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where- sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d))- instance SingI d =>- SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where- sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d))
− tests/compile-and-dump/Singletons/DataValues.hs
@@ -1,20 +0,0 @@-module Singletons.DataValues where--import Data.Singletons.TH-import Data.Singletons.Prelude-import Data.Singletons.Prelude.Show-import Singletons.Nat-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- data Pair a b = Pair a b deriving Show-- pr = Pair (Succ Zero) ([Zero])-- complex = Pair (Pair (Just Zero) Zero) False-- tuple = (False, Just Zero, True)-- aList = [Zero, Succ Zero, Succ (Succ Zero)]-- |])
− tests/compile-and-dump/Singletons/Empty.ghc86.template
@@ -1,10 +0,0 @@-Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations- singletons [d| data Empty |]- ======>- data Empty- data instance Sing :: Empty -> GHC.Types.Type- type SEmpty = (Sing :: Empty -> GHC.Types.Type)- instance SingKind Empty where- type Demote Empty = Empty- fromSing x = case x of- toSing x = SomeSing (case x of)
− tests/compile-and-dump/Singletons/Empty.hs
@@ -1,7 +0,0 @@-module Singletons.Empty where--import Data.Singletons.TH--$(singletons [d|- data Empty- |])
− tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template
@@ -1,68 +0,0 @@-Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Foo- - deriving instance Show Foo |]- ======>- data Foo- deriving instance Show Foo- type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Foo where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- data instance Sing :: Foo -> GHC.Types.Type- type SFoo = (Sing :: Foo -> GHC.Types.Type)- instance SingKind Foo where- type Demote Foo = Foo- fromSing x = case x of- toSing x = SomeSing (case x of)- instance SShow Foo where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Foo) (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- (sV_0123456789876543210 :: Sing v_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((case sV_0123456789876543210 of) ::- Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210)))- sA_0123456789876543210- deriving instance Show (Sing (z :: Foo))
− tests/compile-and-dump/Singletons/EmptyShowDeriving.hs
@@ -1,7 +0,0 @@-module Singletons.EmptyShowDeriving where--import Data.Singletons.TH--$(singletons [d| data Foo- deriving instance Show Foo- |])
− tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template
@@ -1,199 +0,0 @@-Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Foo- = Bar | Baz | Bum- deriving Enum- data Quux = Q1 | Q2 |]- ======>- data Foo- = Bar | Baz | Bum- deriving Enum- data Quux = Q1 | Q2- type BarSym0 = Bar- type BazSym0 = Baz- type BumSym0 = Bum- type Q1Sym0 = Q1- type Q2Sym0 = Q2- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = BumSym0- Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = BazSym0- Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2))- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = BarSym0- Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))- type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where- ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))- type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) =- ToEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ())- data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Foo- where- ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>- ToEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210- type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where- FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0- FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1- FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2- type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) =- FromEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ())- data FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Types.Nat- where- FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>- FromEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210- instance PEnum Foo where- type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a- type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a- data instance Sing :: Foo -> GHC.Types.Type- where- SBar :: Sing Bar- SBaz :: Sing Baz- SBum :: Sing Bum- type SFoo = (Sing :: Foo -> GHC.Types.Type)- instance SingKind Foo where- type Demote Foo = Foo- fromSing SBar = Bar- fromSing SBaz = Baz- fromSing SBum = Bum- toSing Bar = SomeSing SBar- toSing Baz = SomeSing SBaz- toSing Bum = SomeSing SBum- data instance Sing :: Quux -> GHC.Types.Type- where- SQ1 :: Sing Q1- SQ2 :: Sing Q2- type SQuux = (Sing :: Quux -> GHC.Types.Type)- instance SingKind Quux where- type Demote Quux = Quux- fromSing SQ1 = Q1- fromSing SQ2 = Q2- toSing Q1 = SomeSing SQ1- toSing Q2 = SomeSing SQ2- instance SEnum Foo where- sToEnum ::- forall (t :: GHC.Types.Nat).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Foo- -> GHC.Types.Type) t)- sFromEnum ::- forall (t :: Foo).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Foo GHC.Types.Nat- -> GHC.Types.Type) t)- sToEnum (sN :: Sing n)- = (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0))- of- STrue -> SBar- SFalse- -> (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1))- of- STrue -> SBaz- SFalse- -> (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2))- of- STrue -> SBum- SFalse -> sError (sing :: Sing "toEnum: bad argument")) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)))) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)))- sFromEnum SBar- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)- sFromEnum SBaz- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)- sFromEnum SBum- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2)- instance SingI Bar where- sing = SBar- instance SingI Baz where- sing = SBaz- instance SingI Bum where- sing = SBum- instance SingI Q1 where- sing = SQ1- instance SingI Q2 where- sing = SQ2-Singletons/EnumDeriving.hs:0:0:: Splicing declarations- singEnumInstance ''Quux- ======>- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = Q2Sym0- Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = Q1Sym0- Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1))- type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where- ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))- type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) =- ToEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ())- data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Quux- where- ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>- ToEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210- type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where- FromEnum_0123456789876543210 'Q1 = Data.Singletons.Prelude.Num.FromInteger 0- FromEnum_0123456789876543210 'Q2 = Data.Singletons.Prelude.Num.FromInteger 1- type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) =- FromEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ())- data FromEnum_0123456789876543210Sym0 :: (~>) Quux GHC.Types.Nat- where- FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>- FromEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210- instance PEnum Quux where- type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a- type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a- instance SEnum Quux where- sToEnum ::- forall (t :: GHC.Types.Nat).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Quux- -> GHC.Types.Type) t)- sFromEnum ::- forall (t :: Quux).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Quux GHC.Types.Nat- -> GHC.Types.Type) t)- sToEnum (sN :: Sing n)- = (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0))- of- STrue -> SQ1- SFalse- -> (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1))- of- STrue -> SQ2- SFalse -> sError (sing :: Sing "toEnum: bad argument")) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)))- sFromEnum SQ1- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)- sFromEnum SQ2- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)
− tests/compile-and-dump/Singletons/EnumDeriving.hs
@@ -1,11 +0,0 @@-module Singletons.EnumDeriving where--import Data.Singletons.TH--$(singletons [d|- data Foo = Bar | Baz | Bum- deriving Enum- data Quux = Q1 | Q2- |])--$(singEnumInstance ''Quux)
− tests/compile-and-dump/Singletons/EqInstances.ghc86.template
@@ -1,21 +0,0 @@-Singletons/EqInstances.hs:0:0:: Splicing declarations- singEqInstances [''Foo, ''Empty]- ======>- instance SEq Foo => SEq Foo where- (%==) SFLeaf SFLeaf = STrue- (%==) SFLeaf ((:%+:) _ _) = SFalse- (%==) ((:%+:) _ _) SFLeaf = SFalse- (%==) ((:%+:) a a) ((:%+:) b b)- = ((%&&) (((%==) a) b)) (((%==) a) b)- type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where- Equals_0123456789876543210 'FLeaf 'FLeaf = TrueSym0- Equals_0123456789876543210 ( '(:+:) a a) ( '(:+:) b b) = (&&) ((==) a b) ((==) a b)- Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0- instance PEq Foo where- type (==) a b = Equals_0123456789876543210 a b- instance SEq Empty where- (%==) _ _ = STrue- type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where- Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0- instance PEq Empty where- type (==) a b = Equals_0123456789876543210 a b
− tests/compile-and-dump/Singletons/EqInstances.hs
@@ -1,8 +0,0 @@-module Singletons.EqInstances where--import Data.Singletons.TH-import Data.Singletons.Prelude.Bool-import Singletons.Empty-import Singletons.Operators--$(singEqInstances [''Foo, ''Empty])
− tests/compile-and-dump/Singletons/Error.ghc86.template
@@ -1,30 +0,0 @@-Singletons/Error.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| head :: [a] -> a- head (a : _) = a- head [] = error "Data.Singletons.List.head: empty list" |]- ======>- head :: [a] -> a- head (a : _) = a- head [] = error "Data.Singletons.List.head: empty list"- type HeadSym1 (a0123456789876543210 :: [a0123456789876543210]) =- Head a0123456789876543210- instance SuppressUnusedWarnings HeadSym0 where- suppressUnusedWarnings = snd (((,) HeadSym0KindInference) ())- data HeadSym0 :: forall a0123456789876543210.- (~>) [a0123456789876543210] a0123456789876543210- where- HeadSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) =>- HeadSym0 a0123456789876543210- type instance Apply HeadSym0 a0123456789876543210 = Head a0123456789876543210- type family Head (a :: [a]) :: a where- Head ( '(:) a _) = a- Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list"- sHead ::- forall a (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a)- sHead (SCons (sA :: Sing a) _) = sA- sHead SNil- = sError (sing :: Sing "Data.Singletons.List.head: empty list")- instance SingI (HeadSym0 :: (~>) [a] a) where- sing = (singFun1 @HeadSym0) sHead
− tests/compile-and-dump/Singletons/Error.hs
@@ -1,11 +0,0 @@-module Singletons.Error where--import Data.Singletons-import Data.Singletons.Prelude hiding (Head, HeadSym0, HeadSym1, sHead)-import Data.Singletons.TH--$(singletons [d|- head :: [a] -> a- head (a : _) = a- head [] = error "Data.Singletons.List.head: empty list"- |])
− tests/compile-and-dump/Singletons/Fixity.ghc86.template
@@ -1,86 +0,0 @@-Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infix 4 ====- infix 4 <=>- - (====) :: a -> a -> a- a ==== _ = a- - class MyOrd a where- (<=>) :: a -> a -> Ordering- infix 4 <=> |]- ======>- class MyOrd a where- (<=>) :: a -> a -> Ordering- infix 4 <=>- (====) :: a -> a -> a- (====) a _ = a- infix 4 ====- type (====@#@$$$) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) =- (====) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:====@#@$$###)) ())- data (====@#@$$) (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210- where- (:====@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) =>- (====@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210- infix 4 ====@#@$$- instance SuppressUnusedWarnings (====@#@$) where- suppressUnusedWarnings = snd (((,) (:====@#@$###)) ())- data (====@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210)- where- (:====@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) =>- (====@#@$) a0123456789876543210- type instance Apply (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210- infix 4 ====@#@$- type family (====) (a :: a) (a :: a) :: a where- (====) a _ = a- type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) =- (<=>) arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ())- data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering- where- (:<=>@#@$$###) :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) =>- (<=>@#@$$) arg0123456789876543210 arg0123456789876543210- type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210- infix 4 <=>@#@$$- instance SuppressUnusedWarnings (<=>@#@$) where- suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ())- data (<=>@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering)- where- (:<=>@#@$###) :: forall arg0123456789876543210- arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>- (<=>@#@$) arg0123456789876543210- type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210- infix 4 <=>@#@$- class PMyOrd (a :: GHC.Types.Type) where- type (<=>) (arg :: a) (arg :: a) :: Ordering- infix 4 %====- infix 4 %<=>- (%====) ::- forall a (t :: a) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a)- (%====) (sA :: Sing a) _ = sA- instance SingI ((====@#@$) :: (~>) a ((~>) a a)) where- sing = (singFun2 @(====@#@$)) (%====)- instance SingI d => SingI ((====@#@$$) (d :: a) :: (~>) a a) where- sing = (singFun1 @((====@#@$$) (d :: a))) ((%====) (sing @d))- class SMyOrd a where- (%<=>) ::- forall (t :: a) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering)- instance SMyOrd a =>- SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where- sing = (singFun2 @(<=>@#@$)) (%<=>)- instance (SMyOrd a, SingI d) =>- SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where- sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d))
− tests/compile-and-dump/Singletons/Fixity.hs
@@ -1,16 +0,0 @@-module Singletons.Fixity where--import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude-import Language.Haskell.TH.Desugar--$(singletons [d|- class MyOrd a where- (<=>) :: a -> a -> Ordering- infix 4 <=>-- (====) :: a -> a -> a- a ==== _ = a- infix 4 ====- |])
− tests/compile-and-dump/Singletons/FunDeps.ghc86.template
@@ -1,96 +0,0 @@-Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| t1 = meth True- - class FD a b | a -> b where- meth :: a -> a- l2r :: a -> b- - instance FD Bool Nat where- meth = not- l2r False = 0- l2r True = 1 |]- ======>- class FD a b | a -> b where- meth :: a -> a- l2r :: a -> b- instance FD Bool Nat where- meth = not- l2r False = 0- l2r True = 1- t1 = meth True- type T1Sym0 = T1- type family T1 where- T1 = Apply MethSym0 TrueSym0- type MethSym1 (arg0123456789876543210 :: a0123456789876543210) =- Meth arg0123456789876543210- instance SuppressUnusedWarnings MethSym0 where- suppressUnusedWarnings = snd (((,) MethSym0KindInference) ())- data MethSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- MethSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) =>- MethSym0 arg0123456789876543210- type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210- type L2rSym1 (arg0123456789876543210 :: a0123456789876543210) =- L2r arg0123456789876543210- instance SuppressUnusedWarnings L2rSym0 where- suppressUnusedWarnings = snd (((,) L2rSym0KindInference) ())- data L2rSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 b0123456789876543210- where- L2rSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) =>- L2rSym0 arg0123456789876543210- type instance Apply L2rSym0 arg0123456789876543210 = L2r arg0123456789876543210- class PFD (a :: GHC.Types.Type) (b :: GHC.Types.Type) | a -> b where- type Meth (arg :: a) :: a- type L2r (arg :: a) :: b- type family Meth_0123456789876543210 (a :: Bool) :: Bool where- Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210- type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) =- Meth_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Meth_0123456789876543210Sym0KindInference) ())- data Meth_0123456789876543210Sym0 :: (~>) Bool Bool- where- Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) =>- Meth_0123456789876543210Sym0 a0123456789876543210- type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210- type family L2r_0123456789876543210 (a :: Bool) :: Nat where- L2r_0123456789876543210 'False = FromInteger 0- L2r_0123456789876543210 'True = FromInteger 1- type L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) =- L2r_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) L2r_0123456789876543210Sym0KindInference) ())- data L2r_0123456789876543210Sym0 :: (~>) Bool Nat- where- L2r_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) =>- L2r_0123456789876543210Sym0 a0123456789876543210- type instance Apply L2r_0123456789876543210Sym0 a0123456789876543210 = L2r_0123456789876543210 a0123456789876543210- instance PFD Bool Nat where- type Meth a = Apply Meth_0123456789876543210Sym0 a- type L2r a = Apply L2r_0123456789876543210Sym0 a- sT1 :: Sing T1Sym0- sT1 = (applySing ((singFun1 @MethSym0) sMeth)) STrue- class SFD a b | a -> b where- sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a)- sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b)- instance SFD Bool Nat where- sMeth ::- forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool)- sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat)- sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210- sL2r SFalse = sFromInteger (sing :: Sing 0)- sL2r STrue = sFromInteger (sing :: Sing 1)- instance SFD a b => SingI (MethSym0 :: (~>) a a) where- sing = (singFun1 @MethSym0) sMeth- instance SFD a b => SingI (L2rSym0 :: (~>) a b) where- sing = (singFun1 @L2rSym0) sL2r
− tests/compile-and-dump/Singletons/FunDeps.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}--module Singletons.FunDeps where--import Data.Singletons.TH-import Data.Singletons.Prelude-import Data.Singletons.TypeLits--$( singletons [d|- class FD a b | a -> b where- meth :: a -> a- l2r :: a -> b-- instance FD Bool Nat where- meth = not- l2r False = 0- l2r True = 1-- t1 = meth True--- t2 = l2r False -- This fails because no FDs in type families- |])
− tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template
@@ -1,1646 +0,0 @@-Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data T x a- = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x)- deriving (Functor, Foldable, Traversable)- data Empty (a :: Type) deriving (Functor, Foldable, Traversable) |]- ======>- data T x a- = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x)- deriving (Functor, Foldable, Traversable)- data Empty (a :: Type) deriving (Functor, Foldable, Traversable)- type MkT1Sym4 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) (t0123456789876543210 :: Maybe (Maybe a0123456789876543210)) =- MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkT1Sym3KindInference) ())- data MkT1Sym3 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)- where- MkT1Sym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkT1Sym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkT1Sym2KindInference) ())- data MkT1Sym2 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))- where- MkT1Sym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym3 t0123456789876543210 t0123456789876543210 arg) =>- MkT1Sym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkT1Sym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkT1Sym1KindInference) ())- data MkT1Sym1 (t0123456789876543210 :: x0123456789876543210) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))- where- MkT1Sym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkT1Sym1 t0123456789876543210) arg) (MkT1Sym2 t0123456789876543210 arg) =>- MkT1Sym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkT1Sym0 where- suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ())- data MkT1Sym0 :: forall a0123456789876543210 x0123456789876543210.- (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))))- where- MkT1Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) =>- MkT1Sym0 t0123456789876543210- type instance Apply MkT1Sym0 t0123456789876543210 = MkT1Sym1 t0123456789876543210- type MkT2Sym1 (t0123456789876543210 :: Maybe x0123456789876543210) =- MkT2 t0123456789876543210- instance SuppressUnusedWarnings MkT2Sym0 where- suppressUnusedWarnings = snd (((,) MkT2Sym0KindInference) ())- data MkT2Sym0 :: forall a0123456789876543210 x0123456789876543210.- (~>) (Maybe x0123456789876543210) (T x0123456789876543210 a0123456789876543210)- where- MkT2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) =>- MkT2Sym0 t0123456789876543210- type instance Apply MkT2Sym0 t0123456789876543210 = MkT2 t0123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210- type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210- type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: T x a) :: T x b where- Fmap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply FmapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply FmapSym0 _f_0123456789876543210)) a_0123456789876543210)- Fmap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210)- type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) =- Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Fmap_0123456789876543210Sym1KindInference) ())- data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: forall x0123456789876543210.- (~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210)- where- Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) =>- Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Fmap_0123456789876543210Sym0KindInference) ())- data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- x0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210))- where- Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) =>- Fmap_0123456789876543210Sym0 a0123456789876543210- type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210- type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210- type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210- type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210- type Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210- type family TFHelper_0123456789876543210 (a :: a) (a :: T x b) :: T x a where- TFHelper_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (<$@#@$) _z_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply (<$@#@$) _z_0123456789876543210)) a_0123456789876543210)- TFHelper_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210)- type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 b0123456789876543210) =- TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ())- data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- x0123456789876543210.- (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210)- where- TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) =>- TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ())- data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- x0123456789876543210.- (~>) a0123456789876543210 ((~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210))- where- TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>- TFHelper_0123456789876543210Sym0 a0123456789876543210- type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210- instance PFunctor (T x) where- type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a- type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a- type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0- type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0- type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: T x a) :: m where- FoldMap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply MappendSym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply (Apply FoldMapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FoldMapSym0 (Apply FoldMapSym0 _f_0123456789876543210)) a_0123456789876543210)))- FoldMap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210- type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) =- FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ())- data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: forall x0123456789876543210.- (~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210- where- FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) =>- FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ())- data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210- m0123456789876543210- x0123456789876543210.- (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210)- where- FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) =>- FoldMap_0123456789876543210Sym0 a0123456789876543210- type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210- type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym7KindInference) ())- data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym6KindInference) ())- data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210- type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym7KindInference) ())- data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym6KindInference) ())- data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210- type Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym9KindInference) ())- data Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym9KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym8KindInference) ())- data Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym8KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym7KindInference) ())- data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym6KindInference) ())- data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- n2_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- n1_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210- type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym7KindInference) ())- data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym6KindInference) ())- data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym5KindInference) ())- data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210- type Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210- _z_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210- type family Foldr_0123456789876543210 (a :: (~>) a ((~>) b b)) (a :: b) (a :: T x a) :: b where- Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply _f_0123456789876543210 a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210)))- Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210- type Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) =- Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Foldr_0123456789876543210Sym2KindInference) ())- data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) :: forall x0123456789876543210.- (~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210- where- Foldr_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Foldr_0123456789876543210Sym1KindInference) ())- data Foldr_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210.- (~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210)- where- Foldr_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) arg) (Foldr_0123456789876543210Sym2 a0123456789876543210 arg) =>- Foldr_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Foldr_0123456789876543210Sym0KindInference) ())- data Foldr_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- x0123456789876543210.- (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) ((~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210))- where- Foldr_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) =>- Foldr_0123456789876543210Sym0 a0123456789876543210- type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210- instance PFoldable (T x) where- type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a- type Foldr a a a = Apply (Apply (Apply Foldr_0123456789876543210Sym0 a) a) a- type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: T x a) :: f (T x b) where- Traverse_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (<*>@#@$) (Apply (Apply (<*>@#@$) (Apply (Apply (Apply LiftA2Sym0 MkT1Sym0) (Apply PureSym0 a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210))) (Apply (Apply TraverseSym0 _f_0123456789876543210) a_0123456789876543210))) (Apply (Apply TraverseSym0 (Apply TraverseSym0 _f_0123456789876543210)) a_0123456789876543210)- Traverse_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply FmapSym0 MkT2Sym0) (Apply PureSym0 a_0123456789876543210)- type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) =- Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Traverse_0123456789876543210Sym1KindInference) ())- data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210.- (~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210))- where- Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) =>- Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Traverse_0123456789876543210Sym0KindInference) ())- data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- f0123456789876543210- x0123456789876543210.- (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210)))- where- Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) =>- Traverse_0123456789876543210Sym0 a0123456789876543210- type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210- instance PTraversable (T x) where- type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a- type family Case_0123456789876543210 v_0123456789876543210 t where- type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: Empty a) :: Empty b where- Fmap_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210- type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) =- Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Fmap_0123456789876543210Sym1KindInference) ())- data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Empty a0123456789876543210) (Empty b0123456789876543210)- where- Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) =>- Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Fmap_0123456789876543210Sym0KindInference) ())- data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Empty a0123456789876543210) (Empty b0123456789876543210))- where- Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) =>- Fmap_0123456789876543210Sym0 a0123456789876543210- type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210- type family Case_0123456789876543210 v_0123456789876543210 t where- type family TFHelper_0123456789876543210 (a :: a) (a :: Empty b) :: Empty a where- TFHelper_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210- type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Empty b0123456789876543210) =- TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ())- data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) (Empty b0123456789876543210) (Empty a0123456789876543210)- where- TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) =>- TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ())- data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) a0123456789876543210 ((~>) (Empty b0123456789876543210) (Empty a0123456789876543210))- where- TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>- TFHelper_0123456789876543210Sym0 a0123456789876543210- type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210- instance PFunctor Empty where- type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a- type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a- type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: Empty a) :: m where- FoldMap_0123456789876543210 _ _ = MemptySym0- type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) =- FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ())- data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: (~>) (Empty a0123456789876543210) m0123456789876543210- where- FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) =>- FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ())- data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210- m0123456789876543210.- (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (Empty a0123456789876543210) m0123456789876543210)- where- FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) =>- FoldMap_0123456789876543210Sym0 a0123456789876543210- type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210- instance PFoldable Empty where- type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a- type family Case_0123456789876543210 v_0123456789876543210 t where- type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: Empty a) :: f (Empty b) where- Traverse_0123456789876543210 _ v_0123456789876543210 = Apply PureSym0 (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)- type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: Empty a0123456789876543210) =- Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Traverse_0123456789876543210Sym1KindInference) ())- data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: (~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210))- where- Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) =>- Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Traverse_0123456789876543210Sym0KindInference) ())- data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- f0123456789876543210.- (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210)))- where- Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) =>- Traverse_0123456789876543210Sym0 a0123456789876543210- type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210- instance PTraversable Empty where- type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a- data instance Sing :: T x a -> Type- where- SMkT1 :: forall x- a- (n :: x)- (n :: a)- (n :: Maybe a)- (n :: Maybe (Maybe a)).- (Sing (n :: x))- -> (Sing (n :: a))- -> (Sing (n :: Maybe a))- -> (Sing (n :: Maybe (Maybe a))) -> Sing (MkT1 n n n n)- SMkT2 :: forall x (n :: Maybe x).- (Sing (n :: Maybe x)) -> Sing (MkT2 n)- type ST = (Sing :: T x a -> Type)- instance (SingKind x, SingKind a) => SingKind (T x a) where- type Demote (T x a) = T (Demote x) (Demote a)- fromSing (SMkT1 b b b b)- = (((MkT1 (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SMkT2 b) = MkT2 (fromSing b)- toSing- (MkT1 (b :: Demote x)- (b :: Demote a)- (b :: Demote (Maybe a))- (b :: Demote (Maybe (Maybe a))))- = case- ((((,,,) (toSing b :: SomeSing x)) (toSing b :: SomeSing a))- (toSing b :: SomeSing (Maybe a)))- (toSing b :: SomeSing (Maybe (Maybe a)))- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SMkT1 c) c) c) c) }- toSing (MkT2 (b :: Demote (Maybe x)))- = case toSing b :: SomeSing (Maybe x) of {- SomeSing c -> SomeSing (SMkT2 c) }- data instance Sing :: Empty a -> Type- type SEmpty = (Sing :: Empty a -> Type)- instance SingKind a => SingKind (Empty a) where- type Demote (Empty a) = Empty (Demote a)- fromSing x = case x of- toSing x = SomeSing (case x of)- instance SFunctor (T x) where- sFmap ::- forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: T x a).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (T x a) (T x b))- -> Type) t1) t2)- (%<$) ::- forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: T x b).- Sing t1- -> Sing t2- -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (T x b) (T x a))- -> Type) t1) t2)- sFmap- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing- ((applySing- ((applySing ((singFun4 @MkT1Sym0) SMkT1))- ((applySing- ((singFun1- @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210)- -> sN_0123456789876543210 })))- sA_0123456789876543210)))- ((applySing _sf_0123456789876543210) sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @FmapSym0) sFmap)) _sf_0123456789876543210))- sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @FmapSym0) sFmap))- ((applySing ((singFun2 @FmapSym0) sFmap))- _sf_0123456789876543210)))- sA_0123456789876543210)- sFmap- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing ((singFun1 @MkT2Sym0) SMkT2))- ((applySing- ((singFun1- @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 })))- sA_0123456789876543210)- (%<$)- (_sz_0123456789876543210 :: Sing _z_0123456789876543210)- (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing- ((applySing- ((applySing ((singFun4 @MkT1Sym0) SMkT1))- ((applySing- ((singFun1- @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210)- -> sN_0123456789876543210 })))- sA_0123456789876543210)))- ((applySing- ((singFun1- @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210) -> _sz_0123456789876543210 })))- sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(<$@#@$)) (%<$))) _sz_0123456789876543210))- sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @FmapSym0) sFmap))- ((applySing ((singFun2 @(<$@#@$)) (%<$)))- _sz_0123456789876543210)))- sA_0123456789876543210)- (%<$)- (_sz_0123456789876543210 :: Sing _z_0123456789876543210)- (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing ((singFun1 @MkT2Sym0) SMkT2))- ((applySing- ((singFun1- @(Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 })))- sA_0123456789876543210)- instance SFoldable (T x) where- sFoldMap ::- forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: T x a).- SMonoid m =>- Sing t1- -> Sing t2- -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (T x a) m)- -> Type) t1) t2)- sFoldr ::- forall (a :: Type)- (b :: Type)- (t1 :: (~>) a ((~>) b b))- (t2 :: b)- (t3 :: T x a).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (FoldrSym0 :: TyFun ((~>) a ((~>) b b)) ((~>) b ((~>) (T x a) b))- -> Type) t1) t2) t3)- sFoldMap- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing ((singFun2 @MappendSym0) sMappend))- ((applySing- ((singFun1- @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210) -> sMempty })))- sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @MappendSym0) sMappend))- ((applySing _sf_0123456789876543210) sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @MappendSym0) sMappend))- ((applySing- ((applySing ((singFun2 @FoldMapSym0) sFoldMap))- _sf_0123456789876543210))- sA_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @FoldMapSym0) sFoldMap))- ((applySing ((singFun2 @FoldMapSym0) sFoldMap))- _sf_0123456789876543210)))- sA_0123456789876543210)))- sFoldMap- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((singFun1- @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210))- (\ sN_0123456789876543210- -> case sN_0123456789876543210 of {- (_ :: Sing n_0123456789876543210) -> sMempty })))- sA_0123456789876543210- sFoldr- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (_sz_0123456789876543210 :: Sing _z_0123456789876543210)- (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing- ((singFun2- @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN1_0123456789876543210 sN2_0123456789876543210- -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of {- (,) (_ :: Sing n1_0123456789876543210)- (_ :: Sing n2_0123456789876543210)- -> sN2_0123456789876543210 })))- sA_0123456789876543210))- ((applySing- ((applySing _sf_0123456789876543210) sA_0123456789876543210))- ((applySing- ((applySing- ((singFun2- @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN1_0123456789876543210 sN2_0123456789876543210- -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of {- (,) (_ :: Sing n1_0123456789876543210)- (_ :: Sing n2_0123456789876543210)- -> (applySing- ((applySing- ((applySing ((singFun3 @FoldrSym0) sFoldr))- _sf_0123456789876543210))- sN2_0123456789876543210))- sN1_0123456789876543210 })))- sA_0123456789876543210))- ((applySing- ((applySing- ((singFun2- @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN1_0123456789876543210 sN2_0123456789876543210- -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of {- (,) (_ :: Sing n1_0123456789876543210)- (_ :: Sing n2_0123456789876543210)- -> (applySing- ((applySing- ((applySing ((singFun3 @FoldrSym0) sFoldr))- ((singFun2- @(Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210))- (\ sN1_0123456789876543210- sN2_0123456789876543210- -> case- ((,) sN1_0123456789876543210)- sN2_0123456789876543210- of {- (,) (_ :: Sing n1_0123456789876543210)- (_ :: Sing n2_0123456789876543210)- -> (applySing- ((applySing- ((applySing- ((singFun3- @FoldrSym0)- sFoldr))- _sf_0123456789876543210))- sN2_0123456789876543210))- sN1_0123456789876543210 }))))- sN2_0123456789876543210))- sN1_0123456789876543210 })))- sA_0123456789876543210))- _sz_0123456789876543210)))- sFoldr- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (_sz_0123456789876543210 :: Sing _z_0123456789876543210)- (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing- ((singFun2- @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210))- (\ sN1_0123456789876543210 sN2_0123456789876543210- -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of {- (,) (_ :: Sing n1_0123456789876543210)- (_ :: Sing n2_0123456789876543210)- -> sN2_0123456789876543210 })))- sA_0123456789876543210))- _sz_0123456789876543210- instance STraversable (T x) where- sTraverse ::- forall (f :: Type -> Type)- (a :: Type)- (b :: Type)- (t1 :: (~>) a (f b))- (t2 :: T x a).- SApplicative f =>- Sing t1- -> Sing t2- -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (T x a) (f (T x b)))- -> Type) t1) t2)- sTraverse- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing ((singFun2 @(<*>@#@$)) (%<*>)))- ((applySing- ((applySing ((singFun2 @(<*>@#@$)) (%<*>)))- ((applySing- ((applySing- ((applySing ((singFun3 @LiftA2Sym0) sLiftA2))- ((singFun4 @MkT1Sym0) SMkT1)))- ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210)))- ((applySing _sf_0123456789876543210) sA_0123456789876543210))))- ((applySing- ((applySing ((singFun2 @TraverseSym0) sTraverse))- _sf_0123456789876543210))- sA_0123456789876543210))))- ((applySing- ((applySing ((singFun2 @TraverseSym0) sTraverse))- ((applySing ((singFun2 @TraverseSym0) sTraverse))- _sf_0123456789876543210)))- sA_0123456789876543210)- sTraverse- (_sf_0123456789876543210 :: Sing _f_0123456789876543210)- (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210))- = (applySing- ((applySing ((singFun2 @FmapSym0) sFmap))- ((singFun1 @MkT2Sym0) SMkT2)))- ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210)- instance SFunctor Empty where- sFmap ::- forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: Empty a).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (Empty a) (Empty b))- -> Type) t1) t2)- (%<$) ::- forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: Empty b).- Sing t1- -> Sing t2- -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (Empty b) (Empty a))- -> Type) t1) t2)- sFmap _ (sV_0123456789876543210 :: Sing v_0123456789876543210)- = (case sV_0123456789876543210 of) ::- Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)- (%<$) _ (sV_0123456789876543210 :: Sing v_0123456789876543210)- = (case sV_0123456789876543210 of) ::- Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)- instance SFoldable Empty where- sFoldMap ::- forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: Empty a).- SMonoid m =>- Sing t1- -> Sing t2- -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (Empty a) m)- -> Type) t1) t2)- sFoldMap _ _ = sMempty- instance STraversable Empty where- sTraverse ::- forall (f :: Type -> Type)- (a :: Type)- (b :: Type)- (t1 :: (~>) a (f b))- (t2 :: Empty a).- SApplicative f =>- Sing t1- -> Sing t2- -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (Empty a) (f (Empty b)))- -> Type) t1) t2)- sTraverse _ (sV_0123456789876543210 :: Sing v_0123456789876543210)- = (applySing ((singFun1 @PureSym0) sPure))- ((case sV_0123456789876543210 of) ::- Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (MkT1 (n :: x) (n :: a) (n :: Maybe a) (n :: Maybe (Maybe a))) where- sing = (((SMkT1 sing) sing) sing) sing- instance SingI (MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where- sing = (singFun4 @MkT1Sym0) SMkT1- instance SingI (TyCon4 MkT1 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where- sing = (singFun4 @(TyCon4 MkT1)) SMkT1- instance SingI d =>- SingI (MkT1Sym1 (d :: x) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where- sing = (singFun3 @(MkT1Sym1 (d :: x))) (SMkT1 (sing @d))- instance SingI d =>- SingI (TyCon3 (MkT1 (d :: x)) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where- sing = (singFun3 @(TyCon3 (MkT1 (d :: x)))) (SMkT1 (sing @d))- instance (SingI d, SingI d) =>- SingI (MkT1Sym2 (d :: x) (d :: a) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where- sing- = (singFun2 @(MkT1Sym2 (d :: x) (d :: a)))- ((SMkT1 (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (MkT1 (d :: x) (d :: a)) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where- sing- = (singFun2 @(TyCon2 (MkT1 (d :: x) (d :: a))))- ((SMkT1 (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a) :: (~>) (Maybe (Maybe a)) (T x a)) where- sing- = (singFun1 @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a)))- (((SMkT1 (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a)) :: (~>) (Maybe (Maybe a)) (T x a)) where- sing- = (singFun1 @(TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a))))- (((SMkT1 (sing @d)) (sing @d)) (sing @d))- instance SingI n => SingI (MkT2 (n :: Maybe x)) where- sing = SMkT2 sing- instance SingI (MkT2Sym0 :: (~>) (Maybe x) (T x a)) where- sing = (singFun1 @MkT2Sym0) SMkT2- instance SingI (TyCon1 MkT2 :: (~>) (Maybe x) (T x a)) where- sing = (singFun1 @(TyCon1 MkT2)) SMkT2
− tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs
@@ -1,17 +0,0 @@-{-# LANGUAGE DeriveTraversable #-}--- Ensure that we can derive Functor, Foldable, and Traversable using only--- an import of Data.Singletons.TH-module FunctorLikeDeriving where--import Data.Kind-import Data.Singletons.TH--$(singletons [d|- data T x a- = MkT1 x a (Maybe a) (Maybe (Maybe a))- | MkT2 (Maybe x)- deriving (Functor, Foldable, Traversable)-- data Empty (a :: Type)- deriving (Functor, Foldable, Traversable)- |])
− tests/compile-and-dump/Singletons/HigherOrder.ghc86.template
@@ -1,480 +0,0 @@-Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| map :: (a -> b) -> [a] -> [b]- map _ [] = []- map f (h : t) = (f h) : (map f t)- liftMaybe :: (a -> b) -> Maybe a -> Maybe b- liftMaybe f (Just x) = Just (f x)- liftMaybe _ Nothing = Nothing- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]- zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys- zipWith _ [] [] = []- zipWith _ (_ : _) [] = []- zipWith _ [] (_ : _) = []- foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b- foo f g a = f g a- splunge :: [Nat] -> [Bool] -> [Nat]- splunge ns bs- = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs- etad :: [Nat] -> [Bool] -> [Nat]- etad = zipWith (\ n b -> if b then Succ (Succ n) else n)- - data Either a b = Left a | Right b |]- ======>- data Either a b = Left a | Right b- map :: (a -> b) -> [a] -> [b]- map _ [] = []- map f (h : t) = (f h : (map f) t)- liftMaybe :: (a -> b) -> Maybe a -> Maybe b- liftMaybe f (Just x) = Just (f x)- liftMaybe _ Nothing = Nothing- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]- zipWith f (x : xs) (y : ys) = ((f x) y : ((zipWith f) xs) ys)- zipWith _ [] [] = []- zipWith _ (_ : _) [] = []- zipWith _ [] (_ : _) = []- foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b- foo f g a = (f g) a- splunge :: [Nat] -> [Bool] -> [Nat]- splunge ns bs- = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs- etad :: [Nat] -> [Bool] -> [Nat]- etad = zipWith (\ n b -> if b then Succ (Succ n) else n)- type LeftSym1 (t0123456789876543210 :: a0123456789876543210) =- Left t0123456789876543210- instance SuppressUnusedWarnings LeftSym0 where- suppressUnusedWarnings = snd (((,) LeftSym0KindInference) ())- data LeftSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 (Either a0123456789876543210 b0123456789876543210)- where- LeftSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) =>- LeftSym0 t0123456789876543210- type instance Apply LeftSym0 t0123456789876543210 = Left t0123456789876543210- type RightSym1 (t0123456789876543210 :: b0123456789876543210) =- Right t0123456789876543210- instance SuppressUnusedWarnings RightSym0 where- suppressUnusedWarnings = snd (((,) RightSym0KindInference) ())- data RightSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) b0123456789876543210 (Either a0123456789876543210 b0123456789876543210)- where- RightSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) =>- RightSym0 t0123456789876543210- type instance Apply RightSym0 t0123456789876543210 = Right t0123456789876543210- type family Case_0123456789876543210 ns bs n b t where- Case_0123456789876543210 ns bs n b 'True = Apply SuccSym0 (Apply SuccSym0 n)- Case_0123456789876543210 ns bs n b 'False = n- type family Lambda_0123456789876543210 ns bs t t where- Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b- type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall ns0123456789876543210- bs0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall ns0123456789876543210- bs0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 bs0123456789876543210 ns0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ns0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall ns0123456789876543210- bs0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ns0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) bs0123456789876543210 = Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 ns0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall ns0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 ns0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210- type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'True = Apply SuccSym0 (Apply SuccSym0 n)- Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'False = n- type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b- type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210- type FooSym3 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) =- Foo a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) FooSym2KindInference) ())- data FooSym2 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210- where- FooSym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) =>- FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) FooSym1KindInference) ())- data FooSym1 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)- where- FooSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) =>- FooSym1 a0123456789876543210 a0123456789876543210- type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210))- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210- type ZipWithSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) =- ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) ZipWithSym2KindInference) ())- data ZipWithSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [b0123456789876543210] [c0123456789876543210]- where- ZipWithSym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) =>- ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) ZipWithSym1KindInference) ())- data ZipWithSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) :: (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210])- where- ZipWithSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) =>- ZipWithSym1 a0123456789876543210 a0123456789876543210- type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ZipWithSym0 where- suppressUnusedWarnings = snd (((,) ZipWithSym0KindInference) ())- data ZipWithSym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210.- (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) ((~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210]))- where- ZipWithSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) =>- ZipWithSym0 a0123456789876543210- type instance Apply ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210- type SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) =- Splunge a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ())- data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat]- where- SplungeSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) =>- SplungeSym1 a0123456789876543210 a0123456789876543210- type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings SplungeSym0 where- suppressUnusedWarnings = snd (((,) SplungeSym0KindInference) ())- data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])- where- SplungeSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) =>- SplungeSym0 a0123456789876543210- type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210- type EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) =- Etad a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ())- data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat]- where- EtadSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) =>- EtadSym1 a0123456789876543210 a0123456789876543210- type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings EtadSym0 where- suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ())- data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])- where- EtadSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) =>- EtadSym0 a0123456789876543210- type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210- type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) =- LiftMaybe a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ())- data LiftMaybeSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)- where- LiftMaybeSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) =>- LiftMaybeSym1 a0123456789876543210 a0123456789876543210- type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings LiftMaybeSym0 where- suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ())- data LiftMaybeSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210))- where- LiftMaybeSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>- LiftMaybeSym0 a0123456789876543210- type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210- type MapSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) =- Map a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) MapSym1KindInference) ())- data MapSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) [a0123456789876543210] [b0123456789876543210]- where- MapSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) =>- MapSym1 a0123456789876543210 a0123456789876543210- type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = Map a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings MapSym0 where- suppressUnusedWarnings = snd (((,) MapSym0KindInference) ())- data MapSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) [a0123456789876543210] [b0123456789876543210])- where- MapSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) =>- MapSym0 a0123456789876543210- type instance Apply MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210- type family Foo (a :: (~>) ((~>) a b) ((~>) a b)) (a :: (~>) a b) (a :: a) :: b where- Foo f g a = Apply (Apply f g) a- type family ZipWith (a :: (~>) a ((~>) b c)) (a :: [a]) (a :: [b]) :: [c] where- ZipWith f ( '(:) x xs) ( '(:) y ys) = Apply (Apply (:@#@$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys)- ZipWith _ '[] '[] = '[]- ZipWith _ ( '(:) _ _) '[] = '[]- ZipWith _ '[] ( '(:) _ _) = '[]- type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where- Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs- type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where- Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210- type family LiftMaybe (a :: (~>) a b) (a :: Maybe a) :: Maybe b where- LiftMaybe f ( 'Just x) = Apply JustSym0 (Apply f x)- LiftMaybe _ 'Nothing = NothingSym0- type family Map (a :: (~>) a b) (a :: [a]) :: [b] where- Map _ '[] = '[]- Map f ( '(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t)- sFoo ::- forall a- b- (t :: (~>) ((~>) a b) ((~>) a b))- (t :: (~>) a b)- (t :: a).- Sing t- -> Sing t- -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b)- sZipWith ::- forall a b c (t :: (~>) a ((~>) b c)) (t :: [a]) (t :: [b]).- Sing t- -> Sing t- -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c])- sSplunge ::- forall (t :: [Nat]) (t :: [Bool]).- Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat])- sEtad ::- forall (t :: [Nat]) (t :: [Bool]).- Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat])- sLiftMaybe ::- forall a b (t :: (~>) a b) (t :: Maybe a).- Sing t- -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b)- sMap ::- forall a b (t :: (~>) a b) (t :: [a]).- Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b])- sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a)- = (applySing ((applySing sF) sG)) sA- sZipWith- (sF :: Sing f)- (SCons (sX :: Sing x) (sXs :: Sing xs))- (SCons (sY :: Sing y) (sYs :: Sing ys))- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((applySing sF) sX)) sY)))- ((applySing- ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF))- sXs))- sYs)- sZipWith _ SNil SNil = SNil- sZipWith _ (SCons _ _) SNil = SNil- sZipWith _ SNil (SCons _ _) = SNil- sSplunge (sNs :: Sing ns) (sBs :: Sing bs)- = (applySing- ((applySing- ((applySing ((singFun3 @ZipWithSym0) sZipWith))- ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs))- (\ sN sB- -> case ((,) sN) sB of {- (,) (_ :: Sing n) (_ :: Sing b)- -> (case sB of- STrue- -> (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((singFun1 @SuccSym0) SSucc)) sN)- SFalse -> sN) ::- Sing (Case_0123456789876543210 ns bs n b b) }))))- sNs))- sBs- sEtad- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ZipWithSym0) sZipWith))- ((singFun2- @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210))- (\ sN sB- -> case ((,) sN) sB of {- (,) (_ :: Sing n) (_ :: Sing b)- -> (case sB of- STrue- -> (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((singFun1 @SuccSym0) SSucc)) sN)- SFalse -> sN) ::- Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) }))))- sA_0123456789876543210))- sA_0123456789876543210- sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x))- = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX)- sLiftMaybe _ SNothing = SNothing- sMap _ SNil = SNil- sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t))- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH)))- ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT)- instance SingI (FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))) where- sing = (singFun3 @FooSym0) sFoo- instance SingI d =>- SingI (FooSym1 (d :: (~>) ((~>) a b) ((~>) a b)) :: (~>) ((~>) a b) ((~>) a b)) where- sing- = (singFun2 @(FooSym1 (d :: (~>) ((~>) a b) ((~>) a b))))- (sFoo (sing @d))- instance (SingI d, SingI d) =>- SingI (FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b) :: (~>) a b) where- sing- = (singFun1- @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b)))- ((sFoo (sing @d)) (sing @d))- instance SingI (ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c]))) where- sing = (singFun3 @ZipWithSym0) sZipWith- instance SingI d =>- SingI (ZipWithSym1 (d :: (~>) a ((~>) b c)) :: (~>) [a] ((~>) [b] [c])) where- sing- = (singFun2 @(ZipWithSym1 (d :: (~>) a ((~>) b c))))- (sZipWith (sing @d))- instance (SingI d, SingI d) =>- SingI (ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]) :: (~>) [b] [c]) where- sing- = (singFun1 @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a])))- ((sZipWith (sing @d)) (sing @d))- instance SingI (SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where- sing = (singFun2 @SplungeSym0) sSplunge- instance SingI d =>- SingI (SplungeSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where- sing = (singFun1 @(SplungeSym1 (d :: [Nat]))) (sSplunge (sing @d))- instance SingI (EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where- sing = (singFun2 @EtadSym0) sEtad- instance SingI d =>- SingI (EtadSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where- sing = (singFun1 @(EtadSym1 (d :: [Nat]))) (sEtad (sing @d))- instance SingI (LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))) where- sing = (singFun2 @LiftMaybeSym0) sLiftMaybe- instance SingI d =>- SingI (LiftMaybeSym1 (d :: (~>) a b) :: (~>) (Maybe a) (Maybe b)) where- sing- = (singFun1 @(LiftMaybeSym1 (d :: (~>) a b)))- (sLiftMaybe (sing @d))- instance SingI (MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b])) where- sing = (singFun2 @MapSym0) sMap- instance SingI d =>- SingI (MapSym1 (d :: (~>) a b) :: (~>) [a] [b]) where- sing = (singFun1 @(MapSym1 (d :: (~>) a b))) (sMap (sing @d))- data instance Sing :: Either a b -> GHC.Types.Type- where- SLeft :: forall a (n :: a). (Sing (n :: a)) -> Sing (Left n)- SRight :: forall b (n :: b). (Sing (n :: b)) -> Sing (Right n)- type SEither = (Sing :: Either a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (Either a b) where- type Demote (Either a b) = Either (Demote a) (Demote b)- fromSing (SLeft b) = Left (fromSing b)- fromSing (SRight b) = Right (fromSing b)- toSing (Left (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SLeft c) }- toSing (Right (b :: Demote b))- = case toSing b :: SomeSing b of {- SomeSing c -> SomeSing (SRight c) }- instance SingI n => SingI (Left (n :: a)) where- sing = SLeft sing- instance SingI (LeftSym0 :: (~>) a (Either a b)) where- sing = (singFun1 @LeftSym0) SLeft- instance SingI (TyCon1 Left :: (~>) a (Either a b)) where- sing = (singFun1 @(TyCon1 Left)) SLeft- instance SingI n => SingI (Right (n :: b)) where- sing = SRight sing- instance SingI (RightSym0 :: (~>) b (Either a b)) where- sing = (singFun1 @RightSym0) SRight- instance SingI (TyCon1 Right :: (~>) b (Either a b)) where- sing = (singFun1 @(TyCon1 Right)) SRight
− tests/compile-and-dump/Singletons/HigherOrder.hs
@@ -1,57 +0,0 @@-module Singletons.HigherOrder where--import Data.Singletons-import Data.Singletons.TH-import Data.Singletons.Prelude.List hiding (- sMap, Map, MapSym0, MapSym1, MapSym2,- ZipWith, sZipWith, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3 )-import Data.Singletons.Prelude.Maybe-import Singletons.Nat-import Prelude hiding (Either(..))-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- data Either a b = Left a | Right b-- map :: (a -> b) -> [a] -> [b]- map _ [] = []- map f (h:t) = (f h) : (map f t)-- liftMaybe :: (a -> b) -> Maybe a -> Maybe b- liftMaybe f (Just x) = Just (f x)- liftMaybe _ Nothing = Nothing-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]- zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys- zipWith _ [] [] = []- zipWith _ (_:_) [] = []- zipWith _ [] (_:_) = []-- foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b- foo f g a = f g a-- splunge :: [Nat] -> [Bool] -> [Nat]- splunge ns bs = zipWith (\n b -> if b then Succ (Succ n) else n) ns bs-- etad :: [Nat] -> [Bool] -> [Nat]- etad = zipWith (\n b -> if b then Succ (Succ n) else n)-- |])--foo1a :: Proxy (ZipWith (TyCon Either) '[Int, Bool] '[Char, Double])-foo1a = Proxy--foo1b :: Proxy ('[Either Int Char, Either Bool Double])-foo1b = foo1a--foo2a :: Proxy (Map (TyCon (Either Int)) '[Bool, Double])-foo2a = Proxy--foo2b :: Proxy ('[Either Int Bool, Either Int Double])-foo2b = foo2a--foo3a :: Proxy (Map PredSym0 '[Succ Zero, Succ (Succ Zero)])-foo3a = Proxy--foo3b :: Proxy '[Zero, Succ Zero]-foo3b = foo3a
− tests/compile-and-dump/Singletons/LambdaCase.ghc86.template
@@ -1,252 +0,0 @@-Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo1 :: a -> Maybe a -> a- foo1 d x- = (\case- Just y -> y- Nothing -> d)- x- foo2 :: a -> Maybe a -> a- foo2 d _- = (\case- Just y -> y- Nothing -> d)- (Just d)- foo3 :: a -> b -> a- foo3 a b = (\case (p, _) -> p) (a, b) |]- ======>- foo1 :: a -> Maybe a -> a- foo1 d x- = (\case- Just y -> y- Nothing -> d)- x- foo2 :: a -> Maybe a -> a- foo2 d _- = (\case- Just y -> y- Nothing -> d)- (Just d)- foo3 :: a -> b -> a- foo3 a b = (\case (p, _) -> p) (a, b)- type family Case_0123456789876543210 a b x_0123456789876543210 t where- Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p- type family Lambda_0123456789876543210 a b t where- Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210- type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210- b0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210- b0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210- type family Case_0123456789876543210 d x_0123456789876543210 t where- Case_0123456789876543210 d x_0123456789876543210 ( 'Just y) = y- Case_0123456789876543210 d x_0123456789876543210 'Nothing = d- type family Lambda_0123456789876543210 d t where- Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210- type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 d0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 d0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210- type family Case_0123456789876543210 d x x_0123456789876543210 t where- Case_0123456789876543210 d x x_0123456789876543210 ( 'Just y) = y- Case_0123456789876543210 d x x_0123456789876543210 'Nothing = d- type family Lambda_0123456789876543210 d x t where- Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210- type Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall d0123456789876543210- x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 d0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210- x0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 d0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 d0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210- type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo3 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ())- data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo3Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) =>- Foo3Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 a0123456789876543210- type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210- type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ())- data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo2Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>- Foo2Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo2Sym0 where- suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ())- data Foo2Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210)- where- Foo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>- Foo2Sym0 a0123456789876543210- type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210- type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ())- data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo1Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>- Foo1Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210)- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210- type family Foo3 (a :: a) (a :: b) :: a where- Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b)- type family Foo2 (a :: a) (a :: Maybe a) :: a where- Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d)- type family Foo1 (a :: a) (a :: Maybe a) :: a where- Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x- sFoo3 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a)- sFoo2 ::- forall a (t :: a) (t :: Maybe a).- Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)- sFoo1 ::- forall a (t :: a) (t :: Maybe a).- Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a)- sFoo3 (sA :: Sing a) (sB :: Sing b)- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b))- (\ sX_0123456789876543210- -> case sX_0123456789876543210 of {- (_ :: Sing x_0123456789876543210)- -> (case sX_0123456789876543210 of {- STuple2 (sP :: Sing p) _ -> sP }) ::- Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) })))- ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB)- sFoo2 (sD :: Sing d) _- = (applySing- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d))- (\ sX_0123456789876543210- -> case sX_0123456789876543210 of {- (_ :: Sing x_0123456789876543210)- -> (case sX_0123456789876543210 of- SJust (sY :: Sing y) -> sY- SNothing -> sD) ::- Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) })))- ((applySing ((singFun1 @JustSym0) SJust)) sD)- sFoo1 (sD :: Sing d) (sX :: Sing x)- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x))- (\ sX_0123456789876543210- -> case sX_0123456789876543210 of {- (_ :: Sing x_0123456789876543210)- -> (case sX_0123456789876543210 of- SJust (sY :: Sing y) -> sY- SNothing -> sD) ::- Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) })))- sX- instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo3Sym0) sFoo3- instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d))- instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where- sing = (singFun2 @Foo2Sym0) sFoo2- instance SingI d =>- SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where- sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d))- instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where- sing = (singFun2 @Foo1Sym0) sFoo1- instance SingI d =>- SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where- sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d))
− tests/compile-and-dump/Singletons/LambdaCase.hs
@@ -1,39 +0,0 @@-module Singletons.LambdaCase where--import Data.Singletons.Prelude-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH--$(singletons [d|- foo1 :: a -> Maybe a -> a- foo1 d x = (\case- Just y -> y- Nothing -> d) x-- foo2 :: a -> Maybe a -> a- foo2 d _ = (\case- Just y -> y- Nothing -> d) (Just d)-- foo3 :: a -> b -> a- foo3 a b = (\case- (p, _) -> p) (a, b)- |])--foo1a :: Proxy (Foo1 Int (Just Char))-foo1a = Proxy--foo1b :: Proxy Char-foo1b = foo1a--foo2a :: Proxy (Foo2 Char Nothing)-foo2a = Proxy--foo2b :: Proxy Char-foo2b = foo2a--foo3a :: Proxy (Foo3 Int Char)-foo3a = Proxy--foo3b :: Proxy Int-foo3b = foo3a
− tests/compile-and-dump/Singletons/Lambdas.ghc86.template
@@ -1,830 +0,0 @@-Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo0 :: a -> b -> a- foo0 = (\ x y -> x)- foo1 :: a -> b -> a- foo1 x = (\ _ -> x)- foo2 :: a -> b -> a- foo2 x y = (\ _ -> x) y- foo3 :: a -> a- foo3 x = (\ y -> y) x- foo4 :: a -> b -> c -> a- foo4 x y z = (\ _ _ -> x) y z- foo5 :: a -> b -> b- foo5 x y = (\ x -> x) y- foo6 :: a -> b -> a- foo6 a b = (\ x -> \ _ -> x) a b- foo7 :: a -> b -> b- foo7 x y = (\ (_, b) -> b) (x, y)- foo8 :: Foo a b -> a- foo8 x = (\ (Foo a _) -> a) x- - data Foo a b = Foo a b |]- ======>- foo0 :: a -> b -> a- foo0 = \ x y -> x- foo1 :: a -> b -> a- foo1 x = \ _ -> x- foo2 :: a -> b -> a- foo2 x y = (\ _ -> x) y- foo3 :: a -> a- foo3 x = (\ y -> y) x- foo4 :: a -> b -> c -> a- foo4 x y z = ((\ _ _ -> x) y) z- foo5 :: a -> b -> b- foo5 x y = (\ x -> x) y- foo6 :: a -> b -> a- foo6 a b = ((\ x -> \ _ -> x) a) b- foo7 :: a -> b -> b- foo7 x y = (\ (_, b) -> b) (x, y)- data Foo a b = Foo a b- foo8 :: Foo a b -> a- foo8 x = (\ (Foo a _) -> a) x- type FooSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- Foo t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (FooSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) FooSym1KindInference) ())- data FooSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)- where- FooSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (FooSym1 t0123456789876543210) arg) (FooSym2 t0123456789876543210 arg) =>- FooSym1 t0123456789876543210 t0123456789876543210- type instance Apply (FooSym1 t0123456789876543210) t0123456789876543210 = Foo t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210))- where- FooSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 t0123456789876543210- type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210- type family Case_0123456789876543210 x arg_0123456789876543210 t where- Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a- type family Lambda_0123456789876543210 x t where- Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x y arg_0123456789876543210 t where- Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b- type family Lambda_0123456789876543210 x y t where- Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 a b x arg_0123456789876543210 t where- Case_0123456789876543210 a b x arg_0123456789876543210 _ = x- type family Lambda_0123456789876543210 a b x t where- Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210- b0123456789876543210- x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210- b0123456789876543210- x0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210- b0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210- type family Lambda_0123456789876543210 a b t where- Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x- type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210- b0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210- b0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210- type family Lambda_0123456789876543210 x y t where- Lambda_0123456789876543210 x y x = x- type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where- Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_,- _) = x- type family Lambda_0123456789876543210 x y z t t where- Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)- type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210- y0123456789876543210- z0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210- y0123456789876543210- z0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- z0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 z0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Lambda_0123456789876543210 x t where- Lambda_0123456789876543210 x y = y- type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x y arg_0123456789876543210 t where- Case_0123456789876543210 x y arg_0123456789876543210 _ = x- type family Lambda_0123456789876543210 x y t where- Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x- type family Lambda_0123456789876543210 x a_0123456789876543210 t where- Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where- Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x- type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210- type Foo8Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) =- Foo8 a0123456789876543210- instance SuppressUnusedWarnings Foo8Sym0 where- suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ())- data Foo8Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210- where- Foo8Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>- Foo8Sym0 a0123456789876543210- type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210- type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo7 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ())- data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Foo7Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) =>- Foo7Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo7Sym0 where- suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ())- data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Foo7Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>- Foo7Sym0 a0123456789876543210- type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210- type Foo6Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo6 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo6Sym1KindInference) ())- data Foo6Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo6Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) =>- Foo6Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo6Sym0 where- suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ())- data Foo6Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo6Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>- Foo6Sym0 a0123456789876543210- type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210- type Foo5Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo5 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo5Sym1KindInference) ())- data Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Foo5Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) =>- Foo5Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo5Sym0 where- suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ())- data Foo5Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Foo5Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>- Foo5Sym0 a0123456789876543210- type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210- type Foo4Sym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) =- Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo4Sym2KindInference) ())- data Foo4Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210.- (~>) c0123456789876543210 a0123456789876543210- where- Foo4Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) =>- Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo4Sym1KindInference) ())- data Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210)- where- Foo4Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) =>- Foo4Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo4Sym0 where- suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ())- data Foo4Sym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210))- where- Foo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>- Foo4Sym0 a0123456789876543210- type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210- type Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo3 a0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 a0123456789876543210- type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210- type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ())- data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo2Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>- Foo2Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo2Sym0 where- suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ())- data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>- Foo2Sym0 a0123456789876543210- type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210- type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ())- data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo1Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>- Foo1Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210- type Foo0Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo0 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo0Sym1KindInference) ())- data Foo0Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo0Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) =>- Foo0Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo0Sym0 where- suppressUnusedWarnings = snd (((,) Foo0Sym0KindInference) ())- data Foo0Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo0Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) =>- Foo0Sym0 a0123456789876543210- type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210- type family Foo8 (a :: Foo a b) :: a where- Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x- type family Foo7 (a :: a) (a :: b) :: b where- Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y)- type family Foo6 (a :: a) (a :: b) :: a where- Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b- type family Foo5 (a :: a) (a :: b) :: b where- Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y- type family Foo4 (a :: a) (a :: b) (a :: c) :: a where- Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z- type family Foo3 (a :: a) :: a where- Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x- type family Foo2 (a :: a) (a :: b) :: a where- Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y- type family Foo1 (a :: a) (a :: b) :: a where- Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210- type family Foo0 (a :: a) (a :: b) :: a where- Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210- sFoo8 ::- forall a b (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a)- sFoo7 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b)- sFoo6 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a)- sFoo5 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b)- sFoo4 ::- forall a b c (t :: a) (t :: b) (t :: c).- Sing t- -> Sing t- -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a)- sFoo3 :: forall a (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a)- sFoo2 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)- sFoo1 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a)- sFoo0 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a)- sFoo8 (sX :: Sing x)- = (applySing- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of {- SFoo (sA :: Sing a) _ -> sA }) ::- Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) })))- sX- sFoo7 (sX :: Sing x) (sY :: Sing y)- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of {- STuple2 _ (sB :: Sing b) -> sB }) ::- Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) })))- ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY)- sFoo6 (sA :: Sing a) (sB :: Sing b)- = (applySing- ((applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b))- (\ sX- -> case sX of {- (_ :: Sing x)- -> (singFun1- @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sX }) ::- Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) })))- sA))- sB- sFoo5 (sX :: Sing x) (sY :: Sing y)- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y))- (\ sX -> case sX of { (_ :: Sing x) -> sX })))- sY- sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z)- = (applySing- ((applySing- ((singFun2- @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z))- (\ sArg_0123456789876543210 sArg_0123456789876543210- -> case- ((,) sArg_0123456789876543210) sArg_0123456789876543210- of {- (,) (_ :: Sing arg_0123456789876543210)- (_ :: Sing arg_0123456789876543210)- -> (case- (applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2))- sArg_0123456789876543210))- sArg_0123456789876543210- of {- STuple2 _ _ -> sX }) ::- Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) })))- sY))- sZ- sFoo3 (sX :: Sing x)- = (applySing- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x))- (\ sY -> case sY of { (_ :: Sing y) -> sY })))- sX- sFoo2 (sX :: Sing x) (sY :: Sing y)- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sX }) ::- Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) })))- sY- sFoo1- (sX :: Sing x)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((singFun1- @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sX }) ::- Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) })))- sA_0123456789876543210- sFoo0- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((singFun2- @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210))- (\ sX sY- -> case ((,) sX) sY of { (,) (_ :: Sing x) (_ :: Sing y) -> sX })))- sA_0123456789876543210))- sA_0123456789876543210- instance SingI (Foo8Sym0 :: (~>) (Foo a b) a) where- sing = (singFun1 @Foo8Sym0) sFoo8- instance SingI (Foo7Sym0 :: (~>) a ((~>) b b)) where- sing = (singFun2 @Foo7Sym0) sFoo7- instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b b) where- sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d))- instance SingI (Foo6Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo6Sym0) sFoo6- instance SingI d => SingI (Foo6Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo6Sym1 (d :: a))) (sFoo6 (sing @d))- instance SingI (Foo5Sym0 :: (~>) a ((~>) b b)) where- sing = (singFun2 @Foo5Sym0) sFoo5- instance SingI d => SingI (Foo5Sym1 (d :: a) :: (~>) b b) where- sing = (singFun1 @(Foo5Sym1 (d :: a))) (sFoo5 (sing @d))- instance SingI (Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))) where- sing = (singFun3 @Foo4Sym0) sFoo4- instance SingI d =>- SingI (Foo4Sym1 (d :: a) :: (~>) b ((~>) c a)) where- sing = (singFun2 @(Foo4Sym1 (d :: a))) (sFoo4 (sing @d))- instance (SingI d, SingI d) =>- SingI (Foo4Sym2 (d :: a) (d :: b) :: (~>) c a) where- sing- = (singFun1 @(Foo4Sym2 (d :: a) (d :: b)))- ((sFoo4 (sing @d)) (sing @d))- instance SingI (Foo3Sym0 :: (~>) a a) where- sing = (singFun1 @Foo3Sym0) sFoo3- instance SingI (Foo2Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo2Sym0) sFoo2- instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d))- instance SingI (Foo1Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo1Sym0) sFoo1- instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d))- instance SingI (Foo0Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo0Sym0) sFoo0- instance SingI d => SingI (Foo0Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo0Sym1 (d :: a))) (sFoo0 (sing @d))- data instance Sing :: Foo a b -> GHC.Types.Type- where- SFoo :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Foo n n)- type SFoo = (Sing :: Foo a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (Foo a b) where- type Demote (Foo a b) = Foo (Demote a) (Demote b)- fromSing (SFoo b b) = (Foo (fromSing b)) (fromSing b)- toSing (Foo (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) }- instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where- sing = (SFoo sing) sing- instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where- sing = (singFun2 @FooSym0) SFoo- instance SingI (TyCon2 Foo :: (~>) a ((~>) b (Foo a b))) where- sing = (singFun2 @(TyCon2 Foo)) SFoo- instance SingI d =>- SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where- sing = (singFun1 @(FooSym1 (d :: a))) (SFoo (sing @d))- instance SingI d =>- SingI (TyCon1 (Foo (d :: a)) :: (~>) b (Foo a b)) where- sing = (singFun1 @(TyCon1 (Foo (d :: a)))) (SFoo (sing @d))
− tests/compile-and-dump/Singletons/Lambdas.hs
@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing #-}--{-# LANGUAGE UnboxedTuples #-}--- We expect unused binds and name shadowing in foo5 test.-module Singletons.Lambdas where--import Data.Proxy-import Data.Singletons-import Data.Singletons.TH--$(singletons [d|- -- nothing in scope- foo0 :: a -> b -> a- foo0 = (\x y -> x)-- -- eta-reduced function- foo1 :: a -> b -> a- foo1 x = (\_ -> x)-- -- same as before, but without eta-reduction- foo2 :: a -> b -> a- foo2 x y = (\_ -> x) y-- foo3 :: a -> a- foo3 x = (\y -> y) x-- -- more lambda parameters + returning in-scope variable- foo4 :: a -> b -> c -> a- foo4 x y z = (\_ _ -> x) y z-- -- name shadowing- -- Note: due to -dsuppress-uniques output of this test does not really- -- prove that the result is correct. Compiling this file manually and- -- examining dumped splise of relevant Lamdba reveals that indeed that Lambda- -- returns its last parameter (ie. y passed in a call) rather than the- -- first one (ie. x that is shadowed by the binder in a lambda).- foo5 :: a -> b -> b- foo5 x y = (\x -> x) y-- -- nested lambdas- foo6 :: a -> b -> a- foo6 a b = (\x -> \_ -> x) a b-- -- tuple patterns- foo7 :: a -> b -> b- foo7 x y = (\(_, b) -> b) (x, y)-- -- constructor patters=ns- data Foo a b = Foo a b- foo8 :: Foo a b -> a- foo8 x = (\(Foo a _) -> a) x- |])--foo1a :: Proxy (Foo1 Int Char)-foo1a = Proxy--foo1b :: Proxy Int-foo1b = foo1a--foo2a :: Proxy (Foo2 Int Char)-foo2a = Proxy--foo2b :: Proxy Int-foo2b = foo2a--foo3a :: Proxy (Foo3 Int)-foo3a = Proxy--foo3b :: Proxy Int-foo3b = foo3a--foo4a :: Proxy (Foo4 Int Char Bool)-foo4a = Proxy--foo4b :: Proxy Int-foo4b = foo4a--foo5a :: Proxy (Foo5 Int Bool)-foo5a = Proxy--foo5b :: Proxy Bool-foo5b = foo5a--foo6a :: Proxy (Foo6 Int Char)-foo6a = Proxy--foo6b :: Proxy Int-foo6b = foo6a--foo7a :: Proxy (Foo7 Int Char)-foo7a = Proxy--foo7b :: Proxy Char-foo7b = foo7a
− tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.template
@@ -1,71 +0,0 @@-Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: [Nat]- foo- = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)]- bar :: [Nat]- bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |]- ======>- foo :: [Nat]- foo- = (map (\ x -> ((either_ pred) Succ) x))- [Left Zero, Right (Succ Zero)]- bar :: [Nat]- bar = (map ((either_ pred) Succ)) [Left Zero, Right (Succ Zero)]- type family Lambda_0123456789876543210 t where- Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x- type Lambda_0123456789876543210Sym1 t0123456789876543210 =- Lambda_0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 t0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 t0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210- type BarSym0 = Bar- type FooSym0 = Foo- type family Bar :: [Nat] where- Bar = Apply (Apply MapSym0 (Apply (Apply Either_Sym0 PredSym0) SuccSym0)) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[]))- type family Foo :: [Nat] where- Foo = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[]))- sBar :: Sing (BarSym0 :: [Nat])- sFoo :: Sing (FooSym0 :: [Nat])- sBar- = (applySing- ((applySing ((singFun2 @MapSym0) sMap))- ((applySing- ((applySing ((singFun3 @Either_Sym0) sEither_))- ((singFun1 @PredSym0) sPred)))- ((singFun1 @SuccSym0) SSucc))))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @LeftSym0) SLeft)) SZero)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @RightSym0) SRight))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))))- SNil))- sFoo- = (applySing- ((applySing ((singFun2 @MapSym0) sMap))- ((singFun1 @Lambda_0123456789876543210Sym0)- (\ sX- -> case sX of {- (_ :: Sing x)- -> (applySing- ((applySing- ((applySing ((singFun3 @Either_Sym0) sEither_))- ((singFun1 @PredSym0) sPred)))- ((singFun1 @SuccSym0) SSucc)))- sX }))))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @LeftSym0) SLeft)) SZero)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @RightSym0) SRight))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))))- SNil))
− tests/compile-and-dump/Singletons/LambdasComprehensive.hs
@@ -1,29 +0,0 @@-module Singletons.LambdasComprehensive where--import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Data.Singletons.Prelude-import Singletons.Nat--import Prelude hiding (pred)--$(singletons [d|- foo :: [Nat]- foo = map (\x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)]-- -- this is the same as above except that it does not use lambdas- bar :: [Nat]- bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)]- |])--fooTest1a :: Proxy Foo-fooTest1a = Proxy--fooTest1b :: Proxy [Zero, Succ (Succ Zero)]-fooTest1b = fooTest1a--barTest1a :: Proxy Bar-barTest1a = Proxy--barTest1b :: Proxy [Zero, Succ (Succ Zero)]-barTest1b = barTest1a
− tests/compile-and-dump/Singletons/LetStatements.ghc86.template
@@ -1,1002 +0,0 @@-Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo1 :: Nat -> Nat- foo1 x- = let- y :: Nat- y = Succ Zero- in y- foo2 :: Nat- foo2- = let- y = Succ Zero- z = Succ y- in z- foo3 :: Nat -> Nat- foo3 x- = let- y :: Nat- y = Succ x- in y- foo4 :: Nat -> Nat- foo4 x- = let- f :: Nat -> Nat- f y = Succ y- in f x- foo5 :: Nat -> Nat- foo5 x- = let- f :: Nat -> Nat- f y- = let- z :: Nat- z = Succ y- in Succ z- in f x- foo6 :: Nat -> Nat- foo6 x- = let- f :: Nat -> Nat- f y = Succ y in- let- z :: Nat- z = f x- in z- foo7 :: Nat -> Nat- foo7 x- = let- x :: Nat- x = Zero- in x- foo8 :: Nat -> Nat- foo8 x- = let- z :: Nat- z = (\ x -> x) Zero- in z- foo9 :: Nat -> Nat- foo9 x- = let- z :: Nat -> Nat- z = (\ x -> x)- in z x- foo10 :: Nat -> Nat- foo10 x- = let- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- in (Succ Zero) + x- foo11 :: Nat -> Nat- foo11 x- = let- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- z :: Nat- z = x- in (Succ Zero) + z- foo12 :: Nat -> Nat- foo12 x- = let- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + x)- in x + (Succ (Succ Zero))- foo13 :: forall a. a -> a- foo13 x- = let- bar :: a- bar = x- in foo13_ bar- foo13_ :: a -> a- foo13_ y = y- foo14 :: Nat -> (Nat, Nat)- foo14 x = let (y, z) = (Succ x, x) in (z, y) |]- ======>- foo1 :: Nat -> Nat- foo1 x- = let- y :: Nat- y = Succ Zero- in y- foo2 :: Nat- foo2- = let- y = Succ Zero- z = Succ y- in z- foo3 :: Nat -> Nat- foo3 x- = let- y :: Nat- y = Succ x- in y- foo4 :: Nat -> Nat- foo4 x- = let- f :: Nat -> Nat- f y = Succ y- in f x- foo5 :: Nat -> Nat- foo5 x- = let- f :: Nat -> Nat- f y- = let- z :: Nat- z = Succ y- in Succ z- in f x- foo6 :: Nat -> Nat- foo6 x- = let- f :: Nat -> Nat- f y = Succ y in- let- z :: Nat- z = f x- in z- foo7 :: Nat -> Nat- foo7 x- = let- x :: Nat- x = Zero- in x- foo8 :: Nat -> Nat- foo8 x- = let- z :: Nat- z = (\ x -> x) Zero- in z- foo9 :: Nat -> Nat- foo9 x- = let- z :: Nat -> Nat- z = \ x -> x- in z x- foo10 :: Nat -> Nat- foo10 x- = let- (+) :: Nat -> Nat -> Nat- (+) Zero m = m- (+) (Succ n) m = Succ (n + m)- in (Succ Zero + x)- foo11 :: Nat -> Nat- foo11 x- = let- (+) :: Nat -> Nat -> Nat- z :: Nat- (+) Zero m = m- (+) (Succ n) m = Succ (n + m)- z = x- in (Succ Zero + z)- foo12 :: Nat -> Nat- foo12 x- = let- (+) :: Nat -> Nat -> Nat- (+) Zero m = m- (+) (Succ n) m = Succ (n + x)- in (x + Succ (Succ Zero))- foo13 :: forall a. a -> a- foo13 x- = let- bar :: a- bar = x- in foo13_ bar- foo13_ :: a -> a- foo13_ y = y- foo14 :: Nat -> (Nat, Nat)- foo14 x = let (y, z) = (Succ x, x) in (z, y)- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x '(y_0123456789876543210,- _) = y_0123456789876543210- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x '(_,- y_0123456789876543210) = y_0123456789876543210- type Let0123456789876543210YSym1 x0123456789876543210 =- Let0123456789876543210Y x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210YSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210YSym0KindInference) ())- data Let0123456789876543210YSym0 x0123456789876543210- where- Let0123456789876543210YSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>- Let0123456789876543210YSym0 x0123456789876543210- type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210- type Let0123456789876543210ZSym1 x0123456789876543210 =- Let0123456789876543210Z x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210- type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 =- Let0123456789876543210X_0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,) Let0123456789876543210X_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210- where- Let0123456789876543210X_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) =>- Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210- type instance Apply Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210- type family Let0123456789876543210Y x where- Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)- type family Let0123456789876543210Z x where- Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)- type family Let0123456789876543210X_0123456789876543210 x where- Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x- type Let0123456789876543210BarSym1 x0123456789876543210 =- Let0123456789876543210Bar x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210BarSym0KindInference) ())- data Let0123456789876543210BarSym0 x0123456789876543210- where- Let0123456789876543210BarSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) =>- Let0123456789876543210BarSym0 x0123456789876543210- type instance Apply Let0123456789876543210BarSym0 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210- type family Let0123456789876543210Bar x :: a where- Let0123456789876543210Bar x = x- type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat)- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210- arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210- type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where- (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m- (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x)- type Let0123456789876543210ZSym1 x0123456789876543210 =- Let0123456789876543210Z x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210- type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat)- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210- arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210- type family Let0123456789876543210Z x :: Nat where- Let0123456789876543210Z x = x- type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where- (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m- (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m)- type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat)- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210- type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where- suppressUnusedWarnings- = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ())- data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- where- (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210- arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>- (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210- type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210- type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where- (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m- (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m)- type family Lambda_0123456789876543210 x a_0123456789876543210 t where- Lambda_0123456789876543210 x a_0123456789876543210 x = x- type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) =- Let0123456789876543210Z x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym1KindInference) ())- data Let0123456789876543210ZSym1 x0123456789876543210 :: (~>) Nat Nat- where- Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) =>- Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210- type family Let0123456789876543210Z x (a :: Nat) :: Nat where- Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210- type family Lambda_0123456789876543210 x t where- Lambda_0123456789876543210 x x = x- type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type Let0123456789876543210ZSym1 x0123456789876543210 =- Let0123456789876543210Z x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210- type family Let0123456789876543210Z x :: Nat where- Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0- type Let0123456789876543210XSym1 x0123456789876543210 =- Let0123456789876543210X x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210XSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210XSym0KindInference) ())- data Let0123456789876543210XSym0 x0123456789876543210- where- Let0123456789876543210XSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) =>- Let0123456789876543210XSym0 x0123456789876543210- type instance Apply Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210X x0123456789876543210- type family Let0123456789876543210X x :: Nat where- Let0123456789876543210X x = ZeroSym0- type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) =- Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym1KindInference) ())- data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat- where- Let0123456789876543210FSym1KindInference :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) =>- Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210FSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym0KindInference) ())- data Let0123456789876543210FSym0 x0123456789876543210- where- Let0123456789876543210FSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>- Let0123456789876543210FSym0 x0123456789876543210- type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210- type family Let0123456789876543210F x (a :: Nat) :: Nat where- Let0123456789876543210F x y = Apply SuccSym0 y- type Let0123456789876543210ZSym1 x0123456789876543210 =- Let0123456789876543210Z x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210- type family Let0123456789876543210Z x :: Nat where- Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x- type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 =- Let0123456789876543210Z x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym1KindInference) ())- data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210- where- Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) =>- Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210- type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210ZSym0KindInference) ())- data Let0123456789876543210ZSym0 x0123456789876543210- where- Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>- Let0123456789876543210ZSym0 x0123456789876543210- type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210- type family Let0123456789876543210Z x y :: Nat where- Let0123456789876543210Z x y = Apply SuccSym0 y- type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) =- Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym1KindInference) ())- data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat- where- Let0123456789876543210FSym1KindInference :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) =>- Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210FSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym0KindInference) ())- data Let0123456789876543210FSym0 x0123456789876543210- where- Let0123456789876543210FSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>- Let0123456789876543210FSym0 x0123456789876543210- type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210- type family Let0123456789876543210F x (a :: Nat) :: Nat where- Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y)- type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) =- Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym1KindInference) ())- data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat- where- Let0123456789876543210FSym1KindInference :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) =>- Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210FSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210FSym0KindInference) ())- data Let0123456789876543210FSym0 x0123456789876543210- where- Let0123456789876543210FSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>- Let0123456789876543210FSym0 x0123456789876543210- type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210- type family Let0123456789876543210F x (a :: Nat) :: Nat where- Let0123456789876543210F x y = Apply SuccSym0 y- type Let0123456789876543210YSym1 x0123456789876543210 =- Let0123456789876543210Y x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210YSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210YSym0KindInference) ())- data Let0123456789876543210YSym0 x0123456789876543210- where- Let0123456789876543210YSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>- Let0123456789876543210YSym0 x0123456789876543210- type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210- type family Let0123456789876543210Y x :: Nat where- Let0123456789876543210Y x = Apply SuccSym0 x- type Let0123456789876543210YSym0 = Let0123456789876543210Y- type Let0123456789876543210ZSym0 = Let0123456789876543210Z- type family Let0123456789876543210Y where- Let0123456789876543210Y = Apply SuccSym0 ZeroSym0- type family Let0123456789876543210Z where- Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0- type Let0123456789876543210YSym1 x0123456789876543210 =- Let0123456789876543210Y x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210YSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210YSym0KindInference) ())- data Let0123456789876543210YSym0 x0123456789876543210- where- Let0123456789876543210YSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>- Let0123456789876543210YSym0 x0123456789876543210- type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210- type family Let0123456789876543210Y x :: Nat where- Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0- type Foo14Sym1 (a0123456789876543210 :: Nat) =- Foo14 a0123456789876543210- instance SuppressUnusedWarnings Foo14Sym0 where- suppressUnusedWarnings = snd (((,) Foo14Sym0KindInference) ())- data Foo14Sym0 :: (~>) Nat (Nat, Nat)- where- Foo14Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) =>- Foo14Sym0 a0123456789876543210- type instance Apply Foo14Sym0 a0123456789876543210 = Foo14 a0123456789876543210- type Foo13_Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo13_ a0123456789876543210- instance SuppressUnusedWarnings Foo13_Sym0 where- suppressUnusedWarnings = snd (((,) Foo13_Sym0KindInference) ())- data Foo13_Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo13_Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) =>- Foo13_Sym0 a0123456789876543210- type instance Apply Foo13_Sym0 a0123456789876543210 = Foo13_ a0123456789876543210- type Foo13Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo13 a0123456789876543210- instance SuppressUnusedWarnings Foo13Sym0 where- suppressUnusedWarnings = snd (((,) Foo13Sym0KindInference) ())- data Foo13Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo13Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) =>- Foo13Sym0 a0123456789876543210- type instance Apply Foo13Sym0 a0123456789876543210 = Foo13 a0123456789876543210- type Foo12Sym1 (a0123456789876543210 :: Nat) =- Foo12 a0123456789876543210- instance SuppressUnusedWarnings Foo12Sym0 where- suppressUnusedWarnings = snd (((,) Foo12Sym0KindInference) ())- data Foo12Sym0 :: (~>) Nat Nat- where- Foo12Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) =>- Foo12Sym0 a0123456789876543210- type instance Apply Foo12Sym0 a0123456789876543210 = Foo12 a0123456789876543210- type Foo11Sym1 (a0123456789876543210 :: Nat) =- Foo11 a0123456789876543210- instance SuppressUnusedWarnings Foo11Sym0 where- suppressUnusedWarnings = snd (((,) Foo11Sym0KindInference) ())- data Foo11Sym0 :: (~>) Nat Nat- where- Foo11Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) =>- Foo11Sym0 a0123456789876543210- type instance Apply Foo11Sym0 a0123456789876543210 = Foo11 a0123456789876543210- type Foo10Sym1 (a0123456789876543210 :: Nat) =- Foo10 a0123456789876543210- instance SuppressUnusedWarnings Foo10Sym0 where- suppressUnusedWarnings = snd (((,) Foo10Sym0KindInference) ())- data Foo10Sym0 :: (~>) Nat Nat- where- Foo10Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) =>- Foo10Sym0 a0123456789876543210- type instance Apply Foo10Sym0 a0123456789876543210 = Foo10 a0123456789876543210- type Foo9Sym1 (a0123456789876543210 :: Nat) =- Foo9 a0123456789876543210- instance SuppressUnusedWarnings Foo9Sym0 where- suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ())- data Foo9Sym0 :: (~>) Nat Nat- where- Foo9Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) =>- Foo9Sym0 a0123456789876543210- type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210- type Foo8Sym1 (a0123456789876543210 :: Nat) =- Foo8 a0123456789876543210- instance SuppressUnusedWarnings Foo8Sym0 where- suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ())- data Foo8Sym0 :: (~>) Nat Nat- where- Foo8Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>- Foo8Sym0 a0123456789876543210- type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210- type Foo7Sym1 (a0123456789876543210 :: Nat) =- Foo7 a0123456789876543210- instance SuppressUnusedWarnings Foo7Sym0 where- suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ())- data Foo7Sym0 :: (~>) Nat Nat- where- Foo7Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>- Foo7Sym0 a0123456789876543210- type instance Apply Foo7Sym0 a0123456789876543210 = Foo7 a0123456789876543210- type Foo6Sym1 (a0123456789876543210 :: Nat) =- Foo6 a0123456789876543210- instance SuppressUnusedWarnings Foo6Sym0 where- suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ())- data Foo6Sym0 :: (~>) Nat Nat- where- Foo6Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>- Foo6Sym0 a0123456789876543210- type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210- type Foo5Sym1 (a0123456789876543210 :: Nat) =- Foo5 a0123456789876543210- instance SuppressUnusedWarnings Foo5Sym0 where- suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ())- data Foo5Sym0 :: (~>) Nat Nat- where- Foo5Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>- Foo5Sym0 a0123456789876543210- type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210- type Foo4Sym1 (a0123456789876543210 :: Nat) =- Foo4 a0123456789876543210- instance SuppressUnusedWarnings Foo4Sym0 where- suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ())- data Foo4Sym0 :: (~>) Nat Nat- where- Foo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>- Foo4Sym0 a0123456789876543210- type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210- type Foo3Sym1 (a0123456789876543210 :: Nat) =- Foo3 a0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: (~>) Nat Nat- where- Foo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 a0123456789876543210- type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210- type Foo2Sym0 = Foo2- type Foo1Sym1 (a0123456789876543210 :: Nat) =- Foo1 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: (~>) Nat Nat- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210- type family Foo14 (a :: Nat) :: (Nat, Nat) where- Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x)- type family Foo13_ (a :: a) :: a where- Foo13_ y = y- type family Foo13 (a :: a) :: a where- Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x)- type family Foo12 (a :: Nat) :: Nat where- Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))- type family Foo11 (a :: Nat) :: Nat where- Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x)- type family Foo10 (a :: Nat) :: Nat where- Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) x- type family Foo9 (a :: Nat) :: Nat where- Foo9 x = Apply (Let0123456789876543210ZSym1 x) x- type family Foo8 (a :: Nat) :: Nat where- Foo8 x = Let0123456789876543210ZSym1 x- type family Foo7 (a :: Nat) :: Nat where- Foo7 x = Let0123456789876543210XSym1 x- type family Foo6 (a :: Nat) :: Nat where- Foo6 x = Let0123456789876543210ZSym1 x- type family Foo5 (a :: Nat) :: Nat where- Foo5 x = Apply (Let0123456789876543210FSym1 x) x- type family Foo4 (a :: Nat) :: Nat where- Foo4 x = Apply (Let0123456789876543210FSym1 x) x- type family Foo3 (a :: Nat) :: Nat where- Foo3 x = Let0123456789876543210YSym1 x- type family Foo2 :: Nat where- Foo2 = Let0123456789876543210ZSym0- type family Foo1 (a :: Nat) :: Nat where- Foo1 x = Let0123456789876543210YSym1 x- sFoo14 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat))- sFoo13_ ::- forall a (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a)- sFoo13 ::- forall a (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a)- sFoo12 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat)- sFoo11 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat)- sFoo10 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat)- sFoo9 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat)- sFoo8 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat)- sFoo7 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat)- sFoo6 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat)- sFoo5 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat)- sFoo4 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat)- sFoo3 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat)- sFoo2 :: Sing (Foo2Sym0 :: Nat)- sFoo1 ::- forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat)- sFoo14 (sX :: Sing x)- = let- sY :: Sing (Let0123456789876543210YSym1 x)- sZ :: Sing (Let0123456789876543210ZSym1 x)- sX_0123456789876543210 ::- Sing (Let0123456789876543210X_0123456789876543210Sym1 x)- sY- = (case sX_0123456789876543210 of {- STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x))- sZ- = (case sX_0123456789876543210 of {- STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x))- sX_0123456789876543210- = (applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2))- ((applySing ((singFun1 @SuccSym0) SSucc)) sX)))- sX- in (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sZ)) sY- sFoo13_ (sY :: Sing y) = sY- sFoo13 (sX :: Sing x)- = let- sBar :: Sing (Let0123456789876543210BarSym1 x :: a)- sBar = sX- in (applySing ((singFun1 @Foo13_Sym0) sFoo13_)) sBar- sFoo12 (sX :: Sing x)- = let- (%+) ::- forall (t :: Nat) (t :: Nat).- Sing t- -> Sing t- -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat)- (%+) SZero (sM :: Sing m) = sM- (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- sN))- sX)- in- (applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- sX))- ((applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))- sFoo11 (sX :: Sing x)- = let- sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat)- (%+) ::- forall (t :: Nat) (t :: Nat).- Sing t- -> Sing t- -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat)- sZ = sX- (%+) SZero (sM :: Sing m) = sM- (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- sN))- sM)- in- (applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- sZ- sFoo10 (sX :: Sing x)- = let- (%+) ::- forall (t :: Nat) (t :: Nat).- Sing t- -> Sing t- -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat)- (%+) SZero (sM :: Sing m) = sM- (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- sN))- sM)- in- (applySing- ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+)))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- sX- sFoo9 (sX :: Sing x)- = let- sZ ::- forall (t :: Nat).- Sing t -> Sing (Apply (Let0123456789876543210ZSym1 x) t :: Nat)- sZ (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((singFun1- @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210))- (\ sX -> case sX of { (_ :: Sing x) -> sX })))- sA_0123456789876543210- in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX- sFoo8 (sX :: Sing x)- = let- sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat)- sZ- = (applySing- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x))- (\ sX -> case sX of { (_ :: Sing x) -> sX })))- SZero- in sZ- sFoo7 (sX :: Sing x)- = let- sX :: Sing (Let0123456789876543210XSym1 x :: Nat)- sX = SZero- in sX- sFoo6 (sX :: Sing x)- = let- sF ::- forall (t :: Nat).- Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat)- sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in- let- sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat)- sZ- = (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX- in sZ- sFoo5 (sX :: Sing x)- = let- sF ::- forall (t :: Nat).- Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat)- sF (sY :: Sing y)- = let- sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat)- sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY- in (applySing ((singFun1 @SuccSym0) SSucc)) sZ- in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX- sFoo4 (sX :: Sing x)- = let- sF ::- forall (t :: Nat).- Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat)- sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY- in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX- sFoo3 (sX :: Sing x)- = let- sY :: Sing (Let0123456789876543210YSym1 x :: Nat)- sY = (applySing ((singFun1 @SuccSym0) SSucc)) sX- in sY- sFoo2- = let- sY :: Sing Let0123456789876543210YSym0- sZ :: Sing Let0123456789876543210ZSym0- sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero- sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY- in sZ- sFoo1 (sX :: Sing x)- = let- sY :: Sing (Let0123456789876543210YSym1 x :: Nat)- sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero- in sY- instance SingI (Foo14Sym0 :: (~>) Nat (Nat, Nat)) where- sing = (singFun1 @Foo14Sym0) sFoo14- instance SingI (Foo13_Sym0 :: (~>) a a) where- sing = (singFun1 @Foo13_Sym0) sFoo13_- instance SingI (Foo13Sym0 :: (~>) a a) where- sing = (singFun1 @Foo13Sym0) sFoo13- instance SingI (Foo12Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo12Sym0) sFoo12- instance SingI (Foo11Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo11Sym0) sFoo11- instance SingI (Foo10Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo10Sym0) sFoo10- instance SingI (Foo9Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo9Sym0) sFoo9- instance SingI (Foo8Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo8Sym0) sFoo8- instance SingI (Foo7Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo7Sym0) sFoo7- instance SingI (Foo6Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo6Sym0) sFoo6- instance SingI (Foo5Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo5Sym0) sFoo5- instance SingI (Foo4Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo4Sym0) sFoo4- instance SingI (Foo3Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo3Sym0) sFoo3- instance SingI (Foo1Sym0 :: (~>) Nat Nat) where- sing = (singFun1 @Foo1Sym0) sFoo1
− tests/compile-and-dump/Singletons/LetStatements.hs
@@ -1,193 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-matches- -Wno-name-shadowing #-}--module Singletons.LetStatements where--import Data.Singletons-import Data.Singletons.Prelude-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Singletons.Nat--$(singletons [d|- -- type signature required for a constant- foo1 :: Nat -> Nat- foo1 x = let y :: Nat- y = Succ Zero- in y-- -- nothing in scope, no type signatures required- foo2 :: Nat- foo2 = let y = Succ Zero- z = Succ y- in z-- -- using in-scope variable- foo3 :: Nat -> Nat- foo3 x = let y :: Nat- y = Succ x- in y-- -- passing in-scope variable to a function. Tests also adding in-scope binders- -- at the call site of f- foo4 :: Nat -> Nat- foo4 x = let f :: Nat -> Nat- f y = Succ y- in f x-- -- nested lets, version 1. This could potentially be problematic.- foo5 :: Nat -> Nat- foo5 x = let f :: Nat -> Nat- f y = let z :: Nat- z = Succ y- in Succ z- in f x-- -- nested lets, version 2. This shouldn't cause any problems, so that's just a- -- sanity check.- foo6 :: Nat -> Nat- foo6 x = let f :: Nat -> Nat- f y = Succ y- in let z :: Nat- z = f x- in z-- -- name shadowing- foo7 :: Nat -> Nat- foo7 x = let x :: Nat- x = Zero- in x-- -- lambda binder in let shadows pattern-bound variable- foo8 :: Nat -> Nat- foo8 x = let z :: Nat- z = (\x -> x) Zero- in z-- -- let-declaring lambdas- foo9 :: Nat -> Nat- foo9 x = let z :: Nat -> Nat- z = (\x -> x)- in z x- -- infix declaration- foo10 :: Nat -> Nat- foo10 x = let (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- in (Succ Zero) + x-- -- infix call uses let-bound binder- foo11 :: Nat -> Nat- foo11 x = let (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- z :: Nat- z = x- in (Succ Zero) + z-- -- infix let-declaration uses in-scope variable- foo12 :: Nat -> Nat- foo12 x = let (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + x)- in x + (Succ (Succ Zero))-- -- make sure that calls to functions declared outside of let don't receive- -- extra parameters with in-scope bindings. See #18.- foo13 :: forall a. a -> a- foo13 x = let bar :: a- bar = x- in foo13_ bar-- foo13_ :: a -> a- foo13_ y = y-- -- tuple patterns in let statements. See #20- foo14 :: Nat -> (Nat, Nat)- foo14 x = let (y, z) = (Succ x, x)- in (z, y)- |])--foo1a :: Proxy (Foo1 Zero)-foo1a = Proxy--foo1b :: Proxy (Succ Zero)-foo1b = foo1a--foo2a :: Proxy Foo2-foo2a = Proxy--foo2b :: Proxy (Succ (Succ Zero))-foo2b = foo2a--foo3a :: Proxy (Foo3 (Succ Zero))-foo3a = Proxy--foo3b :: Proxy (Succ (Succ Zero))-foo3b = foo3a--foo4a :: Proxy (Foo4 (Succ Zero))-foo4a = Proxy--foo4b :: Proxy (Succ (Succ Zero))-foo4b = foo4a--foo5a :: Proxy (Foo5 Zero)-foo5a = Proxy--foo5b :: Proxy (Succ (Succ Zero))-foo5b = foo5a--foo6a :: Proxy (Foo6 Zero)-foo6a = Proxy--foo6b :: Proxy (Succ Zero)-foo6b = foo6a--foo7a :: Proxy (Foo7 (Succ (Succ Zero)))-foo7a = Proxy--foo7b :: Proxy Zero-foo7b = foo7a--foo8a :: Proxy (Foo8 (Succ (Succ Zero)))-foo8a = Proxy--foo8b :: Proxy Zero-foo8b = foo8a--foo9a :: Proxy (Foo9 (Succ (Succ Zero)))-foo9a = Proxy--foo9b :: Proxy (Succ (Succ Zero))-foo9b = foo9a--foo10a :: Proxy (Foo10 (Succ (Succ Zero)))-foo10a = Proxy--foo10b :: Proxy (Succ (Succ (Succ Zero)))-foo10b = foo10a--foo11a :: Proxy (Foo11 (Succ (Succ Zero)))-foo11a = Proxy--foo11b :: Proxy (Succ (Succ (Succ Zero)))-foo11b = foo11a--foo12a :: Proxy (Foo12 (Succ (Succ (Succ Zero))))-foo12a = Proxy--foo12b :: Proxy (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))-foo12b = foo12a--foo13a :: Proxy (Foo13 Zero)-foo13a = Proxy--foo13b :: Proxy Zero-foo13b = foo13a--foo14a :: Proxy (Foo14 Zero)-foo14a = Proxy--foo14b :: Proxy '(Zero, Succ Zero)-foo14b = foo14a
− tests/compile-and-dump/Singletons/Maybe.ghc86.template
@@ -1,140 +0,0 @@-Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Maybe a- = Nothing | Just a- deriving (Eq, Show) |]- ======>- data Maybe a- = Nothing | Just a- deriving (Eq, Show)- type NothingSym0 = Nothing- type JustSym1 (t0123456789876543210 :: a0123456789876543210) =- Just t0123456789876543210- instance SuppressUnusedWarnings JustSym0 where- suppressUnusedWarnings = snd (((,) JustSym0KindInference) ())- data JustSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 (Maybe a0123456789876543210)- where- JustSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) =>- JustSym0 t0123456789876543210- type instance Apply JustSym0 t0123456789876543210 = Just t0123456789876543210- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) GHC.Types.Nat ((~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (Maybe a) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where- Equals_0123456789876543210 Nothing Nothing = TrueSym0- Equals_0123456789876543210 (Just a) (Just b) = (==) a b- Equals_0123456789876543210 (_ :: Maybe a) (_ :: Maybe a) = FalseSym0- instance PEq (Maybe a) where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: Maybe a -> GHC.Types.Type- where- SNothing :: Sing Nothing- SJust :: forall a (n :: a). (Sing (n :: a)) -> Sing (Just n)- type SMaybe = (Sing :: Maybe a -> GHC.Types.Type)- instance SingKind a => SingKind (Maybe a) where- type Demote (Maybe a) = Maybe (Demote a)- fromSing SNothing = Nothing- fromSing (SJust b) = Just (fromSing b)- toSing Nothing = SomeSing SNothing- toSing (Just (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SJust c) }- instance SShow a => SShow (Maybe a) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat)- (t2 :: Maybe a)- (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- SNothing- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Nothing")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SJust (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Just "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))- sA_0123456789876543210- instance SEq a => SEq (Maybe a) where- (%==) SNothing SNothing = STrue- (%==) SNothing (SJust _) = SFalse- (%==) (SJust _) SNothing = SFalse- (%==) (SJust a) (SJust b) = ((%==) a) b- instance SDecide a => SDecide (Maybe a) where- (%~) SNothing SNothing = Proved Refl- (%~) SNothing (SJust _) = Disproved (\ x -> case x of)- (%~) (SJust _) SNothing = Disproved (\ x -> case x of)- (%~) (SJust a) (SJust b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- deriving instance Data.Singletons.ShowSing.ShowSing a =>- Show (Sing (z :: Maybe a))- instance SingI Nothing where- sing = SNothing- instance SingI n => SingI (Just (n :: a)) where- sing = SJust sing- instance SingI (JustSym0 :: (~>) a (Maybe a)) where- sing = (singFun1 @JustSym0) SJust- instance SingI (TyCon1 Just :: (~>) a (Maybe a)) where- sing = (singFun1 @(TyCon1 Just)) SJust
− tests/compile-and-dump/Singletons/Maybe.hs
@@ -1,7 +0,0 @@-module Singletons.Maybe where--import Data.Singletons.TH--$(singletons [d|- data Maybe a = Nothing | Just a deriving (Eq, Show)- |])
− tests/compile-and-dump/Singletons/Nat.ghc86.template
@@ -1,266 +0,0 @@-Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| plus :: Nat -> Nat -> Nat- plus Zero m = m- plus (Succ n) m = Succ (plus n m)- pred :: Nat -> Nat- pred Zero = Zero- pred (Succ n) = n- - data Nat- where- Zero :: Nat- Succ :: Nat -> Nat- deriving (Eq, Show, Read, Ord) |]- ======>- data Nat- where- Zero :: Nat- Succ :: Nat -> Nat- deriving (Eq, Show, Read, Ord)- plus :: Nat -> Nat -> Nat- plus Zero m = m- plus (Succ n) m = Succ ((plus n) m)- pred :: Nat -> Nat- pred Zero = Zero- pred (Succ n) = n- type ZeroSym0 = Zero- type SuccSym1 (t0123456789876543210 :: Nat) =- Succ t0123456789876543210- instance SuppressUnusedWarnings SuccSym0 where- suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ())- data SuccSym0 :: (~>) Nat Nat- where- SuccSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>- SuccSym0 t0123456789876543210- type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210- type PredSym1 (a0123456789876543210 :: Nat) =- Pred a0123456789876543210- instance SuppressUnusedWarnings PredSym0 where- suppressUnusedWarnings = snd (((,) PredSym0KindInference) ())- data PredSym0 :: (~>) Nat Nat- where- PredSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) =>- PredSym0 a0123456789876543210- type instance Apply PredSym0 a0123456789876543210 = Pred a0123456789876543210- type PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Plus a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) PlusSym1KindInference) ())- data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- PlusSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) =>- PlusSym1 a0123456789876543210 a0123456789876543210- type instance Apply (PlusSym1 a0123456789876543210) a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings PlusSym0 where- suppressUnusedWarnings = snd (((,) PlusSym0KindInference) ())- data PlusSym0 :: (~>) Nat ((~>) Nat Nat)- where- PlusSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) =>- PlusSym0 a0123456789876543210- type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210- type family Pred (a :: Nat) :: Nat where- Pred Zero = ZeroSym0- Pred (Succ n) = n- type family Plus (a :: Nat) (a :: Nat) :: Nat where- Plus Zero m = m- Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m)- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Nat where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where- Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- Compare_0123456789876543210 Zero (Succ _) = LTSym0- Compare_0123456789876543210 (Succ _) Zero = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Nat where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where- Equals_0123456789876543210 Zero Zero = TrueSym0- Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b- Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0- instance PEq Nat where- type (==) a b = Equals_0123456789876543210 a b- sPred ::- forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat)- sPlus ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat)- sPred SZero = SZero- sPred (SSucc (sN :: Sing n)) = sN- sPlus SZero (sM :: Sing m) = sM- sPlus (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM)- instance SingI (PredSym0 :: (~>) Nat Nat) where- sing = (singFun1 @PredSym0) sPred- instance SingI (PlusSym0 :: (~>) Nat ((~>) Nat Nat)) where- sing = (singFun2 @PlusSym0) sPlus- instance SingI d =>- SingI (PlusSym1 (d :: Nat) :: (~>) Nat Nat) where- sing = (singFun1 @(PlusSym1 (d :: Nat))) (sPlus (sing @d))- data instance Sing :: Nat -> GHC.Types.Type- where- SZero :: Sing Zero- SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n)- type SNat = (Sing :: Nat -> GHC.Types.Type)- instance SingKind Nat where- type Demote Nat = Nat- fromSing SZero = Zero- fromSing (SSucc b) = Succ (fromSing b)- toSing Zero = SomeSing SZero- toSing (Succ (b :: Demote Nat))- = case toSing b :: SomeSing Nat of {- SomeSing c -> SomeSing (SSucc c) }- instance SShow Nat => SShow Nat where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Nat) (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- SZero- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Zero")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SSucc (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Succ "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))- sA_0123456789876543210- instance SOrd Nat => SOrd Nat where- sCompare ::- forall (t1 :: Nat) (t2 :: Nat).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering)- -> GHC.Types.Type) t1) t2)- sCompare SZero SZero- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- Data.Singletons.Prelude.Instances.SNil- sCompare- (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing- ((singFun2 @(:@#@$))- Data.Singletons.Prelude.Instances.SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- Data.Singletons.Prelude.Instances.SNil)- sCompare SZero (SSucc _) = SLT- sCompare (SSucc _) SZero = SGT- instance SEq Nat => SEq Nat where- (%==) SZero SZero = STrue- (%==) SZero (SSucc _) = SFalse- (%==) (SSucc _) SZero = SFalse- (%==) (SSucc a) (SSucc b) = ((%==) a) b- instance SDecide Nat => SDecide Nat where- (%~) SZero SZero = Proved Refl- (%~) SZero (SSucc _) = Disproved (\ x -> case x of)- (%~) (SSucc _) SZero = Disproved (\ x -> case x of)- (%~) (SSucc a) (SSucc b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- deriving instance Data.Singletons.ShowSing.ShowSing Nat =>- Show (Sing (z :: Nat))- instance SingI Zero where- sing = SZero- instance SingI n => SingI (Succ (n :: Nat)) where- sing = SSucc sing- instance SingI (SuccSym0 :: (~>) Nat Nat) where- sing = (singFun1 @SuccSym0) SSucc- instance SingI (TyCon1 Succ :: (~>) Nat Nat) where- sing = (singFun1 @(TyCon1 Succ)) SSucc
− tests/compile-and-dump/Singletons/Nat.hs
@@ -1,18 +0,0 @@-module Singletons.Nat where--import Data.Singletons.TH--$(singletons [d|- data Nat where- Zero :: Nat- Succ :: Nat -> Nat- deriving (Eq, Show, Read, Ord)-- plus :: Nat -> Nat -> Nat- plus Zero m = m- plus (Succ n) m = Succ (plus n m)-- pred :: Nat -> Nat- pred Zero = Zero- pred (Succ n) = n- |])
− tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template
− tests/compile-and-dump/Singletons/NatSymbolReflexive.hs
@@ -1,11 +0,0 @@-module NatSymbolReflexive where--import Data.Singletons.Prelude-import Data.Type.Equality ((:~:)(..))-import GHC.TypeLits--test1 :: forall (a :: Nat). Sing a -> (a == a) :~: True-test1 _ = Refl--test2 :: forall (a :: Symbol). Sing a -> (a == a) :~: True-test2 _ = Refl
− tests/compile-and-dump/Singletons/Operators.ghc86.template
@@ -1,128 +0,0 @@-Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| child :: Foo -> Foo- child FLeaf = FLeaf- child (a :+: _) = a- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- - data Foo- where- FLeaf :: Foo- (:+:) :: Foo -> Foo -> Foo |]- ======>- data Foo- where- FLeaf :: Foo- (:+:) :: Foo -> Foo -> Foo- child :: Foo -> Foo- child FLeaf = FLeaf- child (a :+: _) = a- (+) :: Nat -> Nat -> Nat- (+) Zero m = m- (+) (Succ n) m = Succ (n + m)- type FLeafSym0 = FLeaf- type (:+:@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) =- (:+:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:+:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::+:@#@$$###)) ())- data (:+:@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo- where- (::+:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:+:@#@$$) t0123456789876543210) arg) ((:+:@#@$$$) t0123456789876543210 arg) =>- (:+:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:+:@#@$$) t0123456789876543210) t0123456789876543210 = (:+:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (:+:@#@$) where- suppressUnusedWarnings = snd (((,) (::+:@#@$###)) ())- data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo)- where- (::+:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) =>- (:+:@#@$) t0123456789876543210- type instance Apply (:+:@#@$) t0123456789876543210 = (:+:@#@$$) t0123456789876543210- type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- (+) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ())- data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:+@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) =>- (+@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (+@#@$) where- suppressUnusedWarnings = snd (((,) (:+@#@$###)) ())- data (+@#@$) :: (~>) Nat ((~>) Nat Nat)- where- (:+@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>- (+@#@$) a0123456789876543210- type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210- type ChildSym1 (a0123456789876543210 :: Foo) =- Child a0123456789876543210- instance SuppressUnusedWarnings ChildSym0 where- suppressUnusedWarnings = snd (((,) ChildSym0KindInference) ())- data ChildSym0 :: (~>) Foo Foo- where- ChildSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) =>- ChildSym0 a0123456789876543210- type instance Apply ChildSym0 a0123456789876543210 = Child a0123456789876543210- type family (+) (a :: Nat) (a :: Nat) :: Nat where- (+) 'Zero m = m- (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m)- type family Child (a :: Foo) :: Foo where- Child FLeaf = FLeafSym0- Child ((:+:) a _) = a- (%+) ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat)- sChild ::- forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo)- (%+) SZero (sM :: Sing m) = sM- (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM)- sChild SFLeaf = SFLeaf- sChild ((:%+:) (sA :: Sing a) _) = sA- instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where- sing = (singFun2 @(+@#@$)) (%+)- instance SingI d =>- SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where- sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d))- instance SingI (ChildSym0 :: (~>) Foo Foo) where- sing = (singFun1 @ChildSym0) sChild- data instance Sing :: Foo -> GHC.Types.Type- where- SFLeaf :: Sing FLeaf- (:%+:) :: forall (n :: Foo) (n :: Foo).- (Sing (n :: Foo)) -> (Sing (n :: Foo)) -> Sing ((:+:) n n)- type SFoo = (Sing :: Foo -> GHC.Types.Type)- instance SingKind Foo where- type Demote Foo = Foo- fromSing SFLeaf = FLeaf- fromSing ((:%+:) b b) = ((:+:) (fromSing b)) (fromSing b)- toSing FLeaf = SomeSing SFLeaf- toSing ((:+:) (b :: Demote Foo) (b :: Demote Foo))- = case- ((,) (toSing b :: SomeSing Foo)) (toSing b :: SomeSing Foo)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%+:) c) c) }- instance SingI FLeaf where- sing = SFLeaf- instance (SingI n, SingI n) =>- SingI ((:+:) (n :: Foo) (n :: Foo)) where- sing = ((:%+:) sing) sing- instance SingI ((:+:@#@$) :: (~>) Foo ((~>) Foo Foo)) where- sing = (singFun2 @(:+:@#@$)) (:%+:)- instance SingI (TyCon2 (:+:) :: (~>) Foo ((~>) Foo Foo)) where- sing = (singFun2 @(TyCon2 (:+:))) (:%+:)- instance SingI d =>- SingI ((:+:@#@$$) (d :: Foo) :: (~>) Foo Foo) where- sing = (singFun1 @((:+:@#@$$) (d :: Foo))) ((:%+:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:+:) (d :: Foo)) :: (~>) Foo Foo) where- sing = (singFun1 @(TyCon1 ((:+:) (d :: Foo)))) ((:%+:) (sing @d))
− tests/compile-and-dump/Singletons/Operators.hs
@@ -1,20 +0,0 @@-module Singletons.Operators where--import Data.Singletons-import Data.Singletons.TH-import Singletons.Nat-import Data.Singletons.SuppressUnusedWarnings--$(singletons [d|- data Foo where- FLeaf :: Foo- (:+:) :: Foo -> Foo -> Foo-- child :: Foo -> Foo- child FLeaf = FLeaf- child (a :+: _) = a-- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- |])
− tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template
@@ -1,1235 +0,0 @@-Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Nat- = Zero | Succ Nat- deriving (Eq, Ord)- data Foo a b c d- = A a b c d |- B a b c d |- C a b c d |- D a b c d |- E a b c d |- F a b c d- deriving (Eq, Ord) |]- ======>- data Nat- = Zero | Succ Nat- deriving (Eq, Ord)- data Foo a b c d- = A a b c d |- B a b c d |- C a b c d |- D a b c d |- E a b c d |- F a b c d- deriving (Eq, Ord)- type ZeroSym0 = Zero- type SuccSym1 (t0123456789876543210 :: Nat) =- Succ t0123456789876543210- instance SuppressUnusedWarnings SuccSym0 where- suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ())- data SuccSym0 :: (~>) Nat Nat- where- SuccSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>- SuccSym0 t0123456789876543210- type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210- type ASym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ASym3KindInference) ())- data ASym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- ASym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ASym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ASym2KindInference) ())- data ASym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- ASym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ASym2 t0123456789876543210 t0123456789876543210) arg) (ASym3 t0123456789876543210 t0123456789876543210 arg) =>- ASym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (ASym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ASym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ASym1KindInference) ())- data ASym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- ASym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ASym1 t0123456789876543210) arg) (ASym2 t0123456789876543210 arg) =>- ASym1 t0123456789876543210 t0123456789876543210- type instance Apply (ASym1 t0123456789876543210) t0123456789876543210 = ASym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ASym0 where- suppressUnusedWarnings = snd (((,) ASym0KindInference) ())- data ASym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- ASym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply ASym0 arg) (ASym1 arg) =>- ASym0 t0123456789876543210- type instance Apply ASym0 t0123456789876543210 = ASym1 t0123456789876543210- type BSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BSym3KindInference) ())- data BSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- BSym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BSym2KindInference) ())- data BSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- BSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BSym2 t0123456789876543210 t0123456789876543210) arg) (BSym3 t0123456789876543210 t0123456789876543210 arg) =>- BSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (BSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) BSym1KindInference) ())- data BSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- BSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BSym1 t0123456789876543210) arg) (BSym2 t0123456789876543210 arg) =>- BSym1 t0123456789876543210 t0123456789876543210- type instance Apply (BSym1 t0123456789876543210) t0123456789876543210 = BSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings BSym0 where- suppressUnusedWarnings = snd (((,) BSym0KindInference) ())- data BSym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- BSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply BSym0 arg) (BSym1 arg) =>- BSym0 t0123456789876543210- type instance Apply BSym0 t0123456789876543210 = BSym1 t0123456789876543210- type CSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) CSym3KindInference) ())- data CSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- CSym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (CSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) CSym2KindInference) ())- data CSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- CSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (CSym2 t0123456789876543210 t0123456789876543210) arg) (CSym3 t0123456789876543210 t0123456789876543210 arg) =>- CSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (CSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (CSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) CSym1KindInference) ())- data CSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- CSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (CSym1 t0123456789876543210) arg) (CSym2 t0123456789876543210 arg) =>- CSym1 t0123456789876543210 t0123456789876543210- type instance Apply (CSym1 t0123456789876543210) t0123456789876543210 = CSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings CSym0 where- suppressUnusedWarnings = snd (((,) CSym0KindInference) ())- data CSym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- CSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply CSym0 arg) (CSym1 arg) =>- CSym0 t0123456789876543210- type instance Apply CSym0 t0123456789876543210 = CSym1 t0123456789876543210- type DSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) DSym3KindInference) ())- data DSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- DSym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (DSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) DSym2KindInference) ())- data DSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- DSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (DSym2 t0123456789876543210 t0123456789876543210) arg) (DSym3 t0123456789876543210 t0123456789876543210 arg) =>- DSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (DSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (DSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) DSym1KindInference) ())- data DSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- DSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (DSym1 t0123456789876543210) arg) (DSym2 t0123456789876543210 arg) =>- DSym1 t0123456789876543210 t0123456789876543210- type instance Apply (DSym1 t0123456789876543210) t0123456789876543210 = DSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings DSym0 where- suppressUnusedWarnings = snd (((,) DSym0KindInference) ())- data DSym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- DSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply DSym0 arg) (DSym1 arg) =>- DSym0 t0123456789876543210- type instance Apply DSym0 t0123456789876543210 = DSym1 t0123456789876543210- type ESym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ESym3KindInference) ())- data ESym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- ESym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ESym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ESym2KindInference) ())- data ESym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- ESym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ESym2 t0123456789876543210 t0123456789876543210) arg) (ESym3 t0123456789876543210 t0123456789876543210 arg) =>- ESym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (ESym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (ESym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) ESym1KindInference) ())- data ESym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- ESym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (ESym1 t0123456789876543210) arg) (ESym2 t0123456789876543210 arg) =>- ESym1 t0123456789876543210 t0123456789876543210- type instance Apply (ESym1 t0123456789876543210) t0123456789876543210 = ESym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ESym0 where- suppressUnusedWarnings = snd (((,) ESym0KindInference) ())- data ESym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- ESym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply ESym0 arg) (ESym1 arg) =>- ESym0 t0123456789876543210- type instance Apply ESym0 t0123456789876543210 = ESym1 t0123456789876543210- type FSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) =- F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) FSym3KindInference) ())- data FSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210.- (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)- where- FSym3KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) =>- FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (FSym2 t0123456789876543210 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) FSym2KindInference) ())- data FSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210- d0123456789876543210.- (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))- where- FSym2KindInference :: forall t0123456789876543210- t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (FSym2 t0123456789876543210 t0123456789876543210) arg) (FSym3 t0123456789876543210 t0123456789876543210 arg) =>- FSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210- type instance Apply (FSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (FSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) FSym1KindInference) ())- data FSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))- where- FSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (FSym1 t0123456789876543210) arg) (FSym2 t0123456789876543210 arg) =>- FSym1 t0123456789876543210 t0123456789876543210- type instance Apply (FSym1 t0123456789876543210) t0123456789876543210 = FSym2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings FSym0 where- suppressUnusedWarnings = snd (((,) FSym0KindInference) ())- data FSym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))))- where- FSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>- FSym0 t0123456789876543210- type instance Apply FSym0 t0123456789876543210 = FSym1 t0123456789876543210- type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where- Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- Compare_0123456789876543210 Zero (Succ _) = LTSym0- Compare_0123456789876543210 (Succ _) Zero = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Nat where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where- Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))))- Compare_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = LTSym0- Compare_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = LTSym0- Compare_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = LTSym0- Compare_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = LTSym0- Compare_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = LTSym0- Compare_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = GTSym0- Compare_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = LTSym0- Compare_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = LTSym0- Compare_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = LTSym0- Compare_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = LTSym0- Compare_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = GTSym0- Compare_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = GTSym0- Compare_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = LTSym0- Compare_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = LTSym0- Compare_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = LTSym0- Compare_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = GTSym0- Compare_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = GTSym0- Compare_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = GTSym0- Compare_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = LTSym0- Compare_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = LTSym0- Compare_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = GTSym0- Compare_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = GTSym0- Compare_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = GTSym0- Compare_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = GTSym0- Compare_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = LTSym0- Compare_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = GTSym0- Compare_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = GTSym0- Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0- Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0- Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) :: (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210- c0123456789876543210- d0123456789876543210.- (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) ((~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd (Foo a b c d) where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where- Equals_0123456789876543210 Zero Zero = TrueSym0- Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b- Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0- instance PEq Nat where- type (==) a b = Equals_0123456789876543210 a b- type family Equals_0123456789876543210 (a :: Foo a b c d) (b :: Foo a b c d) :: Bool where- Equals_0123456789876543210 (A a a a a) (A b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (B a a a a) (B b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (C a a a a) (C b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (D a a a a) (D b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (E a a a a) (E b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (F a a a a) (F b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b)))- Equals_0123456789876543210 (_ :: Foo a b c d) (_ :: Foo a b c d) = FalseSym0- instance PEq (Foo a b c d) where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: Nat -> GHC.Types.Type- where- SZero :: Sing Zero- SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n)- type SNat = (Sing :: Nat -> GHC.Types.Type)- instance SingKind Nat where- type Demote Nat = Nat- fromSing SZero = Zero- fromSing (SSucc b) = Succ (fromSing b)- toSing Zero = SomeSing SZero- toSing (Succ (b :: Demote Nat))- = case toSing b :: SomeSing Nat of {- SomeSing c -> SomeSing (SSucc c) }- data instance Sing :: Foo a b c d -> GHC.Types.Type- where- SA :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (A n n n n)- SB :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (B n n n n)- SC :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (C n n n n)- SD :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (D n n n n)- SE :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (E n n n n)- SF :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).- (Sing (n :: a))- -> (Sing (n :: b))- -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (F n n n n)- type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type)- instance (SingKind a, SingKind b, SingKind c, SingKind d) =>- SingKind (Foo a b c d) where- type Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d)- fromSing (SA b b b b)- = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SB b b b b)- = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SC b b b b)- = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SD b b b b)- = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SE b b b b)- = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- fromSing (SF b b b b)- = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b)- toSing- (A (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SA c) c) c) c) }- toSing- (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SB c) c) c) c) }- toSing- (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SC c) c) c) c) }- toSing- (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SD c) c) c) c) }- toSing- (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SE c) c) c) c) }- toSing- (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))- = case- ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b))- (toSing b :: SomeSing c))- (toSing b :: SomeSing d)- of {- (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)- -> SomeSing ((((SF c) c) c) c) }- instance SOrd Nat => SOrd Nat where- sCompare ::- forall (t1 :: Nat) (t2 :: Nat).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering)- -> GHC.Types.Type) t1) t2)- sCompare SZero SZero- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare- (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil)- sCompare SZero (SSucc _) = SLT- sCompare (SSucc _) SZero = SGT- instance (SOrd a, SOrd b, SOrd c, SOrd d) =>- SOrd (Foo a b c d) where- sCompare ::- forall (t1 :: Foo a b c d) (t2 :: Foo a b c d).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) ((~>) (Foo a b c d) Ordering)- -> GHC.Types.Type) t1) t2)- sCompare- (SA (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SA (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare- (SB (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SB (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare- (SC (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SC (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare- (SD (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SD (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare- (SE (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SE (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare- (SF (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SF (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))))- sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT- sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT- sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT- sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT- sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT- sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT- sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT- sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT- sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT- sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT- sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT- sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT- sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT- sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT- sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT- sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT- sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT- sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT- sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT- sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT- sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT- sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT- sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT- sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT- sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT- sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT- sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT- sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT- sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT- sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT- instance SEq Nat => SEq Nat where- (%==) SZero SZero = STrue- (%==) SZero (SSucc _) = SFalse- (%==) (SSucc _) SZero = SFalse- (%==) (SSucc a) (SSucc b) = ((%==) a) b- instance SDecide Nat => SDecide Nat where- (%~) SZero SZero = Proved Refl- (%~) SZero (SSucc _) = Disproved (\ x -> case x of)- (%~) (SSucc _) SZero = Disproved (\ x -> case x of)- (%~) (SSucc a) (SSucc b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance (SEq a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where- (%==) (SA a a a a) (SA b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse- (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse- (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse- (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse- (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse- (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse- (%==) (SB a a a a) (SB b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse- (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse- (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse- (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse- (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse- (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse- (%==) (SC a a a a) (SC b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse- (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse- (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse- (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse- (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse- (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse- (%==) (SD a a a a) (SD b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse- (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse- (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse- (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse- (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse- (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse- (%==) (SE a a a a) (SE b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse- (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse- (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse- (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse- (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse- (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse- (%==) (SF a a a a) (SF b b b b)- = ((%&&) (((%==) a) b))- (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b)))- instance (SDecide a, SDecide b, SDecide c, SDecide d) =>- SDecide (Foo a b c d) where- (%~) (SA a a a a) (SA b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SB a a a a) (SB b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SC a a a a) (SC b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SD a a a a) (SD b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SE a a a a) (SE b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of)- (%~) (SF a a a a) (SF b b b b)- = case- ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)- of- (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)- -> Proved Refl- (,,,) (Disproved contra) _ _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ (Disproved contra) _ _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,,,) _ _ _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SingI Zero where- sing = SZero- instance SingI n => SingI (Succ (n :: Nat)) where- sing = SSucc sing- instance SingI (SuccSym0 :: (~>) Nat Nat) where- sing = (singFun1 @SuccSym0) SSucc- instance SingI (TyCon1 Succ :: (~>) Nat Nat) where- sing = (singFun1 @(TyCon1 Succ)) SSucc- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SA sing) sing) sing) sing- instance SingI (ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @ASym0) SA- instance SingI (TyCon4 A :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 A)) SA- instance SingI d =>- SingI (ASym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(ASym1 (d :: a))) (SA (sing @d))- instance SingI d =>- SingI (TyCon3 (A (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (A (d :: a)))) (SA (sing @d))- instance (SingI d, SingI d) =>- SingI (ASym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(ASym2 (d :: a) (d :: b))) ((SA (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (A (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (A (d :: a) (d :: b))))- ((SA (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (ASym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(ASym3 (d :: a) (d :: b) (d :: c)))- (((SA (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (A (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (A (d :: a) (d :: b) (d :: c))))- (((SA (sing @d)) (sing @d)) (sing @d))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SB sing) sing) sing) sing- instance SingI (BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @BSym0) SB- instance SingI (TyCon4 B :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 B)) SB- instance SingI d =>- SingI (BSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(BSym1 (d :: a))) (SB (sing @d))- instance SingI d =>- SingI (TyCon3 (B (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (B (d :: a)))) (SB (sing @d))- instance (SingI d, SingI d) =>- SingI (BSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(BSym2 (d :: a) (d :: b))) ((SB (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (B (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (B (d :: a) (d :: b))))- ((SB (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (BSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(BSym3 (d :: a) (d :: b) (d :: c)))- (((SB (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (B (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (B (d :: a) (d :: b) (d :: c))))- (((SB (sing @d)) (sing @d)) (sing @d))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SC sing) sing) sing) sing- instance SingI (CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @CSym0) SC- instance SingI (TyCon4 C :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 C)) SC- instance SingI d =>- SingI (CSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(CSym1 (d :: a))) (SC (sing @d))- instance SingI d =>- SingI (TyCon3 (C (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (C (d :: a)))) (SC (sing @d))- instance (SingI d, SingI d) =>- SingI (CSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(CSym2 (d :: a) (d :: b))) ((SC (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (C (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (C (d :: a) (d :: b))))- ((SC (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (CSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(CSym3 (d :: a) (d :: b) (d :: c)))- (((SC (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (C (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (C (d :: a) (d :: b) (d :: c))))- (((SC (sing @d)) (sing @d)) (sing @d))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SD sing) sing) sing) sing- instance SingI (DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @DSym0) SD- instance SingI (TyCon4 D :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 D)) SD- instance SingI d =>- SingI (DSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(DSym1 (d :: a))) (SD (sing @d))- instance SingI d =>- SingI (TyCon3 (D (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (D (d :: a)))) (SD (sing @d))- instance (SingI d, SingI d) =>- SingI (DSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(DSym2 (d :: a) (d :: b))) ((SD (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (D (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (D (d :: a) (d :: b))))- ((SD (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (DSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(DSym3 (d :: a) (d :: b) (d :: c)))- (((SD (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (D (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (D (d :: a) (d :: b) (d :: c))))- (((SD (sing @d)) (sing @d)) (sing @d))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SE sing) sing) sing) sing- instance SingI (ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @ESym0) SE- instance SingI (TyCon4 E :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 E)) SE- instance SingI d =>- SingI (ESym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(ESym1 (d :: a))) (SE (sing @d))- instance SingI d =>- SingI (TyCon3 (E (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (E (d :: a)))) (SE (sing @d))- instance (SingI d, SingI d) =>- SingI (ESym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(ESym2 (d :: a) (d :: b))) ((SE (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (E (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (E (d :: a) (d :: b))))- ((SE (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (ESym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(ESym3 (d :: a) (d :: b) (d :: c)))- (((SE (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (E (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (E (d :: a) (d :: b) (d :: c))))- (((SE (sing @d)) (sing @d)) (sing @d))- instance (SingI n, SingI n, SingI n, SingI n) =>- SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where- sing = (((SF sing) sing) sing) sing- instance SingI (FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @FSym0) SF- instance SingI (TyCon4 F :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where- sing = (singFun4 @(TyCon4 F)) SF- instance SingI d =>- SingI (FSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(FSym1 (d :: a))) (SF (sing @d))- instance SingI d =>- SingI (TyCon3 (F (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where- sing = (singFun3 @(TyCon3 (F (d :: a)))) (SF (sing @d))- instance (SingI d, SingI d) =>- SingI (FSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(FSym2 (d :: a) (d :: b))) ((SF (sing @d)) (sing @d))- instance (SingI d, SingI d) =>- SingI (TyCon2 (F (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where- sing- = (singFun2 @(TyCon2 (F (d :: a) (d :: b))))- ((SF (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (FSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(FSym3 (d :: a) (d :: b) (d :: c)))- (((SF (sing @d)) (sing @d)) (sing @d))- instance (SingI d, SingI d, SingI d) =>- SingI (TyCon1 (F (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where- sing- = (singFun1 @(TyCon1 (F (d :: a) (d :: b) (d :: c))))- (((SF (sing @d)) (sing @d)) (sing @d))
− tests/compile-and-dump/Singletons/OrdDeriving.hs
@@ -1,58 +0,0 @@-module Singletons.OrdDeriving where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- data Nat = Zero | Succ Nat- deriving (Eq, Ord)-- data Foo a b c d = A a b c d- | B a b c d- | C a b c d- | D a b c d- | E a b c d- | F a b c d deriving (Eq,Ord)- |])--foo1a :: Proxy (Zero < Succ Zero)-foo1a = Proxy--foo1b :: Proxy True-foo1b = foo1a--foo2a :: Proxy (Succ (Succ Zero) `Compare` Zero)-foo2a = Proxy--foo2b :: Proxy GT-foo2b = foo2a--foo3a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 4)-foo3a = Proxy--foo3b :: Proxy EQ-foo3b = foo3a--foo4a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 5)-foo4a = Proxy--foo4b :: Proxy LT-foo4b = foo4a--foo5a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 3)-foo5a = Proxy--foo5b :: Proxy GT-foo5b = foo5a--foo6a :: Proxy (A 1 2 3 4 `Compare` B 1 2 3 4)-foo6a = Proxy--foo6b :: Proxy LT-foo6b = foo6a--foo7a :: Proxy (B 1 2 3 4 `Compare` A 1 2 3 4)-foo7a = Proxy--foo7b :: Proxy GT-foo7b = foo7a
− tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template
@@ -1,35 +0,0 @@-Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| symId :: Symbol -> Symbol- symId x = x- foo :: Symbol- foo = symId "foo" |]- ======>- symId :: Symbol -> Symbol- symId x = x- foo :: Symbol- foo = symId "foo"- type SymIdSym1 (a0123456789876543210 :: Symbol) =- SymId a0123456789876543210- instance SuppressUnusedWarnings SymIdSym0 where- suppressUnusedWarnings = snd (((,) SymIdSym0KindInference) ())- data SymIdSym0 :: (~>) Symbol Symbol- where- SymIdSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) =>- SymIdSym0 a0123456789876543210- type instance Apply SymIdSym0 a0123456789876543210 = SymId a0123456789876543210- type FooSym0 = Foo- type family SymId (a :: Symbol) :: Symbol where- SymId x = x- type family Foo :: Symbol where- Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo")- sSymId ::- forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol)- sFoo :: Sing (FooSym0 :: Symbol)- sSymId (sX :: Sing x) = sX- sFoo- = (applySing ((singFun1 @SymIdSym0) sSymId))- (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo"))- instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where- sing = (singFun1 @SymIdSym0) sSymId
− tests/compile-and-dump/Singletons/OverloadedStrings.hs
@@ -1,13 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module OverloadedStrings where--import Data.Singletons.TH-import Data.Singletons.TypeLits--$(singletons- [d| symId :: Symbol -> Symbol- symId x = x-- foo :: Symbol- foo = symId "foo"- |])
− tests/compile-and-dump/Singletons/PatternMatching.ghc86.template
@@ -1,574 +0,0 @@-Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| pr = Pair (Succ Zero) ([Zero])- complex = Pair (Pair (Just Zero) Zero) False- tuple = (False, Just Zero, True)- aList = [Zero, Succ Zero, Succ (Succ Zero)]- - data Pair a b- = Pair a b- deriving Show |]- ======>- data Pair a b- = Pair a b- deriving Show- pr = (Pair (Succ Zero)) [Zero]- complex = (Pair ((Pair (Just Zero)) Zero)) False- tuple = (False, Just Zero, True)- aList = [Zero, Succ Zero, Succ (Succ Zero)]- type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) PairSym1KindInference) ())- data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)- where- PairSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) =>- PairSym1 t0123456789876543210 t0123456789876543210- type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings PairSym0 where- suppressUnusedWarnings = snd (((,) PairSym0KindInference) ())- data PairSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))- where- PairSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>- PairSym0 t0123456789876543210- type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210- type AListSym0 = AList- type TupleSym0 = Tuple- type ComplexSym0 = Complex- type PrSym0 = Pr- type family AList where- AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[]))- type family Tuple where- Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0- type family Complex where- Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0- type family Pr where- Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[])- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210- b0123456789876543210.- (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (Pair a b) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- sAList :: Sing AListSym0- sTuple :: Sing TupleSym0- sComplex :: Sing ComplexSym0- sPr :: Sing PrSym0- sAList- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))))- SNil))- sTuple- = (applySing- ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse))- ((applySing ((singFun1 @JustSym0) SJust)) SZero)))- STrue- sComplex- = (applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing ((singFun1 @JustSym0) SJust)) SZero)))- SZero)))- SFalse- sPr- = (applySing- ((applySing ((singFun2 @PairSym0) SPair))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil)- data instance Sing :: Pair a b -> GHC.Types.Type- where- SPair :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n)- type SPair = (Sing :: Pair a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (Pair a b) where- type Demote (Pair a b) = Pair (Demote a) (Demote b)- fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b)- toSing (Pair (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) }- instance (SShow a, SShow b) => SShow (Pair a b) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Pair "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- deriving instance (Data.Singletons.ShowSing.ShowSing a,- Data.Singletons.ShowSing.ShowSing b) =>- Show (Sing (z :: Pair a b))- instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where- sing = (SPair sing) sing- instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @PairSym0) SPair- instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @(TyCon2 Pair)) SPair- instance SingI d =>- SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where- sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d))- instance SingI d =>- SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where- sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d))-Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| Pair sz lz = pr- Pair (Pair jz zz) fls = complex- (tf, tjz, tt) = tuple- [_, lsz, (Succ blimy)] = aList- lsz :: Nat- fls :: Bool- foo1 :: (a, b) -> a- foo1 (x, y) = (\ _ -> x) y- foo2 :: (# a, b #) -> a- foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b }- silly :: a -> ()- silly x = case x of { _ -> () } |]- ======>- Pair sz lz = pr- Pair (Pair jz zz) fls = complex- (tf, tjz, tt) = tuple- [_, lsz, Succ blimy] = aList- lsz :: Nat- fls :: Bool- foo1 :: (a, b) -> a- foo1 (x, y) = (\ _ -> x) y- foo2 :: (# a, b #) -> a- foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b }- silly :: a -> ()- silly x = case x of { _ -> () }- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x _ = Tuple0Sym0- type Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 =- Let0123456789876543210T x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210TSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210TSym1KindInference) ())- data Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210- where- Let0123456789876543210TSym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Let0123456789876543210TSym1 x0123456789876543210) arg) (Let0123456789876543210TSym2 x0123456789876543210 arg) =>- Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210- type instance Apply (Let0123456789876543210TSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210TSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210TSym0KindInference) ())- data Let0123456789876543210TSym0 x0123456789876543210- where- Let0123456789876543210TSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) =>- Let0123456789876543210TSym0 x0123456789876543210- type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210- type family Let0123456789876543210T x y where- Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y- type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where- Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a- type family Lambda_0123456789876543210 x y a b t where- Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym4KindInference) ())- data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210- y0123456789876543210- a0123456789876543210- b0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 arg) =>- Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210- y0123456789876543210- a0123456789876543210- b0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 y0123456789876543210 x0123456789876543210 b0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 x y t where- Case_0123456789876543210 x y '(a,- b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b- type family Case_0123456789876543210 x y arg_0123456789876543210 t where- Case_0123456789876543210 x y arg_0123456789876543210 _ = x- type family Lambda_0123456789876543210 x y t where- Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210- y0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- y0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '[_,- y_0123456789876543210,- 'Succ _] = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '[_,- _,- 'Succ y_0123456789876543210] = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '(y_0123456789876543210,- _,- _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '(_,- y_0123456789876543210,- _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '(_,- _,- y_0123456789876543210) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Pair ( 'Pair y_0123456789876543210 _) _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Pair ( 'Pair _ y_0123456789876543210) _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Pair ( 'Pair _ _) y_0123456789876543210) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Pair y_0123456789876543210 _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Pair _ y_0123456789876543210) = y_0123456789876543210- type SillySym1 (a0123456789876543210 :: a0123456789876543210) =- Silly a0123456789876543210- instance SuppressUnusedWarnings SillySym0 where- suppressUnusedWarnings = snd (((,) SillySym0KindInference) ())- data SillySym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ()- where- SillySym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) =>- SillySym0 a0123456789876543210- type instance Apply SillySym0 a0123456789876543210 = Silly a0123456789876543210- type Foo2Sym1 (a0123456789876543210 :: (a0123456789876543210,- b0123456789876543210)) =- Foo2 a0123456789876543210- instance SuppressUnusedWarnings Foo2Sym0 where- suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ())- data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) (a0123456789876543210,- b0123456789876543210) a0123456789876543210- where- Foo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>- Foo2Sym0 a0123456789876543210- type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210- type Foo1Sym1 (a0123456789876543210 :: (a0123456789876543210,- b0123456789876543210)) =- Foo1 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) (a0123456789876543210,- b0123456789876543210) a0123456789876543210- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210- type LszSym0 = Lsz- type BlimySym0 = Blimy- type TfSym0 = Tf- type TjzSym0 = Tjz- type TtSym0 = Tt- type JzSym0 = Jz- type ZzSym0 = Zz- type FlsSym0 = Fls- type SzSym0 = Sz- type LzSym0 = Lz- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type family Silly (a :: a) :: () where- Silly x = Case_0123456789876543210 x x- type family Foo2 (a :: (a, b)) :: a where- Foo2 '(x,- y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y)- type family Foo1 (a :: (a, b)) :: a where- Foo1 '(x,- y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y- type family Lsz :: Nat where- Lsz = Case_0123456789876543210 X_0123456789876543210Sym0- type family Blimy where- Blimy = Case_0123456789876543210 X_0123456789876543210Sym0- type family Tf where- Tf = Case_0123456789876543210 X_0123456789876543210Sym0- type family Tjz where- Tjz = Case_0123456789876543210 X_0123456789876543210Sym0- type family Tt where- Tt = Case_0123456789876543210 X_0123456789876543210Sym0- type family Jz where- Jz = Case_0123456789876543210 X_0123456789876543210Sym0- type family Zz where- Zz = Case_0123456789876543210 X_0123456789876543210Sym0- type family Fls :: Bool where- Fls = Case_0123456789876543210 X_0123456789876543210Sym0- type family Sz where- Sz = Case_0123456789876543210 X_0123456789876543210Sym0- type family Lz where- Lz = Case_0123456789876543210 X_0123456789876543210Sym0- type family X_0123456789876543210 where- X_0123456789876543210 = PrSym0- type family X_0123456789876543210 where- X_0123456789876543210 = ComplexSym0- type family X_0123456789876543210 where- X_0123456789876543210 = TupleSym0- type family X_0123456789876543210 where- X_0123456789876543210 = AListSym0- sSilly ::- forall a (t :: a). Sing t -> Sing (Apply SillySym0 t :: ())- sFoo2 ::- forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a)- sFoo1 ::- forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a)- sLsz :: Sing (LszSym0 :: Nat)- sBlimy :: Sing BlimySym0- sTf :: Sing TfSym0- sTjz :: Sing TjzSym0- sTt :: Sing TtSym0- sJz :: Sing JzSym0- sZz :: Sing ZzSym0- sFls :: Sing (FlsSym0 :: Bool)- sSz :: Sing SzSym0- sLz :: Sing LzSym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sSilly (sX :: Sing x)- = (case sX of { _ -> STuple0 }) ::- Sing (Case_0123456789876543210 x x :: ())- sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y))- = let- sT :: Sing (Let0123456789876543210TSym2 x y)- sT- = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY- in (case sT of {- STuple2 (sA :: Sing a) (sB :: Sing b)- -> (applySing- ((singFun1- @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sA }) ::- Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) })))- sB }) ::- Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a)- sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y))- = (applySing- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sX }) ::- Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) })))- sY- sLsz- = (case sX_0123456789876543210 of {- SCons _- (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)- (SCons (SSucc _) SNil))- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat)- sBlimy- = (case sX_0123456789876543210 of {- SCons _- (SCons _- (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210))- SNil))- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sTf- = (case sX_0123456789876543210 of {- STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sTjz- = (case sX_0123456789876543210 of {- STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sTt- = (case sX_0123456789876543210 of {- STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sJz- = (case sX_0123456789876543210 of {- SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210)- _)- _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sZz- = (case sX_0123456789876543210 of {- SPair (SPair _- (sY_0123456789876543210 :: Sing y_0123456789876543210))- _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sFls- = (case sX_0123456789876543210 of {- SPair (SPair _ _)- (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool)- sSz- = (case sX_0123456789876543210 of {- SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sLz- = (case sX_0123456789876543210 of {- SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0)- sX_0123456789876543210 = sPr- sX_0123456789876543210 = sComplex- sX_0123456789876543210 = sTuple- sX_0123456789876543210 = sAList- instance SingI (SillySym0 :: (~>) a ()) where- sing = (singFun1 @SillySym0) sSilly- instance SingI (Foo2Sym0 :: (~>) (a, b) a) where- sing = (singFun1 @Foo2Sym0) sFoo2- instance SingI (Foo1Sym0 :: (~>) (a, b) a) where- sing = (singFun1 @Foo1Sym0) sFoo1
− tests/compile-and-dump/Singletons/PatternMatching.hs
@@ -1,51 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-matches #-}-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}--module Singletons.PatternMatching where--import Data.Singletons.Prelude-import Data.Singletons.Prelude.Show-import Data.Singletons.TH-import Singletons.Nat--$(singletons [d|- data Pair a b = Pair a b deriving Show- pr = Pair (Succ Zero) ([Zero])- complex = Pair (Pair (Just Zero) Zero) False- tuple = (False, Just Zero, True)- aList = [Zero, Succ Zero, Succ (Succ Zero)]- |])--$(singletons [d|- Pair sz lz = pr- Pair (Pair jz zz) fls = complex- (tf, tjz, tt) = tuple- [_, lsz, (Succ blimy)] = aList- lsz :: Nat- fls :: Bool-- foo1 :: (a, b) -> a- foo1 (x, y) = (\_ -> x) y-- foo2 :: (# a, b #) -> a- foo2 t@(# x, y #) = case t of- (# a, b #) -> (\_ -> a) b-- silly :: a -> ()- silly x = case x of _ -> ()- |])--test1 :: Proxy (Foo1 '(Int, Char)) -> Proxy Int-test1 = id--test2 :: Proxy (Foo2 '(Int, Char)) -> Proxy Int-test2 = id--test3 :: Proxy Lsz -> Proxy (Succ Zero)-test3 = id--test4 :: Proxy Blimy -> Proxy (Succ Zero)-test4 = id--test5 :: Proxy Fls -> Proxy False-test5 = id
− tests/compile-and-dump/Singletons/PolyKinds.ghc86.template
@@ -1,28 +0,0 @@-Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class Cls (a :: k) where- fff :: Proxy (a :: k) -> () |]- ======>- class Cls (a :: k) where- fff :: Proxy (a :: k) -> ()- type FffSym1 (arg0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) =- Fff arg0123456789876543210- instance SuppressUnusedWarnings FffSym0 where- suppressUnusedWarnings = snd (((,) FffSym0KindInference) ())- data FffSym0 :: forall k0123456789876543210- (a0123456789876543210 :: k0123456789876543210).- (~>) (Proxy (a0123456789876543210 :: k0123456789876543210)) ()- where- FffSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) =>- FffSym0 arg0123456789876543210- type instance Apply FffSym0 arg0123456789876543210 = Fff arg0123456789876543210- class PCls (a :: k) where- type Fff (arg :: Proxy (a :: k)) :: ()- class SCls (a :: k) where- sFff ::- forall (t :: Proxy (a :: k)).- Sing t -> Sing (Apply FffSym0 t :: ())- instance SCls a =>- SingI (FffSym0 :: (~>) (Proxy (a :: k)) ()) where- sing = (singFun1 @FffSym0) sFff
− tests/compile-and-dump/Singletons/PolyKinds.hs
@@ -1,8 +0,0 @@-module Singletons.PolyKinds where--import Data.Singletons.TH--$(singletons [d|- class Cls (a :: k) where- fff :: Proxy (a :: k) -> ()- |])
− tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.template
@@ -1,12 +0,0 @@-Singletons/PolyKindsApp.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class Cls (a :: k -> Type) where- fff :: (a :: k -> Type) (b :: k) |]- ======>- class Cls (a :: k -> Type) where- fff :: (a :: k -> Type) (b :: k)- type FffSym0 = Fff- class PCls (a :: k -> Type) where- type Fff :: (a :: k -> Type) (b :: k)- class SCls (a :: k -> Type) where- sFff :: forall b. Sing (FffSym0 :: (a :: k -> Type) (b :: k))
− tests/compile-and-dump/Singletons/PolyKindsApp.hs
@@ -1,12 +0,0 @@-module Singletons.PolyKindsApp where--import Data.Kind (Type)-import Data.Singletons.TH--$(singletons [d|- class Cls (a :: k -> Type) where- fff :: (a :: k -> Type) (b :: k)-- -- instance Cls Proxy where- -- fff = Proxy- |])
− tests/compile-and-dump/Singletons/Records.ghc86.template
@@ -1,79 +0,0 @@-Singletons/Records.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |]- ======>- data Record a = MkRecord {field1 :: a, field2 :: Bool}- type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) =- Field1 a0123456789876543210- instance SuppressUnusedWarnings Field1Sym0 where- suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ())- data Field1Sym0 :: forall a0123456789876543210.- (~>) (Record a0123456789876543210) a0123456789876543210- where- Field1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) =>- Field1Sym0 a0123456789876543210- type instance Apply Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210- type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) =- Field2 a0123456789876543210- instance SuppressUnusedWarnings Field2Sym0 where- suppressUnusedWarnings = snd (((,) Field2Sym0KindInference) ())- data Field2Sym0 :: forall a0123456789876543210.- (~>) (Record a0123456789876543210) Bool- where- Field2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) =>- Field2Sym0 a0123456789876543210- type instance Apply Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210- type family Field1 (a :: Record a) :: a where- Field1 (MkRecord field _) = field- type family Field2 (a :: Record a) :: Bool where- Field2 (MkRecord _ field) = field- type MkRecordSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Bool) =- MkRecord t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkRecordSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkRecordSym1KindInference) ())- data MkRecordSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) Bool (Record a0123456789876543210)- where- MkRecordSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkRecordSym1 t0123456789876543210) arg) (MkRecordSym2 t0123456789876543210 arg) =>- MkRecordSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkRecordSym1 t0123456789876543210) t0123456789876543210 = MkRecord t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkRecordSym0 where- suppressUnusedWarnings = snd (((,) MkRecordSym0KindInference) ())- data MkRecordSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) Bool (Record a0123456789876543210))- where- MkRecordSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) =>- MkRecordSym0 t0123456789876543210- type instance Apply MkRecordSym0 t0123456789876543210 = MkRecordSym1 t0123456789876543210- data instance Sing :: Record a -> GHC.Types.Type- where- SMkRecord :: forall a (n :: a) (n :: Bool).- {sField1 :: (Sing (n :: a)), sField2 :: (Sing (n :: Bool))}- -> Sing (MkRecord n n)- type SRecord = (Sing :: Record a -> GHC.Types.Type)- instance SingKind a => SingKind (Record a) where- type Demote (Record a) = Record (Demote a)- fromSing (SMkRecord b b) = (MkRecord (fromSing b)) (fromSing b)- toSing (MkRecord (b :: Demote a) (b :: Demote Bool))- = case- ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing Bool)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkRecord c) c) }- instance (SingI n, SingI n) =>- SingI (MkRecord (n :: a) (n :: Bool)) where- sing = (SMkRecord sing) sing- instance SingI (MkRecordSym0 :: (~>) a ((~>) Bool (Record a))) where- sing = (singFun2 @MkRecordSym0) SMkRecord- instance SingI (TyCon2 MkRecord :: (~>) a ((~>) Bool (Record a))) where- sing = (singFun2 @(TyCon2 MkRecord)) SMkRecord- instance SingI d =>- SingI (MkRecordSym1 (d :: a) :: (~>) Bool (Record a)) where- sing = (singFun1 @(MkRecordSym1 (d :: a))) (SMkRecord (sing @d))- instance SingI d =>- SingI (TyCon1 (MkRecord (d :: a)) :: (~>) Bool (Record a)) where- sing- = (singFun1 @(TyCon1 (MkRecord (d :: a)))) (SMkRecord (sing @d))
− tests/compile-and-dump/Singletons/Records.hs
@@ -1,29 +0,0 @@-module Singletons.Records where--import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|- data Record a = MkRecord { field1 :: a- , field2 :: Bool }-- |])---- This fails - see #66--- $(singletons [d|--- neg :: Record a -> Record a--- neg rec@(MkRecord { field1 = _, field2 = b } ) = rec {field2 = not b}--- |])--foo1a :: Proxy (Field2 (MkRecord 5 True))-foo1a = Proxy--foo1b :: Proxy True-foo1b = foo1a--foo2a :: Proxy (Field1 (MkRecord 5 True))-foo2a = Proxy--foo2b :: Proxy 5-foo2b = foo2a
− tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template
@@ -1,98 +0,0 @@-Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| returnFunc :: Nat -> Nat -> Nat- returnFunc _ = Succ- id :: a -> a- id x = x- idFoo :: c -> a -> a- idFoo _ = id |]- ======>- returnFunc :: Nat -> Nat -> Nat- returnFunc _ = Succ- id :: a -> a- id x = x- idFoo :: c -> a -> a- idFoo _ = id- type IdSym1 (a0123456789876543210 :: a0123456789876543210) =- Id a0123456789876543210- instance SuppressUnusedWarnings IdSym0 where- suppressUnusedWarnings = snd (((,) IdSym0KindInference) ())- data IdSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- IdSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) =>- IdSym0 a0123456789876543210- type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210- type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) =- IdFoo a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) IdFooSym1KindInference) ())- data IdFooSym1 (a0123456789876543210 :: c0123456789876543210) :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- IdFooSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) =>- IdFooSym1 a0123456789876543210 a0123456789876543210- type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings IdFooSym0 where- suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ())- data IdFooSym0 :: forall a0123456789876543210 c0123456789876543210.- (~>) c0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210)- where- IdFooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) =>- IdFooSym0 a0123456789876543210- type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210- type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- ReturnFunc a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) ReturnFuncSym1KindInference) ())- data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- ReturnFuncSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) =>- ReturnFuncSym1 a0123456789876543210 a0123456789876543210- type instance Apply (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ReturnFuncSym0 where- suppressUnusedWarnings = snd (((,) ReturnFuncSym0KindInference) ())- data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)- where- ReturnFuncSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) =>- ReturnFuncSym0 a0123456789876543210- type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210- type family Id (a :: a) :: a where- Id x = x- type family IdFoo (a :: c) (a :: a) :: a where- IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210- type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where- ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210- sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a)- sIdFoo ::- forall c a (t :: c) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a)- sReturnFunc ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat)- sId (sX :: Sing x) = sX- sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210- sReturnFunc- _- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210- instance SingI (IdSym0 :: (~>) a a) where- sing = (singFun1 @IdSym0) sId- instance SingI (IdFooSym0 :: (~>) c ((~>) a a)) where- sing = (singFun2 @IdFooSym0) sIdFoo- instance SingI d => SingI (IdFooSym1 (d :: c) :: (~>) a a) where- sing = (singFun1 @(IdFooSym1 (d :: c))) (sIdFoo (sing @d))- instance SingI (ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)) where- sing = (singFun2 @ReturnFuncSym0) sReturnFunc- instance SingI d =>- SingI (ReturnFuncSym1 (d :: Nat) :: (~>) Nat Nat) where- sing- = (singFun1 @(ReturnFuncSym1 (d :: Nat))) (sReturnFunc (sing @d))
− tests/compile-and-dump/Singletons/ReturnFunc.hs
@@ -1,23 +0,0 @@-module Singletons.ReturnFunc where--import Data.Singletons-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Singletons.Nat---- tests the "num args" feature of promoteDec. The idea is that when clauses of--- a function have less patterns than required by the type signature the--- promoted type family should have this fact reflected in its return kind,--- which should be turned into a series of nested TyFuns (type level functions)--$(singletons [d|- returnFunc :: Nat -> Nat -> Nat- returnFunc _ = Succ-- -- promotion of two functions below also depends on "num args"- id :: a -> a- id x = x-- idFoo :: c -> a -> a- idFoo _ = id- |])
− tests/compile-and-dump/Singletons/Sections.ghc86.template
@@ -1,122 +0,0 @@-Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)- foo1 :: [Nat]- foo1 = map ((Succ Zero) +) [Zero, Succ Zero]- foo2 :: [Nat]- foo2 = map (+ (Succ Zero)) [Zero, Succ Zero]- foo3 :: [Nat]- foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |]- ======>- (+) :: Nat -> Nat -> Nat- (+) Zero m = m- (+) (Succ n) m = Succ (n + m)- foo1 :: [Nat]- foo1 = (map (Succ Zero +)) [Zero, Succ Zero]- foo2 :: [Nat]- foo2 = (map (+ Succ Zero)) [Zero, Succ Zero]- foo3 :: [Nat]- foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero]- type family Lambda_0123456789876543210 t where- Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0)- type Lambda_0123456789876543210Sym1 t0123456789876543210 =- Lambda_0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 t0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 t0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210- type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- (+) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ())- data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:+@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) =>- (+@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (+@#@$) where- suppressUnusedWarnings = snd (((,) (:+@#@$###)) ())- data (+@#@$) :: (~>) Nat ((~>) Nat Nat)- where- (:+@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>- (+@#@$) a0123456789876543210- type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210- type Foo1Sym0 = Foo1- type Foo2Sym0 = Foo2- type Foo3Sym0 = Foo3- type family (+) (a :: Nat) (a :: Nat) :: Nat where- (+) 'Zero m = m- (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m)- type family Foo1 :: [Nat] where- Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))- type family Foo2 :: [Nat] where- Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))- type family Foo3 :: [Nat] where- Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))- (%+) ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat)- sFoo1 :: Sing (Foo1Sym0 :: [Nat])- sFoo2 :: Sing (Foo2Sym0 :: [Nat])- sFoo3 :: Sing (Foo3Sym0 :: [Nat])- (%+) SZero (sM :: Sing m) = sM- (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)- = (applySing ((singFun1 @SuccSym0) SSucc))- ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM)- sFoo1- = (applySing- ((applySing ((singFun2 @MapSym0) sMap))- ((applySing ((singFun2 @(+@#@$)) (%+)))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- SNil))- sFoo2- = (applySing- ((applySing ((singFun2 @MapSym0) sMap))- ((singFun1 @Lambda_0123456789876543210Sym0)- (\ sLhs_0123456789876543210- -> case sLhs_0123456789876543210 of {- (_ :: Sing lhs_0123456789876543210)- -> (applySing- ((applySing ((singFun2 @(+@#@$)) (%+))) sLhs_0123456789876543210))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) }))))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- SNil))- sFoo3- = (applySing- ((applySing- ((applySing ((singFun3 @ZipWithSym0) sZipWith))- ((singFun2 @(+@#@$)) (%+))))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- SNil))))- ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))- SNil))- instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where- sing = (singFun2 @(+@#@$)) (%+)- instance SingI d =>- SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where- sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d))
− tests/compile-and-dump/Singletons/Sections.hs
@@ -1,40 +0,0 @@-module Singletons.Sections where--import Data.Singletons-import Data.Singletons.Prelude.List-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH-import Singletons.Nat--$(singletons [d|- (+) :: Nat -> Nat -> Nat- Zero + m = m- (Succ n) + m = Succ (n + m)-- foo1 :: [Nat]- foo1 = map ((Succ Zero)+) [Zero, Succ Zero]-- foo2 :: [Nat]- foo2 = map (+(Succ Zero)) [Zero, Succ Zero]-- foo3 :: [Nat]- foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero]- |])--foo1a :: Proxy Foo1-foo1a = Proxy--foo1b :: Proxy [Succ Zero, Succ (Succ Zero)]-foo1b = foo1a--foo2a :: Proxy Foo2-foo2a = Proxy--foo2b :: Proxy [Succ Zero, Succ (Succ Zero)]-foo2b = foo2a--foo3a :: Proxy Foo3-foo3a = Proxy--foo3b :: Proxy [Succ Zero, Succ (Succ Zero)]-foo3b = foo3a
− tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template
@@ -1,582 +0,0 @@-Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixl 5 `MkFoo2b`, :*:, :&:- - data Foo1- = MkFoo1- deriving Show- data Foo2 a- = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a- deriving Show- data Foo3- = MkFoo3 {getFoo3a :: Bool, *** :: Bool}- deriving Show |]- ======>- data Foo1- = MkFoo1- deriving Show- infixl 5 `MkFoo2b`- infixl 5 :*:- infixl 5 :&:- data Foo2 a- = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a- deriving Show- data Foo3- = MkFoo3 {getFoo3a :: Bool, *** :: Bool}- deriving Show- type GetFoo3aSym1 (a0123456789876543210 :: Foo3) =- GetFoo3a a0123456789876543210- instance SuppressUnusedWarnings GetFoo3aSym0 where- suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ())- data GetFoo3aSym0 :: (~>) Foo3 Bool- where- GetFoo3aSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) =>- GetFoo3aSym0 a0123456789876543210- type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210- type (***@#@$$) (a0123456789876543210 :: Foo3) =- (***) a0123456789876543210- instance SuppressUnusedWarnings (***@#@$) where- suppressUnusedWarnings = snd (((,) (:***@#@$###)) ())- data (***@#@$) :: (~>) Foo3 Bool- where- (:***@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) =>- (***@#@$) a0123456789876543210- type instance Apply (***@#@$) a0123456789876543210 = (***) a0123456789876543210- type family GetFoo3a (a :: Foo3) :: Bool where- GetFoo3a (MkFoo3 field _) = field- type family (***) (a :: Foo3) :: Bool where- (***) (MkFoo3 _ field) = field- type MkFoo1Sym0 = MkFoo1- type MkFoo2aSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) =- MkFoo2a t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkFoo2aSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkFoo2aSym1KindInference) ())- data MkFoo2aSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210)- where- MkFoo2aSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkFoo2aSym1 t0123456789876543210) arg) (MkFoo2aSym2 t0123456789876543210 arg) =>- MkFoo2aSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkFoo2aSym1 t0123456789876543210) t0123456789876543210 = MkFoo2a t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkFoo2aSym0 where- suppressUnusedWarnings = snd (((,) MkFoo2aSym0KindInference) ())- data MkFoo2aSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210))- where- MkFoo2aSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) =>- MkFoo2aSym0 t0123456789876543210- type instance Apply MkFoo2aSym0 t0123456789876543210 = MkFoo2aSym1 t0123456789876543210- type MkFoo2bSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) =- MkFoo2b t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkFoo2bSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkFoo2bSym1KindInference) ())- data MkFoo2bSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210)- where- MkFoo2bSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkFoo2bSym1 t0123456789876543210) arg) (MkFoo2bSym2 t0123456789876543210 arg) =>- MkFoo2bSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkFoo2bSym1 t0123456789876543210) t0123456789876543210 = MkFoo2b t0123456789876543210 t0123456789876543210- infixl 5 `MkFoo2bSym1`- instance SuppressUnusedWarnings MkFoo2bSym0 where- suppressUnusedWarnings = snd (((,) MkFoo2bSym0KindInference) ())- data MkFoo2bSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210))- where- MkFoo2bSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) =>- MkFoo2bSym0 t0123456789876543210- type instance Apply MkFoo2bSym0 t0123456789876543210 = MkFoo2bSym1 t0123456789876543210- infixl 5 `MkFoo2bSym0`- type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) =- (:*:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ())- data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210)- where- (::*:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) =>- (:*:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210- infixl 5 :*:@#@$$- instance SuppressUnusedWarnings (:*:@#@$) where- suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ())- data (:*:@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210))- where- (::*:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>- (:*:@#@$) t0123456789876543210- type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210- infixl 5 :*:@#@$- type (:&:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) =- (:&:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:&:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::&:@#@$$###)) ())- data (:&:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210)- where- (::&:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:&:@#@$$) t0123456789876543210) arg) ((:&:@#@$$$) t0123456789876543210 arg) =>- (:&:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:&:@#@$$) t0123456789876543210) t0123456789876543210 = (:&:) t0123456789876543210 t0123456789876543210- infixl 5 :&:@#@$$- instance SuppressUnusedWarnings (:&:@#@$) where- suppressUnusedWarnings = snd (((,) (::&:@#@$###)) ())- data (:&:@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210))- where- (::&:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) =>- (:&:@#@$) t0123456789876543210- type instance Apply (:&:@#@$) t0123456789876543210 = (:&:@#@$$) t0123456789876543210- infixl 5 :&:@#@$- type MkFoo3Sym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) =- MkFoo3 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkFoo3Sym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkFoo3Sym1KindInference) ())- data MkFoo3Sym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo3- where- MkFoo3Sym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkFoo3Sym1 t0123456789876543210) arg) (MkFoo3Sym2 t0123456789876543210 arg) =>- MkFoo3Sym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkFoo3Sym1 t0123456789876543210) t0123456789876543210 = MkFoo3 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkFoo3Sym0 where- suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ())- data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)- where- MkFoo3Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>- MkFoo3Sym0 t0123456789876543210- type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo1 ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Foo1 where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2a arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo2a ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210.- (~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) GHC.Types.Nat ((~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (Foo2 a) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo3 ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Foo3 where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- infixl 5 `SMkFoo2b`- infixl 5 :%*:- infixl 5 :%&:- data instance Sing :: Foo1 -> GHC.Types.Type- where SMkFoo1 :: Sing MkFoo1- type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type)- instance SingKind Foo1 where- type Demote Foo1 = Foo1- fromSing SMkFoo1 = MkFoo1- toSing MkFoo1 = SomeSing SMkFoo1- data instance Sing :: Foo2 a -> GHC.Types.Type- where- SMkFoo2a :: forall a (n :: a) (n :: a).- (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n)- SMkFoo2b :: forall a (n :: a) (n :: a).- (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n)- (:%*:) :: forall a (n :: a) (n :: a).- (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n)- (:%&:) :: forall a (n :: a) (n :: a).- (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:&:) n n)- type SFoo2 = (Sing :: Foo2 a -> GHC.Types.Type)- instance SingKind a => SingKind (Foo2 a) where- type Demote (Foo2 a) = Foo2 (Demote a)- fromSing (SMkFoo2a b b) = (MkFoo2a (fromSing b)) (fromSing b)- fromSing (SMkFoo2b b b) = (MkFoo2b (fromSing b)) (fromSing b)- fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b)- fromSing ((:%&:) b b) = ((:&:) (fromSing b)) (fromSing b)- toSing (MkFoo2a (b :: Demote a) (b :: Demote a))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2a c) c) }- toSing (MkFoo2b (b :: Demote a) (b :: Demote a))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2b c) c) }- toSing ((:*:) (b :: Demote a) (b :: Demote a))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) }- toSing ((:&:) (b :: Demote a) (b :: Demote a))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&:) c) c) }- data instance Sing :: Foo3 -> GHC.Types.Type- where- SMkFoo3 :: forall (n :: Bool) (n :: Bool).- {sGetFoo3a :: (Sing (n :: Bool)), %*** :: (Sing (n :: Bool))}- -> Sing (MkFoo3 n n)- type SFoo3 = (Sing :: Foo3 -> GHC.Types.Type)- instance SingKind Foo3 where- type Demote Foo3 = Foo3- fromSing (SMkFoo3 b b) = (MkFoo3 (fromSing b)) (fromSing b)- toSing (MkFoo3 (b :: Demote Bool) (b :: Demote Bool))- = case- ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo3 c) c) }- instance SShow Foo1 where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Foo1) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- SMkFoo1- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "MkFoo1")))- sA_0123456789876543210- instance SShow a => SShow (Foo2 a) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Foo2 a) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Foo2 a) ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SMkFoo2a (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "MkFoo2a "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SMkFoo2b (sArgL_0123456789876543210 :: Sing argL_0123456789876543210)- (sArgR_0123456789876543210 :: Sing argR_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 5)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 6))))- sArgL_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing " `MkFoo2b` "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 6))))- sArgR_0123456789876543210)))))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- ((:%*:) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "(:*:) "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- ((:%&:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210)- (sArgR_0123456789876543210 :: Sing argR_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 5)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 6))))- sArgL_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing " :&: "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 6))))- sArgR_0123456789876543210)))))- sA_0123456789876543210- instance SShow Bool => SShow Foo3 where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Foo3) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SMkFoo3 (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "MkFoo3 "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowCharSym0) sShowChar))- (sing :: Sing "{"))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "getFoo3a = "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 0))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowCommaSpaceSym0) sShowCommaSpace)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "(***) = "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 0))))- sArg_0123456789876543210)))- ((applySing ((singFun2 @ShowCharSym0) sShowChar))- (sing :: Sing "}")))))))))))- sA_0123456789876543210- deriving instance Show (Sing (z :: Foo1))- deriving instance Data.Singletons.ShowSing.ShowSing a =>- Show (Sing (z :: Foo2 a))- deriving instance Data.Singletons.ShowSing.ShowSing Bool =>- Show (Sing (z :: Foo3))- instance SingI MkFoo1 where- sing = SMkFoo1- instance (SingI n, SingI n) =>- SingI (MkFoo2a (n :: a) (n :: a)) where- sing = (SMkFoo2a sing) sing- instance SingI (MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @MkFoo2aSym0) SMkFoo2a- instance SingI (TyCon2 MkFoo2a :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(TyCon2 MkFoo2a)) SMkFoo2a- instance SingI d =>- SingI (MkFoo2aSym1 (d :: a) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(MkFoo2aSym1 (d :: a))) (SMkFoo2a (sing @d))- instance SingI d =>- SingI (TyCon1 (MkFoo2a (d :: a)) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(TyCon1 (MkFoo2a (d :: a)))) (SMkFoo2a (sing @d))- instance (SingI n, SingI n) =>- SingI (MkFoo2b (n :: a) (n :: a)) where- sing = (SMkFoo2b sing) sing- instance SingI (MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @MkFoo2bSym0) SMkFoo2b- instance SingI (TyCon2 MkFoo2b :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(TyCon2 MkFoo2b)) SMkFoo2b- instance SingI d =>- SingI (MkFoo2bSym1 (d :: a) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(MkFoo2bSym1 (d :: a))) (SMkFoo2b (sing @d))- instance SingI d =>- SingI (TyCon1 (MkFoo2b (d :: a)) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(TyCon1 (MkFoo2b (d :: a)))) (SMkFoo2b (sing @d))- instance (SingI n, SingI n) =>- SingI ((:*:) (n :: a) (n :: a)) where- sing = ((:%*:) sing) sing- instance SingI ((:*:@#@$) :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(:*:@#@$)) (:%*:)- instance SingI (TyCon2 (:*:) :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(TyCon2 (:*:))) (:%*:)- instance SingI d =>- SingI ((:*:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where- sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:*:) (d :: a)) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d))- instance (SingI n, SingI n) =>- SingI ((:&:) (n :: a) (n :: a)) where- sing = ((:%&:) sing) sing- instance SingI ((:&:@#@$) :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(:&:@#@$)) (:%&:)- instance SingI (TyCon2 (:&:) :: (~>) a ((~>) a (Foo2 a))) where- sing = (singFun2 @(TyCon2 (:&:))) (:%&:)- instance SingI d =>- SingI ((:&:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where- sing = (singFun1 @((:&:@#@$$) (d :: a))) ((:%&:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:&:) (d :: a)) :: (~>) a (Foo2 a)) where- sing = (singFun1 @(TyCon1 ((:&:) (d :: a)))) ((:%&:) (sing @d))- instance (SingI n, SingI n) =>- SingI (MkFoo3 (n :: Bool) (n :: Bool)) where- sing = (SMkFoo3 sing) sing- instance SingI (MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)) where- sing = (singFun2 @MkFoo3Sym0) SMkFoo3- instance SingI (TyCon2 MkFoo3 :: (~>) Bool ((~>) Bool Foo3)) where- sing = (singFun2 @(TyCon2 MkFoo3)) SMkFoo3- instance SingI d =>- SingI (MkFoo3Sym1 (d :: Bool) :: (~>) Bool Foo3) where- sing = (singFun1 @(MkFoo3Sym1 (d :: Bool))) (SMkFoo3 (sing @d))- instance SingI d =>- SingI (TyCon1 (MkFoo3 (d :: Bool)) :: (~>) Bool Foo3) where- sing- = (singFun1 @(TyCon1 (MkFoo3 (d :: Bool)))) (SMkFoo3 (sing @d))
− tests/compile-and-dump/Singletons/ShowDeriving.hs
@@ -1,41 +0,0 @@-module Singletons.ShowDeriving where--import Data.Type.Equality-import Data.Singletons.Prelude-import Data.Singletons.Prelude.Show-import Data.Singletons.TH--$(singletons [d|- data Foo1 = MkFoo1 deriving Show-- infixl 5 `MkFoo2b`, :*:, :&:- data Foo2 a = MkFoo2a a a- | a `MkFoo2b` a- | (:*:) a a- | a :&: a- deriving Show-- data Foo3 = MkFoo3 { getFoo3a :: Bool, (***) :: Bool } deriving Show-- |])--foo1 :: "MkFoo1" :~: Show_ MkFoo1-foo1 = Refl--foo2a :: "(MkFoo2a LT GT)" :~: ShowsPrec 11 (MkFoo2a LT GT) ""-foo2a = Refl--foo2b :: "True `MkFoo2b` False" :~: Show_ (True `MkFoo2b` False)-foo2b = Refl--foo2c :: "(:*:) () ()" :~: Show_ ('() :*: '())-foo2c = Refl--foo2d' :: "False :&: True" :~: ShowsPrec 5 (False :&: True) ""-foo2d' = Refl--foo2d'' :: "(False :&: True)" :~: ShowsPrec 6 (False :&: True) ""-foo2d'' = Refl--foo3 :: "MkFoo3 {getFoo3a = True, (***) = False}" :~: Show_ (MkFoo3 True False)-foo3 = Refl
− tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template
@@ -1,447 +0,0 @@-Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixl 6 :*:- - data T a b = a :*: b- data S = S1 | S2- - deriving instance Enum S- deriving instance Bounded S- deriving instance Show S- deriving instance Ord S- deriving instance Eq S- deriving instance Show a => Show (T a ())- deriving instance Ord a => Ord (T a ())- deriving instance Eq a => Eq (T a ()) |]- ======>- infixl 6 :*:- data T a b = a :*: b- data S = S1 | S2- deriving instance Eq a => Eq (T a ())- deriving instance Ord a => Ord (T a ())- deriving instance Show a => Show (T a ())- deriving instance Eq S- deriving instance Ord S- deriving instance Show S- deriving instance Bounded S- deriving instance Enum S- type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- (:*:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ())- data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210)- where- (::*:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) =>- (:*:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210- infixl 6 :*:@#@$$- instance SuppressUnusedWarnings (:*:@#@$) where- suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ())- data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210))- where- (::*:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>- (:*:@#@$) t0123456789876543210- type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210- infixl 6 :*:@#@$- type S1Sym0 = S1- type S2Sym0 = S2- type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where- Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: T a0123456789876543210 ()) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) (T a0123456789876543210 ()) Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) (T a0123456789876543210 ()) ((~>) (T a0123456789876543210 ()) Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd (T a ()) where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210.- (~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) GHC.Types.Nat ((~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (T a ()) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where- Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 S1 S2 = LTSym0- Compare_0123456789876543210 S2 S1 = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: S) :: (~>) S Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd S where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210- ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) S ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) S ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow S where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family MinBound_0123456789876543210 :: S where- MinBound_0123456789876543210 = S1Sym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: S where- MaxBound_0123456789876543210 = S2Sym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded S where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = S2Sym0- Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = S1Sym0- Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1))- type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where- ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0))- type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) =- ToEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ())- data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat S- where- ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>- ToEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210- type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where- FromEnum_0123456789876543210 S1 = FromInteger 0- FromEnum_0123456789876543210 S2 = FromInteger 1- type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) =- FromEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ())- data FromEnum_0123456789876543210Sym0 :: (~>) S GHC.Types.Nat- where- FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>- FromEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210- instance PEnum S where- type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a- type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a- type family Equals_0123456789876543210 (a :: T a ()) (b :: T a ()) :: Bool where- Equals_0123456789876543210 ((:*:) a a) ((:*:) b b) = (&&) ((==) a b) ((==) a b)- Equals_0123456789876543210 (_ :: T a ()) (_ :: T a ()) = FalseSym0- instance PEq (T a ()) where- type (==) a b = Equals_0123456789876543210 a b- type family Equals_0123456789876543210 (a :: S) (b :: S) :: Bool where- Equals_0123456789876543210 S1 S1 = TrueSym0- Equals_0123456789876543210 S2 S2 = TrueSym0- Equals_0123456789876543210 (_ :: S) (_ :: S) = FalseSym0- instance PEq S where- type (==) a b = Equals_0123456789876543210 a b- infixl 6 :%*:- data instance Sing :: T a b -> GHC.Types.Type- where- (:%*:) :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n)- type ST = (Sing :: T a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (T a b) where- type Demote (T a b) = T (Demote a) (Demote b)- fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b)- toSing ((:*:) (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) }- data instance Sing :: S -> GHC.Types.Type- where- SS1 :: Sing S1- SS2 :: Sing S2- type SS = (Sing :: S -> GHC.Types.Type)- instance SingKind S where- type Demote S = S- fromSing SS1 = S1- fromSing SS2 = S2- toSing S1 = SomeSing SS1- toSing S2 = SomeSing SS2- instance SOrd a => SOrd (T a ()) where- sCompare ::- forall (t1 :: T a ()) (t2 :: T a ()).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun (T a ()) ((~>) (T a ()) Ordering)- -> GHC.Types.Type) t1) t2)- sCompare- ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))- instance SShow a => SShow (T a ()) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: T a ()) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (T a ()) ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- ((:%*:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210)- (sArgR_0123456789876543210 :: Sing argR_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 6)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 7))))- sArgL_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing " :*: "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 7))))- sArgR_0123456789876543210)))))- sA_0123456789876543210- instance SOrd S where- sCompare ::- forall (t1 :: S) (t2 :: S).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun S ((~>) S Ordering)- -> GHC.Types.Type) t1) t2)- sCompare SS1 SS1- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare SS2 SS2- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare SS1 SS2 = SLT- sCompare SS2 SS1 = SGT- instance SShow S where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: S) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) S ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- SS1- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "S1")))- sA_0123456789876543210- sShowsPrec- _- SS2- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "S2")))- sA_0123456789876543210- instance SBounded S where- sMinBound :: Sing (MinBoundSym0 :: S)- sMaxBound :: Sing (MaxBoundSym0 :: S)- sMinBound = SS1- sMaxBound = SS2- instance SEnum S where- sToEnum ::- forall (t :: GHC.Types.Nat).- Sing t- -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat S- -> GHC.Types.Type) t)- sFromEnum ::- forall (t :: S).- Sing t- -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Types.Nat- -> GHC.Types.Type) t)- sToEnum (sN :: Sing n)- = (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (sFromInteger (sing :: Sing 0))- of- STrue -> SS1- SFalse- -> (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (sFromInteger (sing :: Sing 1))- of- STrue -> SS2- SFalse -> sError (sing :: Sing "toEnum: bad argument")) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))- sFromEnum SS1 = sFromInteger (sing :: Sing 0)- sFromEnum SS2 = sFromInteger (sing :: Sing 1)- instance SEq a => SEq (T a ()) where- (%==) ((:%*:) a a) ((:%*:) b b)- = ((%&&) (((%==) a) b)) (((%==) a) b)- instance SDecide a => SDecide (T a ()) where- (%~) ((:%*:) a a) ((:%*:) b b)- = case ((,) (((%~) a) b)) (((%~) a) b) of- (,) (Proved Refl) (Proved Refl) -> Proved Refl- (,) (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,) _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SEq S where- (%==) SS1 SS1 = STrue- (%==) SS1 SS2 = SFalse- (%==) SS2 SS1 = SFalse- (%==) SS2 SS2 = STrue- instance SDecide S where- (%~) SS1 SS1 = Proved Refl- (%~) SS1 SS2 = Disproved (\ x -> case x of)- (%~) SS2 SS1 = Disproved (\ x -> case x of)- (%~) SS2 SS2 = Proved Refl- deriving instance Data.Singletons.ShowSing.ShowSing a =>- Show (Sing (z :: T a ()))- deriving instance Show (Sing (z :: S))- instance (SingI n, SingI n) =>- SingI ((:*:) (n :: a) (n :: b)) where- sing = ((:%*:) sing) sing- instance SingI ((:*:@#@$) :: (~>) a ((~>) b (T a b))) where- sing = (singFun2 @(:*:@#@$)) (:%*:)- instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b (T a b))) where- sing = (singFun2 @(TyCon2 (:*:))) (:%*:)- instance SingI d =>- SingI ((:*:@#@$$) (d :: a) :: (~>) b (T a b)) where- sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b (T a b)) where- sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d))- instance SingI S1 where- sing = SS1- instance SingI S2 where- sing = SS2
− tests/compile-and-dump/Singletons/StandaloneDeriving.hs
@@ -1,30 +0,0 @@-module Singletons.StandaloneDeriving where--import Data.Singletons.Prelude-import Data.Singletons.Prelude.Show-import Data.Singletons.TH--$(singletons [d|-- infixl 6 :*:- data T a b = a :*: b- data S = S1 | S2-- deriving instance Eq a => Eq (T a ())- deriving instance Ord a => Ord (T a ())- deriving instance Show a => Show (T a ())-- deriving instance Eq S- deriving instance Ord S- deriving instance Show S- deriving instance Bounded S- deriving instance Enum S-- |])---- Ensure that the fixity is discovered-test1 :: "() :*: ()" :~: ShowsPrec 6 ('() :*: '()) ""-test1 = Refl--test2 :: "(() :*: ())" :~: ShowsPrec 7 ('() :*: '()) ""-test2 = Refl
− tests/compile-and-dump/Singletons/Star.ghc86.template
@@ -1,422 +0,0 @@-Singletons/Star.hs:0:0:: Splicing declarations- singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec]- ======>- data Rep :: Type- where- Singletons.Star.Nat :: Rep- Singletons.Star.Int :: Rep- Singletons.Star.String :: Rep- Singletons.Star.Maybe :: Rep -> Rep- Singletons.Star.Vec :: Rep -> Nat -> Rep- deriving (Eq, Ord, Read, Show)- type NatSym0 = Nat- type IntSym0 = Int- type StringSym0 = String- type MaybeSym1 (t0123456789876543210 :: Type) =- Maybe t0123456789876543210- instance SuppressUnusedWarnings MaybeSym0 where- suppressUnusedWarnings = snd (((,) MaybeSym0KindInference) ())- data MaybeSym0 :: (~>) Type Type- where- MaybeSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) =>- MaybeSym0 t0123456789876543210- type instance Apply MaybeSym0 t0123456789876543210 = Maybe t0123456789876543210- type VecSym2 (t0123456789876543210 :: Type) (t0123456789876543210 :: Nat) =- Vec t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (VecSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) VecSym1KindInference) ())- data VecSym1 (t0123456789876543210 :: Type) :: (~>) Nat Type- where- VecSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (VecSym1 t0123456789876543210) arg) (VecSym2 t0123456789876543210 arg) =>- VecSym1 t0123456789876543210 t0123456789876543210- type instance Apply (VecSym1 t0123456789876543210) t0123456789876543210 = Vec t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings VecSym0 where- suppressUnusedWarnings = snd (((,) VecSym0KindInference) ())- data VecSym0 :: (~>) Type ((~>) Nat Type)- where- VecSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) =>- VecSym0 t0123456789876543210- type instance Apply VecSym0 t0123456789876543210 = VecSym1 t0123456789876543210- type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where- Equals_0123456789876543210 Nat Nat = TrueSym0- Equals_0123456789876543210 Int Int = TrueSym0- Equals_0123456789876543210 String String = TrueSym0- Equals_0123456789876543210 (Maybe a) (Maybe b) = (==) a b- Equals_0123456789876543210 (Vec a a) (Vec b b) = (&&) ((==) a b) ((==) a b)- Equals_0123456789876543210 (_ :: Type) (_ :: Type) = FalseSym0- instance PEq Type where- type (==) a b = Equals_0123456789876543210 a b- type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where- Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]))- Compare_0123456789876543210 Nat Int = LTSym0- Compare_0123456789876543210 Nat String = LTSym0- Compare_0123456789876543210 Nat (Maybe _) = LTSym0- Compare_0123456789876543210 Nat (Vec _ _) = LTSym0- Compare_0123456789876543210 Int Nat = GTSym0- Compare_0123456789876543210 Int String = LTSym0- Compare_0123456789876543210 Int (Maybe _) = LTSym0- Compare_0123456789876543210 Int (Vec _ _) = LTSym0- Compare_0123456789876543210 String Nat = GTSym0- Compare_0123456789876543210 String Int = GTSym0- Compare_0123456789876543210 String (Maybe _) = LTSym0- Compare_0123456789876543210 String (Vec _ _) = LTSym0- Compare_0123456789876543210 (Maybe _) Nat = GTSym0- Compare_0123456789876543210 (Maybe _) Int = GTSym0- Compare_0123456789876543210 (Maybe _) String = GTSym0- Compare_0123456789876543210 (Maybe _) (Vec _ _) = LTSym0- Compare_0123456789876543210 (Vec _ _) Nat = GTSym0- Compare_0123456789876543210 (Vec _ _) Int = GTSym0- Compare_0123456789876543210 (Vec _ _) String = GTSym0- Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Type) :: (~>) Type Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Type where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ Nat a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nat") a_0123456789876543210- ShowsPrec_0123456789876543210 _ Int a_0123456789876543210 = Apply (Apply ShowStringSym0 "Int") a_0123456789876543210- ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Type ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Type where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- data instance Sing :: Type -> Type- where- SNat :: Sing Nat- SInt :: Sing Int- SString :: Sing String- SMaybe :: forall (n :: Type). (Sing (n :: Type)) -> Sing (Maybe n)- SVec :: forall (n :: Type) (n :: Nat).- (Sing (n :: Type)) -> (Sing (n :: Nat)) -> Sing (Vec n n)- type SRep = (Sing :: Type -> Type)- instance SingKind Type where- type Demote Type = Rep- fromSing SNat = Singletons.Star.Nat- fromSing SInt = Singletons.Star.Int- fromSing SString = Singletons.Star.String- fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b)- fromSing (SVec b b)- = (Singletons.Star.Vec (fromSing b)) (fromSing b)- toSing Singletons.Star.Nat = SomeSing SNat- toSing Singletons.Star.Int = SomeSing SInt- toSing Singletons.Star.String = SomeSing SString- toSing (Singletons.Star.Maybe (b :: Demote Type))- = case toSing b :: SomeSing Type of {- SomeSing c -> SomeSing (SMaybe c) }- toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat))- = case- ((,) (toSing b :: SomeSing Type)) (toSing b :: SomeSing Nat)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVec c) c) }- instance (SEq Type, SEq Nat) => SEq Type where- (%==) SNat SNat = STrue- (%==) SNat SInt = SFalse- (%==) SNat SString = SFalse- (%==) SNat (SMaybe _) = SFalse- (%==) SNat (SVec _ _) = SFalse- (%==) SInt SNat = SFalse- (%==) SInt SInt = STrue- (%==) SInt SString = SFalse- (%==) SInt (SMaybe _) = SFalse- (%==) SInt (SVec _ _) = SFalse- (%==) SString SNat = SFalse- (%==) SString SInt = SFalse- (%==) SString SString = STrue- (%==) SString (SMaybe _) = SFalse- (%==) SString (SVec _ _) = SFalse- (%==) (SMaybe _) SNat = SFalse- (%==) (SMaybe _) SInt = SFalse- (%==) (SMaybe _) SString = SFalse- (%==) (SMaybe a) (SMaybe b) = ((%==) a) b- (%==) (SMaybe _) (SVec _ _) = SFalse- (%==) (SVec _ _) SNat = SFalse- (%==) (SVec _ _) SInt = SFalse- (%==) (SVec _ _) SString = SFalse- (%==) (SVec _ _) (SMaybe _) = SFalse- (%==) (SVec a a) (SVec b b) = ((%&&) (((%==) a) b)) (((%==) a) b)- instance (SDecide Type, SDecide Nat) => SDecide Type where- (%~) SNat SNat = Proved Refl- (%~) SNat SInt = Disproved (\ x -> case x of)- (%~) SNat SString = Disproved (\ x -> case x of)- (%~) SNat (SMaybe _) = Disproved (\ x -> case x of)- (%~) SNat (SVec _ _) = Disproved (\ x -> case x of)- (%~) SInt SNat = Disproved (\ x -> case x of)- (%~) SInt SInt = Proved Refl- (%~) SInt SString = Disproved (\ x -> case x of)- (%~) SInt (SMaybe _) = Disproved (\ x -> case x of)- (%~) SInt (SVec _ _) = Disproved (\ x -> case x of)- (%~) SString SNat = Disproved (\ x -> case x of)- (%~) SString SInt = Disproved (\ x -> case x of)- (%~) SString SString = Proved Refl- (%~) SString (SMaybe _) = Disproved (\ x -> case x of)- (%~) SString (SVec _ _) = Disproved (\ x -> case x of)- (%~) (SMaybe _) SNat = Disproved (\ x -> case x of)- (%~) (SMaybe _) SInt = Disproved (\ x -> case x of)- (%~) (SMaybe _) SString = Disproved (\ x -> case x of)- (%~) (SMaybe a) (SMaybe b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (%~) (SMaybe _) (SVec _ _) = Disproved (\ x -> case x of)- (%~) (SVec _ _) SNat = Disproved (\ x -> case x of)- (%~) (SVec _ _) SInt = Disproved (\ x -> case x of)- (%~) (SVec _ _) SString = Disproved (\ x -> case x of)- (%~) (SVec _ _) (SMaybe _) = Disproved (\ x -> case x of)- (%~) (SVec a a) (SVec b b)- = case ((,) (((%~) a) b)) (((%~) a) b) of- (,) (Proved Refl) (Proved Refl) -> Proved Refl- (,) (Disproved contra) _- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- (,) _ (Disproved contra)- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance (SOrd Type, SOrd Nat) => SOrd Type where- sCompare ::- forall (t1 :: Type) (t2 :: Type).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Type ((~>) Type Ordering)- -> Type) t1) t2)- sCompare SNat SNat- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare SInt SInt- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare SString SString- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- SNil- sCompare- (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil)- sCompare- (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210)- (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- SNil))- sCompare SNat SInt = SLT- sCompare SNat SString = SLT- sCompare SNat (SMaybe _) = SLT- sCompare SNat (SVec _ _) = SLT- sCompare SInt SNat = SGT- sCompare SInt SString = SLT- sCompare SInt (SMaybe _) = SLT- sCompare SInt (SVec _ _) = SLT- sCompare SString SNat = SGT- sCompare SString SInt = SGT- sCompare SString (SMaybe _) = SLT- sCompare SString (SVec _ _) = SLT- sCompare (SMaybe _) SNat = SGT- sCompare (SMaybe _) SInt = SGT- sCompare (SMaybe _) SString = SGT- sCompare (SMaybe _) (SVec _ _) = SLT- sCompare (SVec _ _) SNat = SGT- sCompare (SVec _ _) SInt = SGT- sCompare (SVec _ _) SString = SGT- sCompare (SVec _ _) (SMaybe _) = SGT- instance (SShow Type, SShow Nat) => SShow Type where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Type) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol))- -> Type) t1) t2) t3)- sShowsPrec- _- SNat- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Nat")))- sA_0123456789876543210- sShowsPrec- _- SInt- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Int")))- sA_0123456789876543210- sShowsPrec- _- SString- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "String")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SMaybe (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Maybe "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SVec (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Vec "))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @ShowSpaceSym0) sShowSpace)))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))))- sA_0123456789876543210- instance SingI Nat where- sing = SNat- instance SingI Int where- sing = SInt- instance SingI String where- sing = SString- instance SingI n => SingI (Maybe (n :: Type)) where- sing = SMaybe sing- instance SingI (MaybeSym0 :: (~>) Type Type) where- sing = (singFun1 @MaybeSym0) SMaybe- instance SingI (TyCon1 Maybe :: (~>) Type Type) where- sing = (singFun1 @(TyCon1 Maybe)) SMaybe- instance (SingI n, SingI n) =>- SingI (Vec (n :: Type) (n :: Nat)) where- sing = (SVec sing) sing- instance SingI (VecSym0 :: (~>) Type ((~>) Nat Type)) where- sing = (singFun2 @VecSym0) SVec- instance SingI (TyCon2 Vec :: (~>) Type ((~>) Nat Type)) where- sing = (singFun2 @(TyCon2 Vec)) SVec- instance SingI d =>- SingI (VecSym1 (d :: Type) :: (~>) Nat Type) where- sing = (singFun1 @(VecSym1 (d :: Type))) (SVec (sing @d))- instance SingI d =>- SingI (TyCon1 (Vec (d :: Type)) :: (~>) Nat Type) where- sing = (singFun1 @(TyCon1 (Vec (d :: Type)))) (SVec (sing @d))
− tests/compile-and-dump/Singletons/Star.hs
@@ -1,13 +0,0 @@-module Singletons.Star where--import Data.Singletons.Prelude-import Data.Singletons.Decide-import Data.Singletons.CustomStar-import Singletons.Nat-import Data.Kind (Type)--data Vec :: Type -> Nat -> Type where- VNil :: Vec a Zero- VCons :: a -> Vec a n -> Vec a (Succ n)--$(singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec])
− tests/compile-and-dump/Singletons/T124.ghc86.template
@@ -1,33 +0,0 @@-Singletons/T124.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: Bool -> ()- foo True = ()- foo False = () |]- ======>- foo :: Bool -> ()- foo True = ()- foo False = ()- type FooSym1 (a0123456789876543210 :: Bool) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) Bool ()- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Foo (a :: Bool) :: () where- Foo 'True = Tuple0Sym0- Foo 'False = Tuple0Sym0- sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ())- sFoo STrue = STuple0- sFoo SFalse = STuple0- instance SingI (FooSym0 :: (~>) Bool ()) where- sing = (singFun1 @FooSym0) sFoo-Singletons/T124.hs:0:0:: Splicing expression- sCases ''Bool [| b |] [| STuple0 |]- ======>- case b of- SFalse -> STuple0- STrue -> STuple0
− tests/compile-and-dump/Singletons/T124.hs
@@ -1,13 +0,0 @@-module Singletons.T124 where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|- foo :: Bool -> ()- foo True = ()- foo False = ()- |])--bar :: SBool b -> STuple0 (Foo b)-bar b = $(sCases ''Bool [| b |] [| STuple0 |])
− tests/compile-and-dump/Singletons/T136.ghc86.template
@@ -1,171 +0,0 @@-Singletons/T136.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| instance Enum BiNat where- succ [] = [True]- succ (False : as) = True : as- succ (True : as) = False : succ as- pred [] = error "pred 0"- pred (False : as) = True : pred as- pred (True : as) = False : as- toEnum i- | i < 0 = error "negative toEnum"- | i == 0 = []- | otherwise = succ (toEnum (pred i))- fromEnum [] = 0- fromEnum (False : as) = 2 * fromEnum as- fromEnum (True : as) = 1 + 2 * fromEnum as |]- ======>- instance Enum BiNat where- succ [] = [True]- succ (False : as) = (True : as)- succ (True : as) = (False : succ as)- pred [] = error "pred 0"- pred (False : as) = (True : pred as)- pred (True : as) = (False : as)- toEnum i- | (i < 0) = error "negative toEnum"- | (i == 0) = []- | otherwise = succ (toEnum (pred i))- fromEnum [] = 0- fromEnum (False : as) = (2 * fromEnum as)- fromEnum (True : as) = (1 + (2 * fromEnum as))- type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where- Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) '[]- Succ_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as- Succ_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as)- type Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) =- Succ_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Succ_0123456789876543210Sym0KindInference) ())- data Succ_0123456789876543210Sym0 :: (~>) [Bool] [Bool]- where- Succ_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) =>- Succ_0123456789876543210Sym0 a0123456789876543210- type instance Apply Succ_0123456789876543210Sym0 a0123456789876543210 = Succ_0123456789876543210 a0123456789876543210- type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where- Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0"- Pred_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) (Apply PredSym0 as)- Pred_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) as- type Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) =- Pred_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Pred_0123456789876543210Sym0KindInference) ())- data Pred_0123456789876543210Sym0 :: (~>) [Bool] [Bool]- where- Pred_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) =>- Pred_0123456789876543210Sym0 a0123456789876543210- type instance Apply Pred_0123456789876543210Sym0 a0123456789876543210 = Pred_0123456789876543210 a0123456789876543210- type family Case_0123456789876543210 i arg_0123456789876543210 t where- Case_0123456789876543210 i arg_0123456789876543210 'True = '[]- Case_0123456789876543210 i arg_0123456789876543210 'False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i))- type family Case_0123456789876543210 i arg_0123456789876543210 t where- Case_0123456789876543210 i arg_0123456789876543210 'True = Apply ErrorSym0 "negative toEnum"- Case_0123456789876543210 i arg_0123456789876543210 'False = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0))- type family Case_0123456789876543210 arg_0123456789876543210 t where- Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0))- type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where- ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210- type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) =- ToEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ())- data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat [Bool]- where- ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>- ToEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210- type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where- FromEnum_0123456789876543210 '[] = FromInteger 0- FromEnum_0123456789876543210 ( '(:) 'False as) = Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as)- FromEnum_0123456789876543210 ( '(:) 'True as) = Apply (Apply (+@#@$) (FromInteger 1)) (Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as))- type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) =- FromEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ())- data FromEnum_0123456789876543210Sym0 :: (~>) [Bool] GHC.Types.Nat- where- FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>- FromEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210- instance PEnum [Bool] where- type Succ a = Apply Succ_0123456789876543210Sym0 a- type Pred a = Apply Pred_0123456789876543210Sym0 a- type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a- type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a- instance SEnum [Bool] where- sSucc ::- forall (t :: [Bool]).- Sing t- -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool]- -> GHC.Types.Type) t)- sPred ::- forall (t :: [Bool]).- Sing t- -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool]- -> GHC.Types.Type) t)- sToEnum ::- forall (t :: GHC.Types.Nat).- Sing t- -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool]- -> GHC.Types.Type) t)- sFromEnum ::- forall (t :: [Bool]).- Sing t- -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat- -> GHC.Types.Type) t)- sSucc SNil- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) SNil- sSucc (SCons SFalse (sAs :: Sing as))- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) sAs- sSucc (SCons STrue (sAs :: Sing as))- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse))- ((applySing ((singFun1 @SuccSym0) sSucc)) sAs)- sPred SNil = sError (sing :: Sing "pred 0")- sPred (SCons SFalse (sAs :: Sing as))- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue))- ((applySing ((singFun1 @PredSym0) sPred)) sAs)- sPred (SCons STrue (sAs :: Sing as))- = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) sAs- sToEnum (sArg_0123456789876543210 :: Sing arg_0123456789876543210)- = (case sArg_0123456789876543210 of {- (sI :: Sing i)- -> (case- (applySing ((applySing ((singFun2 @(<@#@$)) (%<))) sI))- (sFromInteger (sing :: Sing 0))- of- STrue -> sError (sing :: Sing "negative toEnum")- SFalse- -> (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sI))- (sFromInteger (sing :: Sing 0))- of- STrue -> SNil- SFalse- -> (applySing ((singFun1 @SuccSym0) sSucc))- ((applySing ((singFun1 @ToEnumSym0) sToEnum))- ((applySing ((singFun1 @PredSym0) sPred)) sI))) ::- Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)))) ::- Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0))) }) ::- Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210)- sFromEnum SNil = sFromInteger (sing :: Sing 0)- sFromEnum (SCons SFalse (sAs :: Sing as))- = (applySing- ((applySing ((singFun2 @(*@#@$)) (%*)))- (sFromInteger (sing :: Sing 2))))- ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs)- sFromEnum (SCons STrue (sAs :: Sing as))- = (applySing- ((applySing ((singFun2 @(+@#@$)) (%+)))- (sFromInteger (sing :: Sing 1))))- ((applySing- ((applySing ((singFun2 @(*@#@$)) (%*)))- (sFromInteger (sing :: Sing 2))))- ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs))
− tests/compile-and-dump/Singletons/T136.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE GADTs, DataKinds, PolyKinds, TypeFamilies, KindSignatures #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-{-# LANGUAGE InstanceSigs, DefaultSignatures #-}--module Binary where--import Data.Singletons.TH-import Data.Singletons.Prelude-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Num--type Bit = Bool-type BiNat = [Bit]--$(singletons [d|- instance Enum BiNat where- succ [] = [True]- succ (False:as) = True : as- succ (True:as) = False : succ as-- pred [] = error "pred 0"- pred (False:as) = True : pred as- pred (True:as) = False : as-- toEnum i | i < 0 = error "negative toEnum"- | i == 0 = []- | otherwise = succ (toEnum (pred i))-- fromEnum [] = 0- fromEnum (False:as) = 2 * fromEnum as- fromEnum (True:as) = 1 + 2 * fromEnum as- |])
− tests/compile-and-dump/Singletons/T136b.ghc86.template
@@ -1,53 +0,0 @@-Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class C a where- meth :: a -> a |]- ======>- class C a where- meth :: a -> a- type MethSym1 (arg0123456789876543210 :: a0123456789876543210) =- Meth arg0123456789876543210- instance SuppressUnusedWarnings MethSym0 where- suppressUnusedWarnings = snd (((,) MethSym0KindInference) ())- data MethSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- MethSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) =>- MethSym0 arg0123456789876543210- type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210- class PC (a :: GHC.Types.Type) where- type Meth (arg :: a) :: a- class SC a where- sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a)- instance SC a => SingI (MethSym0 :: (~>) a a) where- sing = (singFun1 @MethSym0) sMeth-Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| instance C Bool where- meth = not |]- ======>- instance C Bool where- meth = not- type family Meth_0123456789876543210 (a :: Bool) :: Bool where- Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210- type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) =- Meth_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Meth_0123456789876543210Sym0KindInference) ())- data Meth_0123456789876543210Sym0 :: (~>) Bool Bool- where- Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) =>- Meth_0123456789876543210Sym0 a0123456789876543210- type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210- instance PC Bool where- type Meth a = Apply Meth_0123456789876543210Sym0 a- instance SC Bool where- sMeth ::- forall (t :: Bool).- Sing t- -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> GHC.Types.Type) t)- sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210
− tests/compile-and-dump/Singletons/T136b.hs
@@ -1,14 +0,0 @@-module T136b where--import Data.Singletons.TH-import Data.Singletons.Prelude.Bool--$(singletons [d|- class C a where- meth :: a -> a- |])--$(singletons [d|- instance C Bool where- meth = not- |])
− tests/compile-and-dump/Singletons/T145.ghc86.template
@@ -1,39 +0,0 @@-Singletons/T145.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class Column (f :: Type -> Type) where- col :: f a -> a -> Bool |]- ======>- class Column (f :: Type -> Type) where- col :: f a -> a -> Bool- type ColSym2 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) =- Col arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (ColSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) ColSym1KindInference) ())- data ColSym1 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) :: (~>) a0123456789876543210 Bool- where- ColSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (ColSym1 arg0123456789876543210) arg) (ColSym2 arg0123456789876543210 arg) =>- ColSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = Col arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings ColSym0 where- suppressUnusedWarnings = snd (((,) ColSym0KindInference) ())- data ColSym0 :: forall a0123456789876543210 f0123456789876543210.- (~>) (f0123456789876543210 a0123456789876543210) ((~>) a0123456789876543210 Bool)- where- ColSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) =>- ColSym0 arg0123456789876543210- type instance Apply ColSym0 arg0123456789876543210 = ColSym1 arg0123456789876543210- class PColumn (f :: Type -> Type) where- type Col (arg :: f a) (arg :: a) :: Bool- class SColumn (f :: Type -> Type) where- sCol ::- forall a (t :: f a) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool)- instance SColumn f =>- SingI (ColSym0 :: (~>) (f a) ((~>) a Bool)) where- sing = (singFun2 @ColSym0) sCol- instance (SColumn f, SingI d) =>- SingI (ColSym1 (d :: f a) :: (~>) a Bool) where- sing = (singFun1 @(ColSym1 (d :: f a))) (sCol (sing @d))
− tests/compile-and-dump/Singletons/T145.hs
@@ -1,9 +0,0 @@-module Singletons.T145 where--import Data.Singletons.TH-import Data.Kind (Type)--$(singletons [d|- class Column (f :: Type -> Type) where- col :: f a -> a -> Bool- |])
− tests/compile-and-dump/Singletons/T153.ghc86.template
− tests/compile-and-dump/Singletons/T153.hs
@@ -1,13 +0,0 @@-{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables,- TypeApplications, RankNTypes #-}--module Singletons.T153 where--import Data.Singletons-import Data.Singletons.Prelude--foo :: Int-foo = withSomeSing @(Maybe Bool) (Just True) $ \case- SJust STrue -> 0- SJust SFalse -> 1- SNothing -> 2
− tests/compile-and-dump/Singletons/T157.ghc86.template
− tests/compile-and-dump/Singletons/T157.hs
@@ -1,6 +0,0 @@-module T157 where--import Data.Singletons.Prelude--foo :: SList '["a", "b", "c"]-foo = sing `SCons` sing `SCons` sing
− tests/compile-and-dump/Singletons/T159.ghc86.template
@@ -1,245 +0,0 @@-Singletons/T159.hs:0:0:: Splicing declarations- genSingletons [''T0, ''T1]- ======>- type ASym0 = 'A- type BSym0 = 'B- type CSym0 = 'C- type DSym0 = 'D- type ESym0 = 'E- type FSym0 = 'F- data instance Sing :: T0 -> GHC.Types.Type- where- SA :: Sing 'A- SB :: Sing 'B- SC :: Sing 'C- SD :: Sing 'D- SE :: Sing 'E- SF :: Sing 'F- type ST0 = (Sing :: T0 -> GHC.Types.Type)- instance SingKind T0 where- type Demote T0 = T0- fromSing SA = A- fromSing SB = B- fromSing SC = C- fromSing SD = D- fromSing SE = E- fromSing SF = F- toSing A = SomeSing SA- toSing B = SomeSing SB- toSing C = SomeSing SC- toSing D = SomeSing SD- toSing E = SomeSing SE- toSing F = SomeSing SF- instance SingI 'A where- sing = SA- instance SingI 'B where- sing = SB- instance SingI 'C where- sing = SC- instance SingI 'D where- sing = SD- instance SingI 'E where- sing = SE- instance SingI 'F where- sing = SF- type N1Sym0 = 'N1- type C1Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) =- 'C1 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (C1Sym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) C1Sym1KindInference) ())- data C1Sym1 (t0123456789876543210 :: T0) :: (~>) T1 T1- where- C1Sym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (C1Sym1 t0123456789876543210) arg) (C1Sym2 t0123456789876543210 arg) =>- C1Sym1 t0123456789876543210 t0123456789876543210- type instance Apply (C1Sym1 t0123456789876543210) t0123456789876543210 = 'C1 t0123456789876543210 t0123456789876543210- infixr 5 `C1Sym1`- instance SuppressUnusedWarnings C1Sym0 where- suppressUnusedWarnings = snd (((,) C1Sym0KindInference) ())- data C1Sym0 :: (~>) T0 ((~>) T1 T1)- where- C1Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) =>- C1Sym0 t0123456789876543210- type instance Apply C1Sym0 t0123456789876543210 = C1Sym1 t0123456789876543210- infixr 5 `C1Sym0`- type (:&&@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) =- '(:&&) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:&&@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::&&@#@$$###)) ())- data (:&&@#@$$) (t0123456789876543210 :: T0) :: (~>) T1 T1- where- (::&&@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:&&@#@$$) t0123456789876543210) arg) ((:&&@#@$$$) t0123456789876543210 arg) =>- (:&&@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:&&@#@$$) t0123456789876543210) t0123456789876543210 = '(:&&) t0123456789876543210 t0123456789876543210- infixr 5 :&&@#@$$- instance SuppressUnusedWarnings (:&&@#@$) where- suppressUnusedWarnings = snd (((,) (::&&@#@$###)) ())- data (:&&@#@$) :: (~>) T0 ((~>) T1 T1)- where- (::&&@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) =>- (:&&@#@$) t0123456789876543210- type instance Apply (:&&@#@$) t0123456789876543210 = (:&&@#@$$) t0123456789876543210- infixr 5 :&&@#@$- data instance Sing :: T1 -> GHC.Types.Type- where- SN1 :: Sing 'N1- SC1 :: forall (n :: T0) (n :: T1).- (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( 'C1 n n)- (:%&&) :: forall (n :: T0) (n :: T1).- (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( '(:&&) n n)- type ST1 = (Sing :: T1 -> GHC.Types.Type)- instance SingKind T1 where- type Demote T1 = T1- fromSing SN1 = N1- fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b)- fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b)- toSing N1 = SomeSing SN1- toSing (C1 (b :: Demote T0) (b :: Demote T1))- = case- ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) }- toSing ((:&&) (b :: Demote T0) (b :: Demote T1))- = case- ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&&) c) c) }- infixr 5 `SC1`- infixr 5 :%&&- instance SingI 'N1 where- sing = SN1- instance (SingI n, SingI n) =>- SingI ( 'C1 (n :: T0) (n :: T1)) where- sing = (SC1 sing) sing- instance SingI (C1Sym0 :: (~>) T0 ((~>) T1 T1)) where- sing = (singFun2 @C1Sym0) SC1- instance SingI (TyCon2 'C1 :: (~>) T0 ((~>) T1 T1)) where- sing = (singFun2 @(TyCon2 'C1)) SC1- instance SingI d => SingI (C1Sym1 (d :: T0) :: (~>) T1 T1) where- sing = (singFun1 @(C1Sym1 (d :: T0))) (SC1 (sing @d))- instance SingI d =>- SingI (TyCon1 ( 'C1 (d :: T0)) :: (~>) T1 T1) where- sing = (singFun1 @(TyCon1 ( 'C1 (d :: T0)))) (SC1 (sing @d))- instance (SingI n, SingI n) =>- SingI ( '(:&&) (n :: T0) (n :: T1)) where- sing = ((:%&&) sing) sing- instance SingI ((:&&@#@$) :: (~>) T0 ((~>) T1 T1)) where- sing = (singFun2 @(:&&@#@$)) (:%&&)- instance SingI (TyCon2 '(:&&) :: (~>) T0 ((~>) T1 T1)) where- sing = (singFun2 @(TyCon2 '(:&&))) (:%&&)- instance SingI d =>- SingI ((:&&@#@$$) (d :: T0) :: (~>) T1 T1) where- sing = (singFun1 @((:&&@#@$$) (d :: T0))) ((:%&&) (sing @d))- instance SingI d =>- SingI (TyCon1 ( '(:&&) (d :: T0)) :: (~>) T1 T1) where- sing = (singFun1 @(TyCon1 ( '(:&&) (d :: T0)))) ((:%&&) (sing @d))-Singletons/T159.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixr 5 :||- infixr 5 `C2`- - data T2 = N2 | C2 T0 T2 | T0 :|| T2 |]- ======>- data T2 = N2 | C2 T0 T2 | T0 :|| T2- infixr 5 `C2`- infixr 5 :||- type N2Sym0 = N2- type C2Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) =- C2 t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (C2Sym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) C2Sym1KindInference) ())- data C2Sym1 (t0123456789876543210 :: T0) :: (~>) T2 T2- where- C2Sym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (C2Sym1 t0123456789876543210) arg) (C2Sym2 t0123456789876543210 arg) =>- C2Sym1 t0123456789876543210 t0123456789876543210- type instance Apply (C2Sym1 t0123456789876543210) t0123456789876543210 = C2 t0123456789876543210 t0123456789876543210- infixr 5 `C2Sym1`- instance SuppressUnusedWarnings C2Sym0 where- suppressUnusedWarnings = snd (((,) C2Sym0KindInference) ())- data C2Sym0 :: (~>) T0 ((~>) T2 T2)- where- C2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) =>- C2Sym0 t0123456789876543210- type instance Apply C2Sym0 t0123456789876543210 = C2Sym1 t0123456789876543210- infixr 5 `C2Sym0`- type (:||@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) =- (:||) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:||@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::||@#@$$###)) ())- data (:||@#@$$) (t0123456789876543210 :: T0) :: (~>) T2 T2- where- (::||@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:||@#@$$) t0123456789876543210) arg) ((:||@#@$$$) t0123456789876543210 arg) =>- (:||@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:||@#@$$) t0123456789876543210) t0123456789876543210 = (:||) t0123456789876543210 t0123456789876543210- infixr 5 :||@#@$$- instance SuppressUnusedWarnings (:||@#@$) where- suppressUnusedWarnings = snd (((,) (::||@#@$###)) ())- data (:||@#@$) :: (~>) T0 ((~>) T2 T2)- where- (::||@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) =>- (:||@#@$) t0123456789876543210- type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210- infixr 5 :||@#@$- infixr 5 `SC2`- infixr 5 :%||- data instance Sing :: T2 -> GHC.Types.Type- where- SN2 :: Sing N2- SC2 :: forall (n :: T0) (n :: T2).- (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing (C2 n n)- (:%||) :: forall (n :: T0) (n :: T2).- (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing ((:||) n n)- type ST2 = (Sing :: T2 -> GHC.Types.Type)- instance SingKind T2 where- type Demote T2 = T2- fromSing SN2 = N2- fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b)- fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b)- toSing N2 = SomeSing SN2- toSing (C2 (b :: Demote T0) (b :: Demote T2))- = case- ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) }- toSing ((:||) (b :: Demote T0) (b :: Demote T2))- = case- ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%||) c) c) }- instance SingI N2 where- sing = SN2- instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where- sing = (SC2 sing) sing- instance SingI (C2Sym0 :: (~>) T0 ((~>) T2 T2)) where- sing = (singFun2 @C2Sym0) SC2- instance SingI (TyCon2 C2 :: (~>) T0 ((~>) T2 T2)) where- sing = (singFun2 @(TyCon2 C2)) SC2- instance SingI d => SingI (C2Sym1 (d :: T0) :: (~>) T2 T2) where- sing = (singFun1 @(C2Sym1 (d :: T0))) (SC2 (sing @d))- instance SingI d =>- SingI (TyCon1 (C2 (d :: T0)) :: (~>) T2 T2) where- sing = (singFun1 @(TyCon1 (C2 (d :: T0)))) (SC2 (sing @d))- instance (SingI n, SingI n) =>- SingI ((:||) (n :: T0) (n :: T2)) where- sing = ((:%||) sing) sing- instance SingI ((:||@#@$) :: (~>) T0 ((~>) T2 T2)) where- sing = (singFun2 @(:||@#@$)) (:%||)- instance SingI (TyCon2 (:||) :: (~>) T0 ((~>) T2 T2)) where- sing = (singFun2 @(TyCon2 (:||))) (:%||)- instance SingI d =>- SingI ((:||@#@$$) (d :: T0) :: (~>) T2 T2) where- sing = (singFun1 @((:||@#@$$) (d :: T0))) ((:%||) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:||) (d :: T0)) :: (~>) T2 T2) where- sing = (singFun1 @(TyCon1 ((:||) (d :: T0)))) ((:%||) (sing @d))
− tests/compile-and-dump/Singletons/T159.hs
@@ -1,27 +0,0 @@-module T159 where--import Data.Singletons.TH--data T0 = A | B | C | D | E | F- deriving (Show)--data T1 = N1 | C1 T0 T1 | T0 :&& T1- deriving (Show)--infixr 5 `C1`-infixr 5 :&&--genSingletons [''T0, ''T1]--singletons [d|- data T2 = N2 | C2 T0 T2 | T0 :|| T2-- infixr 5 `C2`- infixr 5 :||- |]--t1 :: T1-t1 = fromSing $ SA `SC1` SB `SC1` SD :%&& SE :%&& SF `SC1` SN1--t2 :: T2-t2 = fromSing $ SA `SC2` SB `SC2` SD :%|| SE :%|| SF `SC2` SN2
− tests/compile-and-dump/Singletons/T160.ghc86.template
@@ -1,85 +0,0 @@-Singletons/T160.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: (Num a, Eq a) => a -> a- foo x = if x == 0 then 1 else typeError $ ShowType x |]- ======>- foo :: (Num a, Eq a) => a -> a- foo x = if (x == 0) then 1 else (typeError $ ShowType x)- type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 x where- Let0123456789876543210Scrutinee_0123456789876543210 x = Apply (Apply (==@#@$) x) (FromInteger 0)- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x 'True = FromInteger 1- Case_0123456789876543210 x 'False = Apply (Apply ($@#@$) TypeErrorSym0) (Apply ShowTypeSym0 x)- type FooSym1 (a0123456789876543210 :: a0123456789876543210) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Foo (a :: a) :: a where- Foo x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- sFoo ::- forall a (t :: a).- (SNum a, SEq a) => Sing t -> Sing (Apply FooSym0 t :: a)- sFoo (sX :: Sing x)- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- sScrutinee_0123456789876543210- = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sX))- (sFromInteger (sing :: Sing 0))- in (case sScrutinee_0123456789876543210 of- STrue -> sFromInteger (sing :: Sing 1)- SFalse- -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError))- ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a)- instance (SNum a, SEq a) => SingI (FooSym0 :: (~>) a a) where- sing = (singFun1 @FooSym0) sFoo--Singletons/T160.hs:0:0: error:- • t- • In the expression:- (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError))- ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)- In a case alternative:- SFalse- -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError))- ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)- In the expression:- (case sScrutinee_0123456789876543210 of- STrue -> sFromInteger (sing :: Sing 1)- SFalse- -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError))- ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a)- |-7 | $(singletons- | ^^^^^^^^^^...--Singletons/T160.hs:0:0: error:- • 1- • In the expression: Refl- In an equation for ‘f’: f = Refl- |-13 | f = Refl- | ^^^^
− tests/compile-and-dump/Singletons/T160.hs
@@ -1,13 +0,0 @@-module T160 where--import Data.Singletons.Prelude-import Data.Singletons.TH-import Data.Singletons.TypeError--$(singletons- [d| foo :: (Num a, Eq a) => a -> a- foo x = if x == 0 then 1 else typeError $ ShowType x- |])--f :: Foo 1 :~: 42-f = Refl
− tests/compile-and-dump/Singletons/T163.ghc86.template
@@ -1,51 +0,0 @@-Singletons/T163.hs:0:0:: Splicing declarations- singletons [d| data a + b = L a | R b |]- ======>- data (+) a b = L a | R b- type LSym1 (t0123456789876543210 :: a0123456789876543210) =- L t0123456789876543210- instance SuppressUnusedWarnings LSym0 where- suppressUnusedWarnings = snd (((,) LSym0KindInference) ())- data LSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)- where- LSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply LSym0 arg) (LSym1 arg) =>- LSym0 t0123456789876543210- type instance Apply LSym0 t0123456789876543210 = L t0123456789876543210- type RSym1 (t0123456789876543210 :: b0123456789876543210) =- R t0123456789876543210- instance SuppressUnusedWarnings RSym0 where- suppressUnusedWarnings = snd (((,) RSym0KindInference) ())- data RSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210)- where- RSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply RSym0 arg) (RSym1 arg) =>- RSym0 t0123456789876543210- type instance Apply RSym0 t0123456789876543210 = R t0123456789876543210- data instance Sing :: (+) a b -> GHC.Types.Type- where- SL :: forall a (n :: a). (Sing (n :: a)) -> Sing (L n)- SR :: forall b (n :: b). (Sing (n :: b)) -> Sing (R n)- type (%+) = (Sing :: (+) a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind ((+) a b) where- type Demote ((+) a b) = (+) (Demote a) (Demote b)- fromSing (SL b) = L (fromSing b)- fromSing (SR b) = R (fromSing b)- toSing (L (b :: Demote a))- = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SL c) }- toSing (R (b :: Demote b))- = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SR c) }- instance SingI n => SingI (L (n :: a)) where- sing = SL sing- instance SingI (LSym0 :: (~>) a ((+) a b)) where- sing = (singFun1 @LSym0) SL- instance SingI (TyCon1 L :: (~>) a ((+) a b)) where- sing = (singFun1 @(TyCon1 L)) SL- instance SingI n => SingI (R (n :: b)) where- sing = SR sing- instance SingI (RSym0 :: (~>) b ((+) a b)) where- sing = (singFun1 @RSym0) SR- instance SingI (TyCon1 R :: (~>) b ((+) a b)) where- sing = (singFun1 @(TyCon1 R)) SR
− tests/compile-and-dump/Singletons/T163.hs
@@ -1,5 +0,0 @@-module T163 where--import Data.Singletons.TH--$(singletons [d| data a + b = L a | R b |])
− tests/compile-and-dump/Singletons/T166.ghc86.template
@@ -1,139 +0,0 @@-Singletons/T166.hs:(0,0)-(0,0): Splicing declarations- singletonsOnly- [d| class Foo a where- foosPrec :: Nat -> a -> [Bool] -> [Bool]- foo :: a -> [Bool]- foo x s = foosPrec 0 x s |]- ======>- type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) =- FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ())- data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool]- where- FoosPrecSym2KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) =>- FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ())- data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) [Bool] [Bool])- where- FoosPrecSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) =>- FoosPrecSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings FoosPrecSym0 where- suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ())- data FoosPrecSym0 :: forall a0123456789876543210.- (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool]))- where- FoosPrecSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) =>- FoosPrecSym0 arg0123456789876543210- type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210- type FooSym1 (arg0123456789876543210 :: a0123456789876543210) =- Foo arg0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 [Bool]- where- FooSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 arg0123456789876543210- type instance Apply FooSym0 arg0123456789876543210 = Foo arg0123456789876543210- type family Lambda_0123456789876543210 x t where- Lambda_0123456789876543210 x s = Apply (Apply (Apply FoosPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 0)) x) s- type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type family Foo_0123456789876543210 (a :: a) :: [Bool] where- Foo_0123456789876543210 x = Apply Lambda_0123456789876543210Sym0 x- type Foo_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Foo_0123456789876543210Sym0KindInference) ())- data Foo_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 [Bool]- where- Foo_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo_0123456789876543210Sym0 arg) (Foo_0123456789876543210Sym1 arg) =>- Foo_0123456789876543210Sym0 a0123456789876543210- type instance Apply Foo_0123456789876543210Sym0 a0123456789876543210 = Foo_0123456789876543210 a0123456789876543210- class PFoo (a :: GHC.Types.Type) where- type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool]- type Foo (arg :: a) :: [Bool]- type Foo a = Apply Foo_0123456789876543210Sym0 a- class SFoo a where- sFoosPrec ::- forall (t :: Nat) (t :: a) (t :: [Bool]).- Sing t- -> Sing t- -> Sing t- -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool])- sFoo :: forall (t :: a). Sing t -> Sing (Apply FooSym0 t :: [Bool])- default sFoo ::- forall (t :: a).- (Apply FooSym0 t :: [Bool])- ~ Apply Foo_0123456789876543210Sym0 t =>- Sing t -> Sing (Apply FooSym0 t :: [Bool])- sFoo (sX :: Sing x)- = (singFun1 @(Apply Lambda_0123456789876543210Sym0 x))- (\ sS- -> case sS of {- (_ :: Sing s)- -> (applySing- ((applySing- ((applySing ((singFun3 @FoosPrecSym0) sFoosPrec))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0))))- sX))- sS })- instance SFoo a =>- SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where- sing = (singFun3 @FoosPrecSym0) sFoosPrec- instance (SFoo a, SingI d) =>- SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where- sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d))- instance (SFoo a, SingI d, SingI d) =>- SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where- sing- = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a)))- ((sFoosPrec (sing @d)) (sing @d))- instance SFoo a => SingI (FooSym0 :: (~>) a [Bool]) where- sing = (singFun1 @FooSym0) sFoo--Singletons/T166.hs:0:0: error:- • Expecting one more argument to ‘Apply Lambda_0123456789876543210Sym0 x’- Expected kind ‘[Bool]’,- but ‘Apply Lambda_0123456789876543210Sym0 x’ has kind ‘TyFun- [Bool] [Bool]- -> Type’- • In the type ‘Apply Lambda_0123456789876543210Sym0 x’- In the type family declaration for ‘Foo_0123456789876543210’- |-14 | $(singletonsOnly [d|- | ^^^^^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/T166.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-module SingletonsBug where--import Data.Singletons.TH-import GHC.TypeLits--$(singletonsOnly [d|- class Foo a where- foosPrec :: Nat -> a -> [Bool] -> [Bool]- foo :: a -> [Bool]-- foo x s = foosPrec 0 x s- |])
− tests/compile-and-dump/Singletons/T167.ghc86.template
@@ -1,178 +0,0 @@-Singletons/T167.hs:(0,0)-(0,0): Splicing declarations- singletonsOnly- [d| class Foo a where- foosPrec :: Nat -> a -> DiffList- fooList :: a -> DiffList- fooList = undefined- - instance Foo a => Foo [a] where- foosPrec _ = fooList |]- ======>- type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) =- FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ())- data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool]- where- FoosPrecSym2KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) =>- FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ())- data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) [Bool] [Bool])- where- FoosPrecSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) =>- FoosPrecSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings FoosPrecSym0 where- suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ())- data FoosPrecSym0 :: forall a0123456789876543210.- (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool]))- where- FoosPrecSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) =>- FoosPrecSym0 arg0123456789876543210- type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210- type FooListSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) =- FooList arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (FooListSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) FooListSym1KindInference) ())- data FooListSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool]- where- FooListSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (FooListSym1 arg0123456789876543210) arg) (FooListSym2 arg0123456789876543210 arg) =>- FooListSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (FooListSym1 arg0123456789876543210) arg0123456789876543210 = FooList arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings FooListSym0 where- suppressUnusedWarnings = snd (((,) FooListSym0KindInference) ())- data FooListSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) [Bool] [Bool])- where- FooListSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) =>- FooListSym0 arg0123456789876543210- type instance Apply FooListSym0 arg0123456789876543210 = FooListSym1 arg0123456789876543210- type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where- FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210- type FooList_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [Bool]) =- FooList_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FooList_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) FooList_0123456789876543210Sym1KindInference) ())- data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool]- where- FooList_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FooList_0123456789876543210Sym1 a0123456789876543210) arg) (FooList_0123456789876543210Sym2 a0123456789876543210 arg) =>- FooList_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (FooList_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FooList_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FooList_0123456789876543210Sym0KindInference) ())- data FooList_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) [Bool] [Bool])- where- FooList_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) =>- FooList_0123456789876543210Sym0 a0123456789876543210- type instance Apply FooList_0123456789876543210Sym0 a0123456789876543210 = FooList_0123456789876543210Sym1 a0123456789876543210- class PFoo (a :: GHC.Types.Type) where- type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool]- type FooList (arg :: a) (arg :: [Bool]) :: [Bool]- type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a- type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where- FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210- type FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [Bool]) =- FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) FoosPrec_0123456789876543210Sym2KindInference) ())- data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [Bool] [Bool]- where- FoosPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) FoosPrec_0123456789876543210Sym1KindInference) ())- data FoosPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: forall a0123456789876543210.- (~>) [a0123456789876543210] ((~>) [Bool] [Bool])- where- FoosPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- FoosPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FoosPrec_0123456789876543210Sym0KindInference) ())- data FoosPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) Nat ((~>) [a0123456789876543210] ((~>) [Bool] [Bool]))- where- FoosPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) =>- FoosPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210- instance PFoo [a] where- type FoosPrec a a a = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a- class SFoo a where- sFoosPrec ::- forall (t :: Nat) (t :: a) (t :: [Bool]).- Sing t- -> Sing t- -> Sing t- -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool])- sFooList ::- forall (t :: a) (t :: [Bool]).- Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool])- default sFooList ::- forall (t :: a) (t :: [Bool]).- (Apply (Apply FooListSym0 t) t :: [Bool])- ~ Apply (Apply FooList_0123456789876543210Sym0 t) t =>- Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool])- sFooList- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (sUndefined sA_0123456789876543210) sA_0123456789876543210- instance SFoo a => SFoo [a] where- sFoosPrec ::- forall (t :: Nat) (t :: [a]) (t :: [Bool]).- Sing t- -> Sing t- -> Sing t- -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool])- sFoosPrec- _- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @FooListSym0) sFooList))- sA_0123456789876543210))- sA_0123456789876543210- instance SFoo a =>- SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where- sing = (singFun3 @FoosPrecSym0) sFoosPrec- instance (SFoo a, SingI d) =>- SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where- sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d))- instance (SFoo a, SingI d, SingI d) =>- SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where- sing- = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a)))- ((sFoosPrec (sing @d)) (sing @d))- instance SFoo a =>- SingI (FooListSym0 :: (~>) a ((~>) [Bool] [Bool])) where- sing = (singFun2 @FooListSym0) sFooList- instance (SFoo a, SingI d) =>- SingI (FooListSym1 (d :: a) :: (~>) [Bool] [Bool]) where- sing = (singFun1 @(FooListSym1 (d :: a))) (sFooList (sing @d))
− tests/compile-and-dump/Singletons/T167.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-module Singletons.T167 where--import Data.Singletons.TH-import GHC.TypeLits--type DiffList = [Bool] -> [Bool]--$(singletonsOnly [d|- class Foo a where- foosPrec :: Nat -> a -> DiffList- fooList :: a -> DiffList- fooList = undefined-- instance Foo a => Foo [a] where- foosPrec _ = fooList- |])
− tests/compile-and-dump/Singletons/T172.ghc86.template
@@ -1,40 +0,0 @@-Singletons/T172.hs:(0,0)-(0,0): Splicing declarations- singletonsOnly- [d| ($>) :: Nat -> Nat -> Nat- ($>) = (+) |]- ======>- type ($>@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) =- ($>) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:$>@#@$$###)) ())- data ($>@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat- where- (:$>@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) =>- ($>@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ($>@#@$) where- suppressUnusedWarnings = snd (((,) (:$>@#@$###)) ())- data ($>@#@$) :: (~>) Nat ((~>) Nat Nat)- where- (:$>@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) =>- ($>@#@$) a0123456789876543210- type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210- type family ($>) (a :: Nat) (a :: Nat) :: Nat where- ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210- (%$>) ::- forall (t :: Nat) (t :: Nat).- Sing t -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Nat)- (%$>)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @(+@#@$)) (%+))) sA_0123456789876543210))- sA_0123456789876543210- instance SingI (($>@#@$) :: (~>) Nat ((~>) Nat Nat)) where- sing = (singFun2 @($>@#@$)) (%$>)- instance SingI d =>- SingI (($>@#@$$) (d :: Nat) :: (~>) Nat Nat) where- sing = (singFun1 @(($>@#@$$) (d :: Nat))) ((%$>) (sing @d))
− tests/compile-and-dump/Singletons/T172.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-module T172 where--import Data.Singletons.Prelude-import Data.Singletons.TH-import Data.Singletons.TypeLits--$(singletonsOnly [d|- ($>) :: Nat -> Nat -> Nat- ($>) = (+)- |])
− tests/compile-and-dump/Singletons/T175.ghc86.template
@@ -1,45 +0,0 @@-Singletons/T175.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| quux2 :: Bar2 a => a- quux2 = baz- - class Foo a where- baz :: a- class Foo a => Bar1 a where- quux1 :: a- quux1 = baz- class Foo a => Bar2 a |]- ======>- class Foo a where- baz :: a- class Foo a => Bar1 a where- quux1 :: a- quux1 = baz- class Foo a => Bar2 a- quux2 :: Bar2 a => a- quux2 = baz- type Quux2Sym0 = Quux2- type family Quux2 :: a where- Quux2 = BazSym0- type BazSym0 = Baz- class PFoo (a :: GHC.Types.Type) where- type Baz :: a- type Quux1Sym0 = Quux1- type family Quux1_0123456789876543210 :: a where- Quux1_0123456789876543210 = BazSym0- type Quux1_0123456789876543210Sym0 = Quux1_0123456789876543210- class PFoo a => PBar1 (a :: GHC.Types.Type) where- type Quux1 :: a- type Quux1 = Quux1_0123456789876543210Sym0- class PFoo a => PBar2 (a :: GHC.Types.Type)- sQuux2 :: forall a. SBar2 a => Sing (Quux2Sym0 :: a)- sQuux2 = sBaz- class SFoo a where- sBaz :: Sing (BazSym0 :: a)- class SFoo a => SBar1 a where- sQuux1 :: Sing (Quux1Sym0 :: a)- default sQuux1 ::- (Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0 =>- Sing (Quux1Sym0 :: a)- sQuux1 = sBaz- class SFoo a => SBar2 a
− tests/compile-and-dump/Singletons/T175.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}--module T175 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- class Foo a where- baz :: a-- class Foo a => Bar1 a where- quux1 :: a- quux1 = baz-- class Foo a => Bar2 a where-- quux2 :: Bar2 a => a- quux2 = baz- |])
− tests/compile-and-dump/Singletons/T176.ghc86.template
@@ -1,166 +0,0 @@-Singletons/T176.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| quux1 :: Foo1 a => a -> a- quux1 x = x `bar1` \ _ -> baz1- quux2 :: Foo2 a => a -> a- quux2 x = x `bar2` baz2- - class Foo1 a where- bar1 :: a -> (a -> b) -> b- baz1 :: a- class Foo2 a where- bar2 :: a -> b -> b- baz2 :: a |]- ======>- class Foo1 a where- bar1 :: a -> (a -> b) -> b- baz1 :: a- quux1 :: Foo1 a => a -> a- quux1 x = (x `bar1` (\ _ -> baz1))- class Foo2 a where- bar2 :: a -> b -> b- baz2 :: a- quux2 :: Foo2 a => a -> a- quux2 x = (x `bar2` baz2)- type family Case_0123456789876543210 x arg_0123456789876543210 t where- Case_0123456789876543210 x arg_0123456789876543210 _ = Baz1Sym0- type family Lambda_0123456789876543210 x t where- Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 x0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 x0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210- type Quux2Sym1 (a0123456789876543210 :: a0123456789876543210) =- Quux2 a0123456789876543210- instance SuppressUnusedWarnings Quux2Sym0 where- suppressUnusedWarnings = snd (((,) Quux2Sym0KindInference) ())- data Quux2Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Quux2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) =>- Quux2Sym0 a0123456789876543210- type instance Apply Quux2Sym0 a0123456789876543210 = Quux2 a0123456789876543210- type Quux1Sym1 (a0123456789876543210 :: a0123456789876543210) =- Quux1 a0123456789876543210- instance SuppressUnusedWarnings Quux1Sym0 where- suppressUnusedWarnings = snd (((,) Quux1Sym0KindInference) ())- data Quux1Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Quux1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) =>- Quux1Sym0 a0123456789876543210- type instance Apply Quux1Sym0 a0123456789876543210 = Quux1 a0123456789876543210- type family Quux2 (a :: a) :: a where- Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0- type family Quux1 (a :: a) :: a where- Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x)- type Bar1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) =- Bar1 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (Bar1Sym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) Bar1Sym1KindInference) ())- data Bar1Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210- where- Bar1Sym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (Bar1Sym1 arg0123456789876543210) arg) (Bar1Sym2 arg0123456789876543210 arg) =>- Bar1Sym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (Bar1Sym1 arg0123456789876543210) arg0123456789876543210 = Bar1 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings Bar1Sym0 where- suppressUnusedWarnings = snd (((,) Bar1Sym0KindInference) ())- data Bar1Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210)- where- Bar1Sym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) =>- Bar1Sym0 arg0123456789876543210- type instance Apply Bar1Sym0 arg0123456789876543210 = Bar1Sym1 arg0123456789876543210- type Baz1Sym0 = Baz1- class PFoo1 (a :: Type) where- type Bar1 (arg :: a) (arg :: (~>) a b) :: b- type Baz1 :: a- type Bar2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) =- Bar2 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (Bar2Sym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) Bar2Sym1KindInference) ())- data Bar2Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Bar2Sym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (Bar2Sym1 arg0123456789876543210) arg) (Bar2Sym2 arg0123456789876543210 arg) =>- Bar2Sym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (Bar2Sym1 arg0123456789876543210) arg0123456789876543210 = Bar2 arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings Bar2Sym0 where- suppressUnusedWarnings = snd (((,) Bar2Sym0KindInference) ())- data Bar2Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Bar2Sym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) =>- Bar2Sym0 arg0123456789876543210- type instance Apply Bar2Sym0 arg0123456789876543210 = Bar2Sym1 arg0123456789876543210- type Baz2Sym0 = Baz2- class PFoo2 (a :: Type) where- type Bar2 (arg :: a) (arg :: b) :: b- type Baz2 :: a- sQuux2 ::- forall a (t :: a).- SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a)- sQuux1 ::- forall a (t :: a).- SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a)- sQuux2 (sX :: Sing x)- = (applySing ((applySing ((singFun2 @Bar2Sym0) sBar2)) sX)) sBaz2- sQuux1 (sX :: Sing x)- = (applySing ((applySing ((singFun2 @Bar1Sym0) sBar1)) sX))- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of { _ -> sBaz1 }) ::- Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))- instance SFoo2 a => SingI (Quux2Sym0 :: (~>) a a) where- sing = (singFun1 @Quux2Sym0) sQuux2- instance SFoo1 a => SingI (Quux1Sym0 :: (~>) a a) where- sing = (singFun1 @Quux1Sym0) sQuux1- class SFoo1 a where- sBar1 ::- forall b (t :: a) (t :: (~>) a b).- Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b)- sBaz1 :: Sing (Baz1Sym0 :: a)- class SFoo2 a where- sBar2 ::- forall b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b)- sBaz2 :: Sing (Baz2Sym0 :: a)- instance SFoo1 a =>- SingI (Bar1Sym0 :: (~>) a ((~>) ((~>) a b) b)) where- sing = (singFun2 @Bar1Sym0) sBar1- instance (SFoo1 a, SingI d) =>- SingI (Bar1Sym1 (d :: a) :: (~>) ((~>) a b) b) where- sing = (singFun1 @(Bar1Sym1 (d :: a))) (sBar1 (sing @d))- instance SFoo2 a => SingI (Bar2Sym0 :: (~>) a ((~>) b b)) where- sing = (singFun2 @Bar2Sym0) sBar2- instance (SFoo2 a, SingI d) =>- SingI (Bar2Sym1 (d :: a) :: (~>) b b) where- sing = (singFun1 @(Bar2Sym1 (d :: a))) (sBar2 (sing @d))
− tests/compile-and-dump/Singletons/T176.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-module T176 where--import Data.Kind (Type)-import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- class Foo1 a where- bar1 :: a -> (a -> b) -> b- baz1 :: a-- quux1 :: Foo1 a => a -> a- quux1 x = x `bar1` \_ -> baz1-- class Foo2 a where- bar2 :: a -> b -> b- baz2 :: a-- quux2 :: Foo2 a => a -> a- quux2 x = x `bar2` baz2- |])
− tests/compile-and-dump/Singletons/T178.ghc86.template
@@ -1,210 +0,0 @@-Singletons/T178.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| empty :: U- empty = []- - data Occ- = Str | Opt | Many- deriving (Eq, Ord, Show)- type U = [(Symbol, Occ)] |]- ======>- data Occ- = Str | Opt | Many- deriving (Eq, Ord, Show)- type U = [(Symbol, Occ)]- empty :: U- empty = []- type USym0 = U- type StrSym0 = Str- type OptSym0 = Opt- type ManySym0 = Many- type EmptySym0 = Empty- type family Empty :: [(Symbol, Occ)] where- Empty = '[]- type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where- Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- Compare_0123456789876543210 Str Opt = LTSym0- Compare_0123456789876543210 Str Many = LTSym0- Compare_0123456789876543210 Opt Str = GTSym0- Compare_0123456789876543210 Opt Many = LTSym0- Compare_0123456789876543210 Many Str = GTSym0- Compare_0123456789876543210 Many Opt = GTSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Occ) :: (~>) Occ Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Occ where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where- ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210- ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210- ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Occ ((~>) Symbol Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) Nat ((~>) Occ ((~>) Symbol Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow Occ where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where- Equals_0123456789876543210 Str Str = TrueSym0- Equals_0123456789876543210 Opt Opt = TrueSym0- Equals_0123456789876543210 Many Many = TrueSym0- Equals_0123456789876543210 (_ :: Occ) (_ :: Occ) = FalseSym0- instance PEq Occ where- type (==) a b = Equals_0123456789876543210 a b- sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)])- sEmpty = Data.Singletons.Prelude.Instances.SNil- data instance Sing :: Occ -> GHC.Types.Type- where- SStr :: Sing Str- SOpt :: Sing Opt- SMany :: Sing Many- type SOcc = (Sing :: Occ -> GHC.Types.Type)- instance SingKind Occ where- type Demote Occ = Occ- fromSing SStr = Str- fromSing SOpt = Opt- fromSing SMany = Many- toSing Str = SomeSing SStr- toSing Opt = SomeSing SOpt- toSing Many = SomeSing SMany- instance SOrd Occ where- sCompare ::- forall (t1 :: Occ) (t2 :: Occ).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ ((~>) Occ Ordering)- -> GHC.Types.Type) t1) t2)- sCompare SStr SStr- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- Data.Singletons.Prelude.Instances.SNil- sCompare SOpt SOpt- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- Data.Singletons.Prelude.Instances.SNil- sCompare SMany SMany- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- Data.Singletons.Prelude.Instances.SNil- sCompare SStr SOpt = SLT- sCompare SStr SMany = SLT- sCompare SOpt SStr = SGT- sCompare SOpt SMany = SLT- sCompare SMany SStr = SGT- sCompare SMany SOpt = SGT- instance SShow Occ where- sShowsPrec ::- forall (t1 :: Nat) (t2 :: Occ) (t3 :: Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Nat ((~>) Occ ((~>) Symbol Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- SStr- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Str")))- sA_0123456789876543210- sShowsPrec- _- SOpt- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Opt")))- sA_0123456789876543210- sShowsPrec- _- SMany- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Many")))- sA_0123456789876543210- instance SEq Occ where- (%==) SStr SStr = STrue- (%==) SStr SOpt = SFalse- (%==) SStr SMany = SFalse- (%==) SOpt SStr = SFalse- (%==) SOpt SOpt = STrue- (%==) SOpt SMany = SFalse- (%==) SMany SStr = SFalse- (%==) SMany SOpt = SFalse- (%==) SMany SMany = STrue- instance SDecide Occ where- (%~) SStr SStr = Proved Refl- (%~) SStr SOpt = Disproved (\ x -> case x of)- (%~) SStr SMany = Disproved (\ x -> case x of)- (%~) SOpt SStr = Disproved (\ x -> case x of)- (%~) SOpt SOpt = Proved Refl- (%~) SOpt SMany = Disproved (\ x -> case x of)- (%~) SMany SStr = Disproved (\ x -> case x of)- (%~) SMany SOpt = Disproved (\ x -> case x of)- (%~) SMany SMany = Proved Refl- deriving instance Show (Sing (z :: Occ))- instance SingI Str where- sing = SStr- instance SingI Opt where- sing = SOpt- instance SingI Many where- sing = SMany
− tests/compile-and-dump/Singletons/T178.hs
@@ -1,15 +0,0 @@-module T178 where--import GHC.TypeLits-import Data.Singletons.TH--$(singletons [d|-- -- Note: Ord automatically defines "max"- data Occ = Str | Opt | Many deriving (Eq, Ord, Show)-- type U = [(Symbol,Occ)]-- empty :: U- empty = []- |])
− tests/compile-and-dump/Singletons/T183.ghc86.template
@@ -1,512 +0,0 @@-Singletons/T183.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| f1 (x :: Maybe Bool) = (x :: Maybe Bool)- f2 (x :: Maybe a) = (x :: Maybe a)- f3 (Just a :: Maybe Bool) = "hi"- g x = case Just x of { (Just y :: Maybe Bool) -> (y :: Bool) }- foo1 :: Maybe a -> a- foo1 (Just x :: Maybe a) = (x :: a)- foo2, foo3 :: forall a. Maybe a -> a- foo2 (Just x :: Maybe a) = (x :: a)- foo3 (Just x) = (x :: a)- foo4 :: (a, b) -> (b, a)- foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a)- foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a)- foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a))- = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)- foo6 (Just x :: Maybe (Maybe a))- = case x :: Maybe a of {- (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) }- foo7 :: a -> b -> a- foo7 (x :: a) (_ :: b) = (x :: a)- foo8 :: forall a. Maybe a -> Maybe a- foo8 x@(Just (_ :: a) :: Maybe a) = x- foo9 :: a -> a- foo9 (x :: a)- = let- g :: a -> b -> a- g y _ = y- in g x () |]- ======>- f1 (x :: Maybe Bool) = x :: Maybe Bool- f2 (x :: Maybe a) = x :: Maybe a- f3 (Just a :: Maybe Bool) = "hi"- g x = case Just x of { (Just y :: Maybe Bool) -> y :: Bool }- foo1 :: Maybe a -> a- foo1 (Just x :: Maybe a) = x :: a- foo2 :: forall a. Maybe a -> a- foo3 :: forall a. Maybe a -> a- foo2 (Just x :: Maybe a) = x :: a- foo3 (Just x) = x :: a- foo4 :: (a, b) -> (b, a)- foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a)- foo5 :: Maybe (Maybe a) -> Maybe (Maybe a)- foo6 :: Maybe (Maybe a) -> Maybe (Maybe a)- foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a))- = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)- foo6 (Just x :: Maybe (Maybe a))- = case x :: Maybe a of {- (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) }- foo7 :: a -> b -> a- foo7 (x :: a) (_ :: b) = x :: a- foo8 :: forall a. Maybe a -> Maybe a- foo8 x@(Just (_ :: a) :: Maybe a) = x- foo9 :: a -> a- foo9 (x :: a)- = let- g :: a -> b -> a- g y _ = y- in (g x) ()- type Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) =- Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210GSym2KindInference) ())- data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: forall b0123456789876543210.- (~>) b0123456789876543210 a- where- Let0123456789876543210GSym2KindInference :: forall x0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) =>- Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) a0123456789876543210 = Let0123456789876543210G a0123456789876543210 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210GSym1KindInference) ())- data Let0123456789876543210GSym1 x0123456789876543210 :: forall b0123456789876543210- a.- (~>) a ((~>) b0123456789876543210 a)- where- Let0123456789876543210GSym1KindInference :: forall x0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 arg) =>- Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210GSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210GSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210GSym0KindInference) ())- data Let0123456789876543210GSym0 x0123456789876543210- where- Let0123456789876543210GSym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) =>- Let0123456789876543210GSym0 x0123456789876543210- type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210- type family Let0123456789876543210G x (a :: a) (a :: b) :: a where- Let0123456789876543210G x y _ = y- type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 =- Let0123456789876543210X wild_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210XSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210XSym0KindInference) ())- data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210- where- Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) =>- Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210- type family Let0123456789876543210X wild_0123456789876543210 where- Let0123456789876543210X wild_0123456789876543210 = (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a)- type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 x where- Let0123456789876543210Scrutinee_0123456789876543210 x = (x :: Maybe a)- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x ( 'Just (y :: a) :: Maybe a) = Apply JustSym0 (Apply JustSym0 (y :: a) :: Maybe a)- type family Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 '((x :: a),- (y :: b)) = Apply (Apply Tuple2Sym0 (y :: b)) (x :: a)- type family Lambda_0123456789876543210 a_0123456789876543210 t where- Lambda_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210- type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 x where- Let0123456789876543210Scrutinee_0123456789876543210 x = Apply JustSym0 x- type family Case_0123456789876543210 x t where- Case_0123456789876543210 x ( 'Just y :: Maybe Bool) = (y :: Bool)- type Foo9Sym1 (a0123456789876543210 :: a0123456789876543210) =- Foo9 a0123456789876543210- instance SuppressUnusedWarnings Foo9Sym0 where- suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ())- data Foo9Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- Foo9Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) =>- Foo9Sym0 a0123456789876543210- type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210- type Foo8Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo8 a0123456789876543210- instance SuppressUnusedWarnings Foo8Sym0 where- suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ())- data Foo8Sym0 :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) (Maybe a0123456789876543210)- where- Foo8Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>- Foo8Sym0 a0123456789876543210- type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210- type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Foo7 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ())- data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Foo7Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) =>- Foo7Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Foo7Sym0 where- suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ())- data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)- where- Foo7Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>- Foo7Sym0 a0123456789876543210- type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210- type Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) =- Foo6 a0123456789876543210- instance SuppressUnusedWarnings Foo6Sym0 where- suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ())- data Foo6Sym0 :: forall a0123456789876543210.- (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210))- where- Foo6Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>- Foo6Sym0 a0123456789876543210- type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210- type Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) =- Foo5 a0123456789876543210- instance SuppressUnusedWarnings Foo5Sym0 where- suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ())- data Foo5Sym0 :: forall a0123456789876543210.- (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210))- where- Foo5Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>- Foo5Sym0 a0123456789876543210- type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210- type Foo4Sym1 (a0123456789876543210 :: (a0123456789876543210,- b0123456789876543210)) =- Foo4 a0123456789876543210- instance SuppressUnusedWarnings Foo4Sym0 where- suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ())- data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) (a0123456789876543210,- b0123456789876543210) (b0123456789876543210, a0123456789876543210)- where- Foo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>- Foo4Sym0 a0123456789876543210- type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210- type Foo3Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo3 a0123456789876543210- instance SuppressUnusedWarnings Foo3Sym0 where- suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ())- data Foo3Sym0 :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>- Foo3Sym0 a0123456789876543210- type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210- type Foo2Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo2 a0123456789876543210- instance SuppressUnusedWarnings Foo2Sym0 where- suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ())- data Foo2Sym0 :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>- Foo2Sym0 a0123456789876543210- type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210- type Foo1Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) =- Foo1 a0123456789876543210- instance SuppressUnusedWarnings Foo1Sym0 where- suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ())- data Foo1Sym0 :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) a0123456789876543210- where- Foo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>- Foo1Sym0 a0123456789876543210- type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210- type GSym1 a0123456789876543210 = G a0123456789876543210- instance SuppressUnusedWarnings GSym0 where- suppressUnusedWarnings = snd (((,) GSym0KindInference) ())- data GSym0 a0123456789876543210- where- GSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply GSym0 arg) (GSym1 arg) =>- GSym0 a0123456789876543210- type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210- type F3Sym1 a0123456789876543210 = F3 a0123456789876543210- instance SuppressUnusedWarnings F3Sym0 where- suppressUnusedWarnings = snd (((,) F3Sym0KindInference) ())- data F3Sym0 a0123456789876543210- where- F3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply F3Sym0 arg) (F3Sym1 arg) =>- F3Sym0 a0123456789876543210- type instance Apply F3Sym0 a0123456789876543210 = F3 a0123456789876543210- type F2Sym1 a0123456789876543210 = F2 a0123456789876543210- instance SuppressUnusedWarnings F2Sym0 where- suppressUnusedWarnings = snd (((,) F2Sym0KindInference) ())- data F2Sym0 a0123456789876543210- where- F2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply F2Sym0 arg) (F2Sym1 arg) =>- F2Sym0 a0123456789876543210- type instance Apply F2Sym0 a0123456789876543210 = F2 a0123456789876543210- type F1Sym1 a0123456789876543210 = F1 a0123456789876543210- instance SuppressUnusedWarnings F1Sym0 where- suppressUnusedWarnings = snd (((,) F1Sym0KindInference) ())- data F1Sym0 a0123456789876543210- where- F1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply F1Sym0 arg) (F1Sym1 arg) =>- F1Sym0 a0123456789876543210- type instance Apply F1Sym0 a0123456789876543210 = F1 a0123456789876543210- type family Foo9 (a :: a) :: a where- Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym1 x) x) Tuple0Sym0- type family Foo8 (a :: Maybe a) :: Maybe a where- Foo8 ( 'Just (wild_0123456789876543210 :: a) :: Maybe a) = Let0123456789876543210XSym1 wild_0123456789876543210- type family Foo7 (a :: a) (a :: b) :: a where- Foo7 (x :: a) (wild_0123456789876543210 :: b) = (x :: a)- type family Foo6 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where- Foo6 ( 'Just x :: Maybe (Maybe a)) = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- type family Foo5 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where- Foo5 ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a))- type family Foo4 (a :: (a, b)) :: (b, a) where- Foo4 a_0123456789876543210 = Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210- type family Foo3 (a :: Maybe a) :: a where- Foo3 ( 'Just x) = (x :: a)- type family Foo2 (a :: Maybe a) :: a where- Foo2 ( 'Just x :: Maybe a) = (x :: a)- type family Foo1 (a :: Maybe a) :: a where- Foo1 ( 'Just x :: Maybe a) = (x :: a)- type family G a where- G x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- type family F3 a where- F3 ( 'Just a :: Maybe Bool) = "hi"- type family F2 a where- F2 (x :: Maybe a) = (x :: Maybe a)- type family F1 a where- F1 (x :: Maybe Bool) = (x :: Maybe Bool)- sFoo9 :: forall a (t :: a). Sing t -> Sing (Apply Foo9Sym0 t :: a)- sFoo8 ::- forall a (t :: Maybe a).- Sing t -> Sing (Apply Foo8Sym0 t :: Maybe a)- sFoo7 ::- forall a b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: a)- sFoo6 ::- forall a (t :: Maybe (Maybe a)).- Sing t -> Sing (Apply Foo6Sym0 t :: Maybe (Maybe a))- sFoo5 ::- forall a (t :: Maybe (Maybe a)).- Sing t -> Sing (Apply Foo5Sym0 t :: Maybe (Maybe a))- sFoo4 ::- forall a b (t :: (a, b)).- Sing t -> Sing (Apply Foo4Sym0 t :: (b, a))- sFoo3 ::- forall a (t :: Maybe a). Sing t -> Sing (Apply Foo3Sym0 t :: a)- sFoo2 ::- forall a (t :: Maybe a). Sing t -> Sing (Apply Foo2Sym0 t :: a)- sFoo1 ::- forall a (t :: Maybe a). Sing t -> Sing (Apply Foo1Sym0 t :: a)- sG :: forall arg. Sing arg -> Sing (Apply GSym0 arg)- sF3 :: forall arg. Sing arg -> Sing (Apply F3Sym0 arg)- sF2 :: forall arg. Sing arg -> Sing (Apply F2Sym0 arg)- sF1 :: forall arg. Sing arg -> Sing (Apply F1Sym0 arg)- sFoo9 (sX :: Sing x)- = case sX :: Sing x of {- (_ :: Sing (x :: a))- -> let- sG ::- forall b (t :: a) (t :: b).- Sing t- -> Sing t- -> Sing (Apply (Apply (Let0123456789876543210GSym1 x) t) t :: a)- sG (sY :: Sing y) _ = sY- in- (applySing- ((applySing ((singFun2 @(Let0123456789876543210GSym1 x)) sG)) sX))- STuple0 }- sFoo8- (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210))- = case- ((,) (sWild_0123456789876543210 :: Sing wild_0123456789876543210))- (SJust- (sWild_0123456789876543210 :: Sing wild_0123456789876543210))- of {- (,) (_ :: Sing (wild_0123456789876543210 :: a))- (_ :: Sing ( 'Just (wild_0123456789876543210 :: a) :: Maybe a))- -> let- sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210)- sX- = (applySing ((singFun1 @JustSym0) SJust))- (sWild_0123456789876543210 ::- Sing (wild_0123456789876543210 :: a)) ::- Sing (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a)- in sX }- sFoo7- (sX :: Sing x)- (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- = case- ((,) (sX :: Sing x))- (sWild_0123456789876543210 :: Sing wild_0123456789876543210)- of {- (,) (_ :: Sing (x :: a))- (_ :: Sing (wild_0123456789876543210 :: b))- -> sX :: Sing (x :: a) }- sFoo6 (SJust (sX :: Sing x))- = case SJust (sX :: Sing x) of {- (_ :: Sing ( 'Just x :: Maybe (Maybe a)))- -> let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- sScrutinee_0123456789876543210 = sX :: Sing (x :: Maybe a)- in (case sScrutinee_0123456789876543210 of {- SJust (sY :: Sing y)- -> case ((,) (sY :: Sing y)) (SJust (sY :: Sing y)) of {- (,) (_ :: Sing (y :: a)) (_ :: Sing ( 'Just (y :: a) :: Maybe a))- -> (applySing ((singFun1 @JustSym0) SJust))- ((applySing ((singFun1 @JustSym0) SJust))- (sY :: Sing (y :: a)) ::- Sing (Apply JustSym0 (y :: a) :: Maybe a)) } }) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: Maybe (Maybe a)) }- sFoo5 (SJust (SJust (sX :: Sing x)))- = case- (((,,) (sX :: Sing x)) (SJust (sX :: Sing x)))- (SJust (SJust (sX :: Sing x)))- of {- (,,) (_ :: Sing (x :: a))- (_ :: Sing ( 'Just (x :: a) :: Maybe a))- (_ :: Sing ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a)))- -> (applySing ((singFun1 @JustSym0) SJust))- ((applySing ((singFun1 @JustSym0) SJust)) (sX :: Sing (x :: a)) ::- Sing (Apply JustSym0 (x :: a) :: Maybe a)) ::- Sing (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a)) }- sFoo4 (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((singFun1- @(Apply Lambda_0123456789876543210Sym0 a_0123456789876543210))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of {- STuple2 (sX :: Sing x) (sY :: Sing y)- -> case ((,) (sX :: Sing x)) (sY :: Sing y) of {- (,) (_ :: Sing (x :: a)) (_ :: Sing (y :: b))- -> (applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2))- (sY :: Sing (y :: b))))- (sX :: Sing (x :: a)) } }) ::- Sing (Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) })))- sA_0123456789876543210- sFoo3 (SJust (sX :: Sing x)) = sX :: Sing (x :: a)- sFoo2 (SJust (sX :: Sing x))- = case SJust (sX :: Sing x) of {- (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) }- sFoo1 (SJust (sX :: Sing x))- = case SJust (sX :: Sing x) of {- (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) }- sG (sX :: Sing x)- = let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)- sScrutinee_0123456789876543210- = (applySing ((singFun1 @JustSym0) SJust)) sX- in (case sScrutinee_0123456789876543210 of {- SJust (sY :: Sing y)- -> case SJust (sY :: Sing y) of {- (_ :: Sing ( 'Just y :: Maybe Bool))- -> sY :: Sing (y :: Bool) } }) ::- Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x))- sF3 (SJust (sA :: Sing a))- = case SJust (sA :: Sing a) of {- (_ :: Sing ( 'Just a :: Maybe Bool)) -> sing :: Sing "hi" }- sF2 (sX :: Sing x)- = case sX :: Sing x of {- (_ :: Sing (x :: Maybe a)) -> sX :: Sing (x :: Maybe a) }- sF1 (sX :: Sing x)- = case sX :: Sing x of {- (_ :: Sing (x :: Maybe Bool)) -> sX :: Sing (x :: Maybe Bool) }- instance SingI (Foo9Sym0 :: (~>) a a) where- sing = (singFun1 @Foo9Sym0) sFoo9- instance SingI (Foo8Sym0 :: (~>) (Maybe a) (Maybe a)) where- sing = (singFun1 @Foo8Sym0) sFoo8- instance SingI (Foo7Sym0 :: (~>) a ((~>) b a)) where- sing = (singFun2 @Foo7Sym0) sFoo7- instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b a) where- sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d))- instance SingI (Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where- sing = (singFun1 @Foo6Sym0) sFoo6- instance SingI (Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where- sing = (singFun1 @Foo5Sym0) sFoo5- instance SingI (Foo4Sym0 :: (~>) (a, b) (b, a)) where- sing = (singFun1 @Foo4Sym0) sFoo4- instance SingI (Foo3Sym0 :: (~>) (Maybe a) a) where- sing = (singFun1 @Foo3Sym0) sFoo3- instance SingI (Foo2Sym0 :: (~>) (Maybe a) a) where- sing = (singFun1 @Foo2Sym0) sFoo2- instance SingI (Foo1Sym0 :: (~>) (Maybe a) a) where- sing = (singFun1 @Foo1Sym0) sFoo1- instance SingI GSym0 where- sing = (singFun1 @GSym0) sG- instance SingI F3Sym0 where- sing = (singFun1 @F3Sym0) sF3- instance SingI F2Sym0 where- sing = (singFun1 @F2Sym0) sF2- instance SingI F1Sym0 where- sing = (singFun1 @F1Sym0) sF1
− tests/compile-and-dump/Singletons/T183.hs
@@ -1,65 +0,0 @@-module T183 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- ------ -- Examples from #183- ------- f1 (x :: Maybe Bool) = (x :: Maybe Bool)- f2 (x :: Maybe a) = (x :: Maybe a)- f3 (Just a :: Maybe Bool) = "hi"-- g x = case Just x of- (Just y :: Maybe Bool) -> (y :: Bool)-- ------ -- Using explicit type signatures- ------- -- No explicit forall- foo1 :: Maybe a -> a- foo1 (Just x :: Maybe a) = (x :: a)-- -- Explicit forall- foo2, foo3 :: forall a. Maybe a -> a- foo2 (Just x :: Maybe a) = (x :: a)- foo3 (Just x) = (x :: a)-- ------ -- Multiple pattern signatures- ------- foo4 :: (a, b) -> (b, a)- foo4 = \(x :: a, y :: b) -> (y :: b, x :: a)-- foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a)- foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a))- = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)- foo6 (Just x :: Maybe (Maybe a))- = case x :: Maybe a of- (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a)-- ------ -- Other pattern features- ------- foo7 :: a -> b -> a- foo7 (x :: a) (_ :: b) = (x :: a)-- foo8 :: forall a. Maybe a -> Maybe a- foo8 x@(Just (_ :: a) :: Maybe a) = x- -- foo8 x@(Nothing :: Maybe a) = x -- #296-- ------ -- Type variable scoping (vis-à-vis #297)- ------- foo9 :: a -> a- foo9 (x :: a)- = let g :: a -> b -> a- g y _ = y- in g x ()- |])
− tests/compile-and-dump/Singletons/T184.ghc86.template
@@ -1,499 +0,0 @@-Singletons/T184.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| boogie :: Maybe a -> Maybe Bool -> Maybe a- boogie ma mb- = do a <- ma- b <- mb- guard b- return a- zip' :: [a] -> [b] -> [(a, b)]- zip' xs ys = [(x, y) | x <- xs | y <- ys]- cartProd :: [a] -> [b] -> [(a, b)]- cartProd xs ys = [(x, y) | x <- xs, y <- ys]- trues :: [Bool] -> [Bool]- trues xs = [x | x <- xs, x] |]- ======>- boogie :: Maybe a -> Maybe Bool -> Maybe a- boogie ma mb- = do a <- ma- b <- mb- guard b- return a- zip' :: [a] -> [b] -> [(a, b)]- zip' xs ys = [(x, y) | x <- xs | y <- ys]- cartProd :: [a] -> [b] -> [(a, b)]- cartProd xs ys = [(x, y) | x <- xs, y <- ys]- trues :: [Bool] -> [Bool]- trues xs = [x | x <- xs, x]- type family Lambda_0123456789876543210 xs t where- Lambda_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x)- type Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Lambda_0123456789876543210 xs ys x t where- Lambda_0123456789876543210 xs ys x y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y)- type Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall xs0123456789876543210- ys0123456789876543210- x0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210- ys0123456789876543210- x0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- ys0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Lambda_0123456789876543210 xs ys t where- Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x)- type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210- ys0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- ys0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Lambda_0123456789876543210 xs ys t where- Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x- type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210- ys0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- ys0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Lambda_0123456789876543210 xs ys t where- Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y- type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210- ys0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- ys0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Case_0123456789876543210 xs ys arg_0123456789876543210 t where- Case_0123456789876543210 xs ys arg_0123456789876543210 '(x,- y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y)- type family Lambda_0123456789876543210 xs ys t where- Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210- type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210- ys0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210- ys0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 xs0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 xs0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210- type family Lambda_0123456789876543210 ma mb a t where- Lambda_0123456789876543210 ma mb a b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a)- type Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym3KindInference) ())- data Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym3KindInference :: forall ma0123456789876543210- mb0123456789876543210- a0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 arg) =>- Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210- mb0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210- mb0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 ma0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 ma0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210- type family Lambda_0123456789876543210 ma mb t where- Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a)- type Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210- mb0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210- mb0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 ma0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 ma0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210- type TruesSym1 (a0123456789876543210 :: [Bool]) =- Trues a0123456789876543210- instance SuppressUnusedWarnings TruesSym0 where- suppressUnusedWarnings = snd (((,) TruesSym0KindInference) ())- data TruesSym0 :: (~>) [Bool] [Bool]- where- TruesSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TruesSym0 arg) (TruesSym1 arg) =>- TruesSym0 a0123456789876543210- type instance Apply TruesSym0 a0123456789876543210 = Trues a0123456789876543210- type CartProdSym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) =- CartProd a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) CartProdSym1KindInference) ())- data CartProdSym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210.- (~>) [b0123456789876543210] [(a0123456789876543210,- b0123456789876543210)]- where- CartProdSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) =>- CartProdSym1 a0123456789876543210 a0123456789876543210- type instance Apply (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings CartProdSym0 where- suppressUnusedWarnings = snd (((,) CartProdSym0KindInference) ())- data CartProdSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210,- b0123456789876543210)])- where- CartProdSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) =>- CartProdSym0 a0123456789876543210- type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210- type Zip'Sym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) =- Zip' a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Zip'Sym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) Zip'Sym1KindInference) ())- data Zip'Sym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210.- (~>) [b0123456789876543210] [(a0123456789876543210,- b0123456789876543210)]- where- Zip'Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Zip'Sym1 a0123456789876543210) arg) (Zip'Sym2 a0123456789876543210 arg) =>- Zip'Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Zip'Sym1 a0123456789876543210) a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Zip'Sym0 where- suppressUnusedWarnings = snd (((,) Zip'Sym0KindInference) ())- data Zip'Sym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210,- b0123456789876543210)])- where- Zip'Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) =>- Zip'Sym0 a0123456789876543210- type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210- type BoogieSym2 (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: Maybe Bool) =- Boogie a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) BoogieSym1KindInference) ())- data BoogieSym1 (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe Bool) (Maybe a0123456789876543210)- where- BoogieSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) =>- BoogieSym1 a0123456789876543210 a0123456789876543210- type instance Apply (BoogieSym1 a0123456789876543210) a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings BoogieSym0 where- suppressUnusedWarnings = snd (((,) BoogieSym0KindInference) ())- data BoogieSym0 :: forall a0123456789876543210.- (~>) (Maybe a0123456789876543210) ((~>) (Maybe Bool) (Maybe a0123456789876543210))- where- BoogieSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) =>- BoogieSym0 a0123456789876543210- type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210- type family Trues (a :: [Bool]) :: [Bool] where- Trues xs = Apply (Apply (>>=@#@$) xs) (Apply Lambda_0123456789876543210Sym0 xs)- type family CartProd (a :: [a]) (a :: [b]) :: [(a, b)] where- CartProd xs ys = Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)- type family Zip' (a :: [a]) (a :: [b]) :: [(a, b)] where- Zip' xs ys = Apply (Apply (>>=@#@$) (Apply (Apply MzipSym0 (Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))) (Apply (Apply (>>=@#@$) ys) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)))) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)- type family Boogie (a :: Maybe a) (a :: Maybe Bool) :: Maybe a where- Boogie ma mb = Apply (Apply (>>=@#@$) ma) (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb)- sTrues ::- forall (t :: [Bool]). Sing t -> Sing (Apply TruesSym0 t :: [Bool])- sCartProd ::- forall a b (t :: [a]) (t :: [b]).- Sing t- -> Sing t -> Sing (Apply (Apply CartProdSym0 t) t :: [(a, b)])- sZip' ::- forall a b (t :: [a]) (t :: [b]).- Sing t -> Sing t -> Sing (Apply (Apply Zip'Sym0 t) t :: [(a, b)])- sBoogie ::- forall a (t :: Maybe a) (t :: Maybe Bool).- Sing t -> Sing t -> Sing (Apply (Apply BoogieSym0 t) t :: Maybe a)- sTrues (sXs :: Sing xs)- = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs))- ((singFun1 @(Apply Lambda_0123456789876543210Sym0 xs))- (\ sX- -> case sX of {- (_ :: Sing x)- -> (applySing- ((applySing ((singFun2 @(>>@#@$)) (%>>)))- ((applySing ((singFun1 @GuardSym0) sGuard)) sX)))- ((applySing ((singFun1 @ReturnSym0) sReturn)) sX) }))- sCartProd (sXs :: Sing xs) (sYs :: Sing ys)- = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs))- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))- (\ sX- -> case sX of {- (_ :: Sing x)- -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs))- ((singFun1- @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x))- (\ sY- -> case sY of {- (_ :: Sing y)- -> (applySing ((singFun1 @ReturnSym0) sReturn))- ((applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX))- sY) })) }))- sZip' (sXs :: Sing xs) (sYs :: Sing ys)- = (applySing- ((applySing ((singFun2 @(>>=@#@$)) (%>>=)))- ((applySing- ((applySing ((singFun2 @MzipSym0) sMzip))- ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs))- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))- (\ sX- -> case sX of {- (_ :: Sing x)- -> (applySing ((singFun1 @ReturnSym0) sReturn)) sX })))))- ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs))- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))- (\ sY- -> case sY of {- (_ :: Sing y)- -> (applySing ((singFun1 @ReturnSym0) sReturn)) sY }))))))- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))- (\ sArg_0123456789876543210- -> case sArg_0123456789876543210 of {- (_ :: Sing arg_0123456789876543210)- -> (case sArg_0123456789876543210 of {- STuple2 (sX :: Sing x) (sY :: Sing y)- -> (applySing ((singFun1 @ReturnSym0) sReturn))- ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX))- sY) }) ::- Sing (Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210) }))- sBoogie (sMa :: Sing ma) (sMb :: Sing mb)- = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMa))- ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 ma) mb))- (\ sA- -> case sA of {- (_ :: Sing a)- -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMb))- ((singFun1- @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a))- (\ sB- -> case sB of {- (_ :: Sing b)- -> (applySing- ((applySing ((singFun2 @(>>@#@$)) (%>>)))- ((applySing ((singFun1 @GuardSym0) sGuard)) sB)))- ((applySing ((singFun1 @ReturnSym0) sReturn))- sA) })) }))- instance SingI (TruesSym0 :: (~>) [Bool] [Bool]) where- sing = (singFun1 @TruesSym0) sTrues- instance SingI (CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)])) where- sing = (singFun2 @CartProdSym0) sCartProd- instance SingI d =>- SingI (CartProdSym1 (d :: [a]) :: (~>) [b] [(a, b)]) where- sing = (singFun1 @(CartProdSym1 (d :: [a]))) (sCartProd (sing @d))- instance SingI (Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)])) where- sing = (singFun2 @Zip'Sym0) sZip'- instance SingI d =>- SingI (Zip'Sym1 (d :: [a]) :: (~>) [b] [(a, b)]) where- sing = (singFun1 @(Zip'Sym1 (d :: [a]))) (sZip' (sing @d))- instance SingI (BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a))) where- sing = (singFun2 @BoogieSym0) sBoogie- instance SingI d =>- SingI (BoogieSym1 (d :: Maybe a) :: (~>) (Maybe Bool) (Maybe a)) where- sing = (singFun1 @(BoogieSym1 (d :: Maybe a))) (sBoogie (sing @d))
− tests/compile-and-dump/Singletons/T184.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE ParallelListComp #-}-module T184 where--import Control.Monad-import Data.Singletons.Prelude-import Data.Singletons.Prelude.Monad-import Data.Singletons.Prelude.Monad.Zip-import Data.Singletons.TH--$(singletons [d|- boogie :: Maybe a -> Maybe Bool -> Maybe a- boogie ma mb = do- a <- ma- b <- mb- guard b- return a-- zip' :: [a] -> [b] -> [(a, b)]- zip' xs ys = [(x, y) | x <- xs | y <- ys]-- cartProd :: [a] -> [b] -> [(a, b)]- cartProd xs ys = [(x, y) | x <- xs, y <- ys]-- trues :: [Bool] -> [Bool]- trues xs = [x | x <- xs, x]- |])
− tests/compile-and-dump/Singletons/T187.ghc86.template
@@ -1,57 +0,0 @@-Singletons/T187.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Empty- - deriving instance Ord Empty- deriving instance Eq Empty |]- ======>- data Empty- deriving instance Eq Empty- deriving instance Ord Empty- type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where- Compare_0123456789876543210 _ _ = EQSym0- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd Empty where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where- Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0- instance PEq Empty where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: Empty -> GHC.Types.Type- type SEmpty = (Sing :: Empty -> GHC.Types.Type)- instance SingKind Empty where- type Demote Empty = Empty- fromSing x = case x of- toSing x = SomeSing (case x of)- instance SOrd Empty where- sCompare ::- forall (t1 :: Empty) (t2 :: Empty).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty ((~>) Empty Ordering)- -> GHC.Types.Type) t1) t2)- sCompare _ _ = SEQ- instance SEq Empty where- (%==) _ _ = STrue- instance SDecide Empty where- (%~) x _ = Proved (case x of)
− tests/compile-and-dump/Singletons/T187.hs
@@ -1,8 +0,0 @@-module T187 where--import Data.Singletons.TH--$(singletons[d| data Empty- deriving instance Eq Empty- deriving instance Ord Empty- |])
− tests/compile-and-dump/Singletons/T190.ghc86.template
@@ -1,188 +0,0 @@-Singletons/T190.hs:0:0:: Splicing declarations- singletons- [d| data T- = T- deriving (Eq, Ord, Enum, Bounded, Show) |]- ======>- data T- = T- deriving (Eq, Ord, Enum, Bounded, Show)- type TSym0 = T- type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where- Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[]- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T) :: (~>) T Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd T where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Case_0123456789876543210 n t where- Case_0123456789876543210 n 'True = TSym0- Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"- type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where- ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))- type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) =- ToEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ())- data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat T- where- ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>- ToEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210- type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where- FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0- type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) =- FromEnum_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ())- data FromEnum_0123456789876543210Sym0 :: (~>) T GHC.Types.Nat- where- FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>- FromEnum_0123456789876543210Sym0 a0123456789876543210- type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210- instance PEnum T where- type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a- type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a- type family MinBound_0123456789876543210 :: T where- MinBound_0123456789876543210 = TSym0- type MinBound_0123456789876543210Sym0 =- MinBound_0123456789876543210- type family MaxBound_0123456789876543210 :: T where- MaxBound_0123456789876543210 = TSym0- type MaxBound_0123456789876543210Sym0 =- MaxBound_0123456789876543210- instance PBounded T where- type MinBound = MinBound_0123456789876543210Sym0- type MaxBound = MaxBound_0123456789876543210Sym0- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow T where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where- Equals_0123456789876543210 T T = TrueSym0- Equals_0123456789876543210 (_ :: T) (_ :: T) = FalseSym0- instance PEq T where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: T -> GHC.Types.Type where ST :: Sing T- type ST = (Sing :: T -> GHC.Types.Type)- instance SingKind T where- type Demote T = T- fromSing ST = T- toSing T = SomeSing ST- instance SOrd T where- sCompare ::- forall (t1 :: T) (t2 :: T).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun T ((~>) T Ordering)- -> GHC.Types.Type) t1) t2)- sCompare ST ST- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- Data.Singletons.Prelude.Instances.SNil- instance SEnum T where- sToEnum ::- forall (t :: GHC.Types.Nat).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat T- -> GHC.Types.Type) t)- sFromEnum ::- forall (t :: T).- Sing t- -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun T GHC.Types.Nat- -> GHC.Types.Type) t)- sToEnum (sN :: Sing n)- = (case- (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0))- of- STrue -> ST- SFalse -> sError (sing :: Sing "toEnum: bad argument")) ::- Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)))- sFromEnum ST- = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)- instance SBounded T where- sMinBound :: Sing (MinBoundSym0 :: T)- sMaxBound :: Sing (MaxBoundSym0 :: T)- sMinBound = ST- sMaxBound = ST- instance SShow T where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: T) (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> GHC.Types.Type) t1) t2) t3)- sShowsPrec- _- ST- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "T")))- sA_0123456789876543210- instance SEq T where- (%==) ST ST = STrue- instance SDecide T where- (%~) ST ST = Proved Refl- deriving instance Show (Sing (z :: T))- instance SingI T where- sing = ST
− tests/compile-and-dump/Singletons/T190.hs
@@ -1,12 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-module T190 where--import Data.Singletons.TH--$(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |])
− tests/compile-and-dump/Singletons/T197.ghc86.template
@@ -1,43 +0,0 @@-Singletons/T197.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixl 5 $$:- - ($$:) :: Bool -> Bool -> Bool- _ $$: _ = False |]- ======>- infixl 5 $$:- ($$:) :: Bool -> Bool -> Bool- ($$:) _ _ = False- type ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) =- ($$:) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ())- data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool- where- (:$$:@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) =>- ($$:@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210- infixl 5 $$:@#@$$- instance SuppressUnusedWarnings ($$:@#@$) where- suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ())- data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool)- where- (:$$:@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>- ($$:@#@$) a0123456789876543210- type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210- infixl 5 $$:@#@$- type family ($$:) (a :: Bool) (a :: Bool) :: Bool where- ($$:) _ _ = FalseSym0- infixl 5 %$$:- (%$$:) ::- forall (t :: Bool) (t :: Bool).- Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: Bool)- (%$$:) _ _ = SFalse- instance SingI (($$:@#@$) :: (~>) Bool ((~>) Bool Bool)) where- sing = (singFun2 @($$:@#@$)) (%$$:)- instance SingI d =>- SingI (($$:@#@$$) (d :: Bool) :: (~>) Bool Bool) where- sing = (singFun1 @(($$:@#@$$) (d :: Bool))) ((%$$:) (sing @d))
− tests/compile-and-dump/Singletons/T197.hs
@@ -1,10 +0,0 @@-module T197 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- infixl 5 $$:- ($$:) :: Bool -> Bool -> Bool- _ $$: _ = False- |])
− tests/compile-and-dump/Singletons/T197b.ghc86.template
@@ -1,106 +0,0 @@-Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixr 9 `Pair`, `MkPair`- - data a :*: b = a :*: b- data Pair a b = MkPair a b |]- ======>- data (:*:) a b = a :*: b- data Pair a b = MkPair a b- infixr 9 `Pair`- infixr 9 `MkPair`- type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- (:*:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ())- data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)- where- (::*:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) =>- (:*:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (:*:@#@$) where- suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ())- data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210))- where- (::*:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>- (:*:@#@$) t0123456789876543210- type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210- type MkPairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) =- MkPair t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkPairSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkPairSym1KindInference) ())- data MkPairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)- where- MkPairSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkPairSym1 t0123456789876543210) arg) (MkPairSym2 t0123456789876543210 arg) =>- MkPairSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkPairSym1 t0123456789876543210) t0123456789876543210 = MkPair t0123456789876543210 t0123456789876543210- infixr 9 `MkPairSym1`- instance SuppressUnusedWarnings MkPairSym0 where- suppressUnusedWarnings = snd (((,) MkPairSym0KindInference) ())- data MkPairSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))- where- MkPairSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) =>- MkPairSym0 t0123456789876543210- type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210- infixr 9 `MkPairSym0`- infixr 9 `SPair`- infixr 9 `SMkPair`- data instance Sing :: (:*:) a b -> GHC.Types.Type- where- (:%*:) :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n)- type (%:*:) = (Sing :: (:*:) a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind ((:*:) a b) where- type Demote ((:*:) a b) = (:*:) (Demote a) (Demote b)- fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b)- toSing ((:*:) (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) }- data instance Sing :: Pair a b -> GHC.Types.Type- where- SMkPair :: forall a b (n :: a) (n :: b).- (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (MkPair n n)- type SPair = (Sing :: Pair a b -> GHC.Types.Type)- instance (SingKind a, SingKind b) => SingKind (Pair a b) where- type Demote (Pair a b) = Pair (Demote a) (Demote b)- fromSing (SMkPair b b) = (MkPair (fromSing b)) (fromSing b)- toSing (MkPair (b :: Demote a) (b :: Demote b))- = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkPair c) c) }- instance (SingI n, SingI n) =>- SingI ((:*:) (n :: a) (n :: b)) where- sing = ((:%*:) sing) sing- instance SingI ((:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))) where- sing = (singFun2 @(:*:@#@$)) (:%*:)- instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b ((:*:) a b))) where- sing = (singFun2 @(TyCon2 (:*:))) (:%*:)- instance SingI d =>- SingI ((:*:@#@$$) (d :: a) :: (~>) b ((:*:) a b)) where- sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b ((:*:) a b)) where- sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d))- instance (SingI n, SingI n) =>- SingI (MkPair (n :: a) (n :: b)) where- sing = (SMkPair sing) sing- instance SingI (MkPairSym0 :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @MkPairSym0) SMkPair- instance SingI (TyCon2 MkPair :: (~>) a ((~>) b (Pair a b))) where- sing = (singFun2 @(TyCon2 MkPair)) SMkPair- instance SingI d =>- SingI (MkPairSym1 (d :: a) :: (~>) b (Pair a b)) where- sing = (singFun1 @(MkPairSym1 (d :: a))) (SMkPair (sing @d))- instance SingI d =>- SingI (TyCon1 (MkPair (d :: a)) :: (~>) b (Pair a b)) where- sing = (singFun1 @(TyCon1 (MkPair (d :: a)))) (SMkPair (sing @d))
− tests/compile-and-dump/Singletons/T197b.hs
@@ -1,10 +0,0 @@-module T197b where--import Data.Singletons.TH--$(singletons- [d| data a :*: b = a :*: b-- data Pair a b = MkPair a b- infixr 9 `Pair`, `MkPair`- |])
− tests/compile-and-dump/Singletons/T200.ghc86.template
@@ -1,204 +0,0 @@-Singletons/T200.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- x $$: y = x :$$: y- (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- x <>: y = x :<>: y- - data ErrorMessage- = ErrorMessage :$$: ErrorMessage |- ErrorMessage :<>: ErrorMessage |- EM [Bool] |]- ======>- data ErrorMessage- = ErrorMessage :$$: ErrorMessage |- ErrorMessage :<>: ErrorMessage |- EM [Bool]- ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- ($$:) x y = (x :$$: y)- (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- (<>:) x y = (x :<>: y)- type (:$$:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) =- (:$$:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:$$:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::$$:@#@$$###)) ())- data (:$$:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage- where- (::$$:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:$$:@#@$$) t0123456789876543210) arg) ((:$$:@#@$$$) t0123456789876543210 arg) =>- (:$$:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:$$:@#@$$) t0123456789876543210) t0123456789876543210 = (:$$:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (:$$:@#@$) where- suppressUnusedWarnings = snd (((,) (::$$:@#@$###)) ())- data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)- where- (::$$:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) =>- (:$$:@#@$) t0123456789876543210- type instance Apply (:$$:@#@$) t0123456789876543210 = (:$$:@#@$$) t0123456789876543210- type (:<>:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) =- (:<>:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings ((:<>:@#@$$) t0123456789876543210) where- suppressUnusedWarnings = snd (((,) (::<>:@#@$$###)) ())- data (:<>:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage- where- (::<>:@#@$$###) :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply ((:<>:@#@$$) t0123456789876543210) arg) ((:<>:@#@$$$) t0123456789876543210 arg) =>- (:<>:@#@$$) t0123456789876543210 t0123456789876543210- type instance Apply ((:<>:@#@$$) t0123456789876543210) t0123456789876543210 = (:<>:) t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (:<>:@#@$) where- suppressUnusedWarnings = snd (((,) (::<>:@#@$###)) ())- data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)- where- (::<>:@#@$###) :: forall t0123456789876543210- arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) =>- (:<>:@#@$) t0123456789876543210- type instance Apply (:<>:@#@$) t0123456789876543210 = (:<>:@#@$$) t0123456789876543210- type EMSym1 (t0123456789876543210 :: [Bool]) =- EM t0123456789876543210- instance SuppressUnusedWarnings EMSym0 where- suppressUnusedWarnings = snd (((,) EMSym0KindInference) ())- data EMSym0 :: (~>) [Bool] ErrorMessage- where- EMSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) =>- EMSym0 t0123456789876543210- type instance Apply EMSym0 t0123456789876543210 = EM t0123456789876543210- type (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) =- (<>:) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:<>:@#@$$###)) ())- data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage- where- (:<>:@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) =>- (<>:@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (<>:@#@$) where- suppressUnusedWarnings = snd (((,) (:<>:@#@$###)) ())- data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)- where- (:<>:@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) =>- (<>:@#@$) a0123456789876543210- type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210- type ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) =- ($$:) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ())- data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage- where- (:$$:@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) =>- ($$:@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ($$:@#@$) where- suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ())- data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)- where- (:$$:@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>- ($$:@#@$) a0123456789876543210- type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210- type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where- (<>:) x y = Apply (Apply (:<>:@#@$) x) y- type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where- ($$:) x y = Apply (Apply (:$$:@#@$) x) y- (%<>:) ::- forall (t :: ErrorMessage) (t :: ErrorMessage).- Sing t- -> Sing t -> Sing (Apply (Apply (<>:@#@$) t) t :: ErrorMessage)- (%$$:) ::- forall (t :: ErrorMessage) (t :: ErrorMessage).- Sing t- -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage)- (%<>:) (sX :: Sing x) (sY :: Sing y)- = (applySing ((applySing ((singFun2 @(:<>:@#@$)) (:%<>:))) sX)) sY- (%$$:) (sX :: Sing x) (sY :: Sing y)- = (applySing ((applySing ((singFun2 @(:$$:@#@$)) (:%$$:))) sX)) sY- instance SingI ((<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @(<>:@#@$)) (%<>:)- instance SingI d =>- SingI ((<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @((<>:@#@$$) (d :: ErrorMessage))) ((%<>:) (sing @d))- instance SingI (($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @($$:@#@$)) (%$$:)- instance SingI d =>- SingI (($$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @(($$:@#@$$) (d :: ErrorMessage))) ((%$$:) (sing @d))- data instance Sing :: ErrorMessage -> GHC.Types.Type- where- (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage).- (Sing (n :: ErrorMessage))- -> (Sing (n :: ErrorMessage)) -> Sing ((:$$:) n n)- (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage).- (Sing (n :: ErrorMessage))- -> (Sing (n :: ErrorMessage)) -> Sing ((:<>:) n n)- SEM :: forall (n :: [Bool]). (Sing (n :: [Bool])) -> Sing (EM n)- type SErrorMessage = (Sing :: ErrorMessage -> GHC.Types.Type)- instance SingKind ErrorMessage where- type Demote ErrorMessage = ErrorMessage- fromSing ((:%$$:) b b) = ((:$$:) (fromSing b)) (fromSing b)- fromSing ((:%<>:) b b) = ((:<>:) (fromSing b)) (fromSing b)- fromSing (SEM b) = EM (fromSing b)- toSing- ((:$$:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage))- = case- ((,) (toSing b :: SomeSing ErrorMessage))- (toSing b :: SomeSing ErrorMessage)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%$$:) c) c) }- toSing- ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage))- = case- ((,) (toSing b :: SomeSing ErrorMessage))- (toSing b :: SomeSing ErrorMessage)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%<>:) c) c) }- toSing (EM (b :: Demote [Bool]))- = case toSing b :: SomeSing [Bool] of {- SomeSing c -> SomeSing (SEM c) }- instance (SingI n, SingI n) =>- SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where- sing = ((:%$$:) sing) sing- instance SingI ((:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @(:$$:@#@$)) (:%$$:)- instance SingI (TyCon2 (:$$:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @(TyCon2 (:$$:))) (:%$$:)- instance SingI d =>- SingI ((:$$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @((:$$:@#@$$) (d :: ErrorMessage))) ((:%$$:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:$$:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @(TyCon1 ((:$$:) (d :: ErrorMessage))))- ((:%$$:) (sing @d))- instance (SingI n, SingI n) =>- SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where- sing = ((:%<>:) sing) sing- instance SingI ((:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @(:<>:@#@$)) (:%<>:)- instance SingI (TyCon2 (:<>:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where- sing = (singFun2 @(TyCon2 (:<>:))) (:%<>:)- instance SingI d =>- SingI ((:<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @((:<>:@#@$$) (d :: ErrorMessage))) ((:%<>:) (sing @d))- instance SingI d =>- SingI (TyCon1 ((:<>:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where- sing- = (singFun1 @(TyCon1 ((:<>:) (d :: ErrorMessage))))- ((:%<>:) (sing @d))- instance SingI n => SingI (EM (n :: [Bool])) where- sing = SEM sing- instance SingI (EMSym0 :: (~>) [Bool] ErrorMessage) where- sing = (singFun1 @EMSym0) SEM- instance SingI (TyCon1 EM :: (~>) [Bool] ErrorMessage) where- sing = (singFun1 @(TyCon1 EM)) SEM
− tests/compile-and-dump/Singletons/T200.hs
@@ -1,15 +0,0 @@-module T200 where--import Data.Singletons.TH--$(singletons [d|- data ErrorMessage = ErrorMessage :$$: ErrorMessage- | ErrorMessage :<>: ErrorMessage- | EM [Bool]-- ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- x $$: y = x :$$: y-- (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage- x <>: y = x :<>: y- |])
− tests/compile-and-dump/Singletons/T206.ghc86.template
− tests/compile-and-dump/Singletons/T206.hs
@@ -1,5 +0,0 @@-module T206 where--import Data.Singletons.Prelude--x = SCons @Bool @True @'[False]
− tests/compile-and-dump/Singletons/T209.ghc86.template
@@ -1,82 +0,0 @@-Singletons/T209.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| m :: a -> b -> Bool -> Bool- m _ _ x = x- - class C a b- data Hm- = Hm- deriving anyclass (C Bool)- - deriving anyclass instance C a a => C a (Maybe a) |]- ======>- class C a b- m :: a -> b -> Bool -> Bool- m _ _ x = x- data Hm- = Hm- deriving anyclass (C Bool)- deriving anyclass instance C a a => C a (Maybe a)- type HmSym0 = Hm- type MSym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: Bool) =- M a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) MSym2KindInference) ())- data MSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) Bool Bool- where- MSym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) =>- MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) MSym1KindInference) ())- data MSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 ((~>) Bool Bool)- where- MSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) =>- MSym1 a0123456789876543210 a0123456789876543210- type instance Apply (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings MSym0 where- suppressUnusedWarnings = snd (((,) MSym0KindInference) ())- data MSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) Bool Bool))- where- MSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply MSym0 arg) (MSym1 arg) =>- MSym0 a0123456789876543210- type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210- type family M (a :: a) (a :: b) (a :: Bool) :: Bool where- M _ _ x = x- class PC (a :: GHC.Types.Type) (b :: GHC.Types.Type)- instance PC Bool Hm- instance PC a (Maybe a)- sM ::- forall a b (t :: a) (t :: b) (t :: Bool).- Sing t- -> Sing t- -> Sing t -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool)- sM _ _ (sX :: Sing x) = sX- instance SingI (MSym0 :: (~>) a ((~>) b ((~>) Bool Bool))) where- sing = (singFun3 @MSym0) sM- instance SingI d =>- SingI (MSym1 (d :: a) :: (~>) b ((~>) Bool Bool)) where- sing = (singFun2 @(MSym1 (d :: a))) (sM (sing @d))- instance (SingI d, SingI d) =>- SingI (MSym2 (d :: a) (d :: b) :: (~>) Bool Bool) where- sing- = (singFun1 @(MSym2 (d :: a) (d :: b))) ((sM (sing @d)) (sing @d))- data instance Sing :: Hm -> GHC.Types.Type where SHm :: Sing Hm- type SHm = (Sing :: Hm -> GHC.Types.Type)- instance SingKind Hm where- type Demote Hm = Hm- fromSing SHm = Hm- toSing Hm = SomeSing SHm- class SC a b- instance SC Bool Hm- instance SC a a => SC a (Maybe a)- instance SingI Hm where- sing = SHm
− tests/compile-and-dump/Singletons/T209.hs
@@ -1,16 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-module T209 where--import Data.Singletons.TH--$(singletons- [d| class C a b where- m :: a -> b -> Bool -> Bool- m _ _ x = x-- data Hm = Hm- deriving anyclass (C Bool)-- deriving anyclass instance C a a => C a (Maybe a)- |])
− tests/compile-and-dump/Singletons/T216.ghc86.template
@@ -1,56 +0,0 @@-Singletons/T216.hs:0:0:: Splicing declarations- genDefunSymbols [''MyProxy, ''Symmetry]- ======>- type MyProxySym2 (k0123456789876543210 :: Type) (a0123456789876543210 :: k0123456789876543210) =- MyProxy k0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where- suppressUnusedWarnings = snd (((,) MyProxySym1KindInference) ())- data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type- where- MyProxySym1KindInference :: forall k0123456789876543210- a0123456789876543210- arg. SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) =>- MyProxySym1 k0123456789876543210 a0123456789876543210- type instance Apply (MyProxySym1 k0123456789876543210) a0123456789876543210 = MyProxy k0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings MyProxySym0 where- suppressUnusedWarnings = snd (((,) MyProxySym0KindInference) ())- data MyProxySym0 :: forall (k0123456789876543210 :: Type).- (~>) Type ((~>) k0123456789876543210 Type)- where- MyProxySym0KindInference :: forall k0123456789876543210- arg. SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) =>- MyProxySym0 k0123456789876543210- type instance Apply MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210- type SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) =- Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210- instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ())- data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type- where- SymmetrySym2KindInference :: forall a0123456789876543210- y0123456789876543210- e0123456789876543210- arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) =>- SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210- type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210- instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ())- data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: forall (y0123456789876543210 :: t0123456789876543210).- (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)- where- SymmetrySym1KindInference :: forall a0123456789876543210- y0123456789876543210- arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) =>- SymmetrySym1 a0123456789876543210 y0123456789876543210- type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings SymmetrySym0 where- suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ())- data SymmetrySym0 :: forall t0123456789876543210- (a0123456789876543210 :: t0123456789876543210)- (y0123456789876543210 :: t0123456789876543210).- (~>) t0123456789876543210 ((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type))- where- SymmetrySym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) =>- SymmetrySym0 a0123456789876543210- type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210
− tests/compile-and-dump/Singletons/T216.hs
@@ -1,12 +0,0 @@-module T216 where--import Data.Kind-import Data.Singletons.TH--type family MyProxy k (a :: k) :: Type where- MyProxy _ a = Proxy a--type family Symmetry (a :: t) (y :: t) (e :: a :~: y) :: Type where- Symmetry a y _ = y :~: a--$(genDefunSymbols [''MyProxy, ''Symmetry])
− tests/compile-and-dump/Singletons/T226.ghc86.template
@@ -1,6 +0,0 @@-Singletons/T226.hs:0:0:: Splicing declarations- singletons [d| class a ~> b |]- ======>- class (~>) a b- class (#~>) (a :: GHC.Types.Type) (b :: GHC.Types.Type)- class (%~>) a b
− tests/compile-and-dump/Singletons/T226.hs
@@ -1,5 +0,0 @@-module T226 where--import Data.Singletons.TH--$(singletons [d| class a ~> b |])
− tests/compile-and-dump/Singletons/T229.ghc86.template
@@ -1,24 +0,0 @@-Singletons/T229.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| ___foo :: Bool -> Bool- ___foo _ = True |]- ======>- ___foo :: Bool -> Bool- ___foo _ = True- type US___fooSym1 (a0123456789876543210 :: Bool) =- US___foo a0123456789876543210- instance SuppressUnusedWarnings US___fooSym0 where- suppressUnusedWarnings = snd (((,) US___fooSym0KindInference) ())- data US___fooSym0 :: (~>) Bool Bool- where- US___fooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) =>- US___fooSym0 a0123456789876543210- type instance Apply US___fooSym0 a0123456789876543210 = US___foo a0123456789876543210- type family US___foo (a :: Bool) :: Bool where- US___foo _ = TrueSym0- ___sfoo ::- forall (t :: Bool). Sing t -> Sing (Apply US___fooSym0 t :: Bool)- ___sfoo _ = STrue- instance SingI (US___fooSym0 :: (~>) Bool Bool) where- sing = (singFun1 @US___fooSym0) ___sfoo
− tests/compile-and-dump/Singletons/T229.hs
@@ -1,6 +0,0 @@-module T229 where--import Data.Singletons.TH--$(singletons [d| ___foo :: Bool -> Bool- ___foo _ = True |])
− tests/compile-and-dump/Singletons/T249.ghc86.template
@@ -1,90 +0,0 @@-Singletons/T249.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Foo1 a = MkFoo1 a- data Foo2 a where MkFoo2 :: x -> Foo2 x- data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |]- ======>- data Foo1 a = MkFoo1 a- data Foo2 a where MkFoo2 :: x -> Foo2 x- data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x- type MkFoo1Sym1 (t0123456789876543210 :: a0123456789876543210) =- MkFoo1 t0123456789876543210- instance SuppressUnusedWarnings MkFoo1Sym0 where- suppressUnusedWarnings = snd (((,) MkFoo1Sym0KindInference) ())- data MkFoo1Sym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 (Foo1 a0123456789876543210)- where- MkFoo1Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) =>- MkFoo1Sym0 t0123456789876543210- type instance Apply MkFoo1Sym0 t0123456789876543210 = MkFoo1 t0123456789876543210- type MkFoo2Sym1 (t0123456789876543210 :: x0123456789876543210) =- MkFoo2 t0123456789876543210- instance SuppressUnusedWarnings MkFoo2Sym0 where- suppressUnusedWarnings = snd (((,) MkFoo2Sym0KindInference) ())- data MkFoo2Sym0 :: forall x0123456789876543210.- (~>) x0123456789876543210 (Foo2 x0123456789876543210)- where- MkFoo2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) =>- MkFoo2Sym0 t0123456789876543210- type instance Apply MkFoo2Sym0 t0123456789876543210 = MkFoo2 t0123456789876543210- type MkFoo3Sym1 (t0123456789876543210 :: x0123456789876543210) =- MkFoo3 t0123456789876543210- instance SuppressUnusedWarnings MkFoo3Sym0 where- suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ())- data MkFoo3Sym0 :: forall x0123456789876543210.- (~>) x0123456789876543210 (Foo3 x0123456789876543210)- where- MkFoo3Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>- MkFoo3Sym0 t0123456789876543210- type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3 t0123456789876543210- data instance Sing :: Foo1 a -> Type- where- SMkFoo1 :: forall a (n :: a). (Sing (n :: a)) -> Sing (MkFoo1 n)- type SFoo1 = (Sing :: Foo1 a -> Type)- instance SingKind a => SingKind (Foo1 a) where- type Demote (Foo1 a) = Foo1 (Demote a)- fromSing (SMkFoo1 b) = MkFoo1 (fromSing b)- toSing (MkFoo1 (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SMkFoo1 c) }- data instance Sing :: Foo2 a -> Type- where- SMkFoo2 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo2 n)- type SFoo2 = (Sing :: Foo2 a -> Type)- instance SingKind a => SingKind (Foo2 a) where- type Demote (Foo2 a) = Foo2 (Demote a)- fromSing (SMkFoo2 b) = MkFoo2 (fromSing b)- toSing (MkFoo2 (b :: Demote x))- = case toSing b :: SomeSing x of {- SomeSing c -> SomeSing (SMkFoo2 c) }- data instance Sing :: Foo3 a -> Type- where- SMkFoo3 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo3 n)- type SFoo3 = (Sing :: Foo3 a -> Type)- instance SingKind a => SingKind (Foo3 a) where- type Demote (Foo3 a) = Foo3 (Demote a)- fromSing (SMkFoo3 b) = MkFoo3 (fromSing b)- toSing (MkFoo3 (b :: Demote x))- = case toSing b :: SomeSing x of {- SomeSing c -> SomeSing (SMkFoo3 c) }- instance SingI n => SingI (MkFoo1 (n :: a)) where- sing = SMkFoo1 sing- instance SingI (MkFoo1Sym0 :: (~>) a (Foo1 a)) where- sing = (singFun1 @MkFoo1Sym0) SMkFoo1- instance SingI (TyCon1 MkFoo1 :: (~>) a (Foo1 a)) where- sing = (singFun1 @(TyCon1 MkFoo1)) SMkFoo1- instance SingI n => SingI (MkFoo2 (n :: x)) where- sing = SMkFoo2 sing- instance SingI (MkFoo2Sym0 :: (~>) x (Foo2 x)) where- sing = (singFun1 @MkFoo2Sym0) SMkFoo2- instance SingI (TyCon1 MkFoo2 :: (~>) x (Foo2 x)) where- sing = (singFun1 @(TyCon1 MkFoo2)) SMkFoo2- instance SingI n => SingI (MkFoo3 (n :: x)) where- sing = SMkFoo3 sing- instance SingI (MkFoo3Sym0 :: (~>) x (Foo3 x)) where- sing = (singFun1 @MkFoo3Sym0) SMkFoo3- instance SingI (TyCon1 MkFoo3 :: (~>) x (Foo3 x)) where- sing = (singFun1 @(TyCon1 MkFoo3)) SMkFoo3
− tests/compile-and-dump/Singletons/T249.hs
@@ -1,12 +0,0 @@-module T249 where--import Data.Kind-import Data.Singletons.TH--$(singletons- [d| data Foo1 a = MkFoo1 a- data Foo2 a where- MkFoo2 :: x -> Foo2 x- data Foo3 a where- MkFoo3 :: forall x. x -> Foo3 x- |])
− tests/compile-and-dump/Singletons/T271.ghc86.template
@@ -1,199 +0,0 @@-Singletons/T271.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| newtype Constant (a :: Type) (b :: Type)- = Constant a- deriving (Eq, Ord)- data Identity :: Type -> Type- where Identity :: a -> Identity a- deriving (Eq, Ord) |]- ======>- newtype Constant (a :: Type) (b :: Type)- = Constant a- deriving (Eq, Ord)- data Identity :: Type -> Type- where Identity :: a -> Identity a- deriving (Eq, Ord)- type ConstantSym1 (t0123456789876543210 :: a0123456789876543210) =- Constant t0123456789876543210- instance SuppressUnusedWarnings ConstantSym0 where- suppressUnusedWarnings = snd (((,) ConstantSym0KindInference) ())- data ConstantSym0 :: forall (a0123456789876543210 :: Type)- (b0123456789876543210 :: Type).- (~>) a0123456789876543210 (Constant (a0123456789876543210 :: Type) (b0123456789876543210 :: Type))- where- ConstantSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) =>- ConstantSym0 t0123456789876543210- type instance Apply ConstantSym0 t0123456789876543210 = Constant t0123456789876543210- type IdentitySym1 (t0123456789876543210 :: a0123456789876543210) =- Identity t0123456789876543210- instance SuppressUnusedWarnings IdentitySym0 where- suppressUnusedWarnings = snd (((,) IdentitySym0KindInference) ())- data IdentitySym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 (Identity a0123456789876543210)- where- IdentitySym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) =>- IdentitySym0 t0123456789876543210- type instance Apply IdentitySym0 t0123456789876543210 = Identity t0123456789876543210- type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where- Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) :: (~>) (Constant a0123456789876543210 b0123456789876543210) Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) (Constant a0123456789876543210 b0123456789876543210) ((~>) (Constant a0123456789876543210 b0123456789876543210) Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd (Constant a b) where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where- Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])- type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a0123456789876543210) (a0123456789876543210 :: Identity a0123456789876543210) =- Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym1KindInference) ())- data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a0123456789876543210) :: (~>) (Identity a0123456789876543210) Ordering- where- Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) =>- Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Compare_0123456789876543210Sym0KindInference) ())- data Compare_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) (Identity a0123456789876543210) ((~>) (Identity a0123456789876543210) Ordering)- where- Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>- Compare_0123456789876543210Sym0 a0123456789876543210- type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210- instance POrd (Identity a) where- type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a- type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where- Equals_0123456789876543210 (Constant a) (Constant b) = (==) a b- Equals_0123456789876543210 (_ :: Constant a b) (_ :: Constant a b) = FalseSym0- instance PEq (Constant a b) where- type (==) a b = Equals_0123456789876543210 a b- type family Equals_0123456789876543210 (a :: Identity a) (b :: Identity a) :: Bool where- Equals_0123456789876543210 (Identity a) (Identity b) = (==) a b- Equals_0123456789876543210 (_ :: Identity a) (_ :: Identity a) = FalseSym0- instance PEq (Identity a) where- type (==) a b = Equals_0123456789876543210 a b- data instance Sing :: Constant a b -> Type- where- SConstant :: forall a (n :: a).- (Sing (n :: a)) -> Sing (Constant n)- type SConstant = (Sing :: Constant a b -> Type)- instance (SingKind a, SingKind b) => SingKind (Constant a b) where- type Demote (Constant a b) = Constant (Demote a) (Demote b)- fromSing (SConstant b) = Constant (fromSing b)- toSing (Constant (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SConstant c) }- data instance Sing :: Identity a -> Type- where- SIdentity :: forall a (n :: a).- (Sing (n :: a)) -> Sing (Identity n)- type SIdentity = (Sing :: Identity a -> Type)- instance SingKind a => SingKind (Identity a) where- type Demote (Identity a) = Identity (Demote a)- fromSing (SIdentity b) = Identity (fromSing b)- toSing (Identity (b :: Demote a))- = case toSing b :: SomeSing a of {- SomeSing c -> SomeSing (SIdentity c) }- instance SOrd a => SOrd (Constant a b) where- sCompare ::- forall (t1 :: Constant a b) (t2 :: Constant a b).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun (Constant a b) ((~>) (Constant a b) Ordering)- -> Type) t1) t2)- sCompare- (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing- ((singFun2 @(:@#@$))- Data.Singletons.Prelude.Instances.SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- Data.Singletons.Prelude.Instances.SNil)- instance SOrd a => SOrd (Identity a) where- sCompare ::- forall (t1 :: Identity a) (t2 :: Identity a).- Sing t1- -> Sing t2- -> Sing (Apply (Apply (CompareSym0 :: TyFun (Identity a) ((~>) (Identity a) Ordering)- -> Type) t1) t2)- sCompare- (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210))- (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210))- = (applySing- ((applySing- ((applySing ((singFun3 @FoldlSym0) sFoldl))- ((singFun2 @ThenCmpSym0) sThenCmp)))- SEQ))- ((applySing- ((applySing- ((singFun2 @(:@#@$))- Data.Singletons.Prelude.Instances.SCons))- ((applySing- ((applySing ((singFun2 @CompareSym0) sCompare))- sA_0123456789876543210))- sB_0123456789876543210)))- Data.Singletons.Prelude.Instances.SNil)- instance SEq a => SEq (Constant a b) where- (%==) (SConstant a) (SConstant b) = ((%==) a) b- instance SDecide a => SDecide (Constant a b) where- (%~) (SConstant a) (SConstant b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SEq a => SEq (Identity a) where- (%==) (SIdentity a) (SIdentity b) = ((%==) a) b- instance SDecide a => SDecide (Identity a) where- (%~) (SIdentity a) (SIdentity b)- = case ((%~) a) b of- Proved Refl -> Proved Refl- Disproved contra- -> Disproved (\ refl -> case refl of { Refl -> contra Refl })- instance SingI n => SingI (Constant (n :: a)) where- sing = SConstant sing- instance SingI (ConstantSym0 :: (~>) a (Constant (a :: Type) (b :: Type))) where- sing = (singFun1 @ConstantSym0) SConstant- instance SingI (TyCon1 Constant :: (~>) a (Constant (a :: Type) (b :: Type))) where- sing = (singFun1 @(TyCon1 Constant)) SConstant- instance SingI n => SingI (Identity (n :: a)) where- sing = SIdentity sing- instance SingI (IdentitySym0 :: (~>) a (Identity a)) where- sing = (singFun1 @IdentitySym0) SIdentity- instance SingI (TyCon1 Identity :: (~>) a (Identity a)) where- sing = (singFun1 @(TyCon1 Identity)) SIdentity
− tests/compile-and-dump/Singletons/T271.hs
@@ -1,13 +0,0 @@-module T271 where--import Data.Kind (Type)-import Data.Singletons.TH--$(singletons- [d| newtype Constant (a :: Type) (b :: Type) =- Constant a deriving (Eq, Ord)-- data Identity :: Type -> Type where- Identity :: a -> Identity a- deriving (Eq, Ord)- |])
− tests/compile-and-dump/Singletons/T287.ghc86.template
@@ -1,116 +0,0 @@-Singletons/T287.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class S a where- (<<>>) :: a -> a -> a- - instance S b => S (a -> b) where- f <<>> g = \ x -> f x <<>> g x |]- ======>- class S a where- (<<>>) :: a -> a -> a- instance S b => S (a -> b) where- (<<>>) f g = \ x -> (f x <<>> g x)- type (<<>>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) =- (<<>>) arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings ((<<>>@#@$$) arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:<<>>@#@$$###)) ())- data (<<>>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210- where- (:<<>>@#@$$###) :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply ((<<>>@#@$$) arg0123456789876543210) arg) ((<<>>@#@$$$) arg0123456789876543210 arg) =>- (<<>>@#@$$) arg0123456789876543210 arg0123456789876543210- type instance Apply ((<<>>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<<>>) arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (<<>>@#@$) where- suppressUnusedWarnings = snd (((,) (:<<>>@#@$###)) ())- data (<<>>@#@$) :: forall a0123456789876543210.- (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210)- where- (:<<>>@#@$###) :: forall arg0123456789876543210- arg. SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) =>- (<<>>@#@$) arg0123456789876543210- type instance Apply (<<>>@#@$) arg0123456789876543210 = (<<>>@#@$$) arg0123456789876543210- class PS (a :: GHC.Types.Type) where- type (<<>>) (arg :: a) (arg :: a) :: a- type family Lambda_0123456789876543210 f g t where- Lambda_0123456789876543210 f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x)- type Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 =- Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym2KindInference) ())- data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210- where- Lambda_0123456789876543210Sym2KindInference :: forall f0123456789876543210- g0123456789876543210- t0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) =>- Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 g0123456789876543210 f0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 f0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym1KindInference) ())- data Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210- where- Lambda_0123456789876543210Sym1KindInference :: forall f0123456789876543210- g0123456789876543210- arg. SameKind (Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) arg) (Lambda_0123456789876543210Sym2 f0123456789876543210 arg) =>- Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210- type instance Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) g0123456789876543210 = Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210- instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Lambda_0123456789876543210Sym0KindInference) ())- data Lambda_0123456789876543210Sym0 f0123456789876543210- where- Lambda_0123456789876543210Sym0KindInference :: forall f0123456789876543210- arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>- Lambda_0123456789876543210Sym0 f0123456789876543210- type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210- type family TFHelper_0123456789876543210 (a :: (~>) a b) (a :: (~>) a b) :: (~>) a b where- TFHelper_0123456789876543210 f g = Apply (Apply Lambda_0123456789876543210Sym0 f) g- type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) =- TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ())- data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)- where- TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) =>- TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ())- data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210))- where- TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>- TFHelper_0123456789876543210Sym0 a0123456789876543210- type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210- instance PS ((~>) a b) where- type (<<>>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a- class SS a where- (%<<>>) ::- forall (t :: a) (t :: a).- Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: a)- instance SS b => SS ((~>) a b) where- (%<<>>) ::- forall (t :: (~>) a b) (t :: (~>) a b).- Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: (~>) a b)- (%<<>>) (sF :: Sing f) (sG :: Sing g)- = (singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 f) g))- (\ sX- -> case sX of {- (_ :: Sing x)- -> (applySing- ((applySing ((singFun2 @(<<>>@#@$)) (%<<>>))) ((applySing sF) sX)))- ((applySing sG) sX) })- instance SS a => SingI ((<<>>@#@$) :: (~>) a ((~>) a a)) where- sing = (singFun2 @(<<>>@#@$)) (%<<>>)- instance (SS a, SingI d) =>- SingI ((<<>>@#@$$) (d :: a) :: (~>) a a) where- sing = (singFun1 @((<<>>@#@$$) (d :: a))) ((%<<>>) (sing @d))
− tests/compile-and-dump/Singletons/T287.hs
@@ -1,11 +0,0 @@-module T287 where--import Data.Singletons.TH--$(singletons [d|- class S a where- (<<>>) :: a -> a -> a-- instance S b => S (a -> b) where- f <<>> g = \x -> f x <<>> g x- |])
− tests/compile-and-dump/Singletons/T29.ghc86.template
@@ -1,115 +0,0 @@-Singletons/T29.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: Bool -> Bool- foo x = not $ x- bar :: Bool -> Bool- bar x = not . not . not $ x- baz :: Bool -> Bool- baz x = not $! x- ban :: Bool -> Bool- ban x = not . not . not $! x |]- ======>- foo :: Bool -> Bool- foo x = (not $ x)- bar :: Bool -> Bool- bar x = ((not . (not . not)) $ x)- baz :: Bool -> Bool- baz x = (not $! x)- ban :: Bool -> Bool- ban x = ((not . (not . not)) $! x)- type BanSym1 (a0123456789876543210 :: Bool) =- Ban a0123456789876543210- instance SuppressUnusedWarnings BanSym0 where- suppressUnusedWarnings = snd (((,) BanSym0KindInference) ())- data BanSym0 :: (~>) Bool Bool- where- BanSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) =>- BanSym0 a0123456789876543210- type instance Apply BanSym0 a0123456789876543210 = Ban a0123456789876543210- type BazSym1 (a0123456789876543210 :: Bool) =- Baz a0123456789876543210- instance SuppressUnusedWarnings BazSym0 where- suppressUnusedWarnings = snd (((,) BazSym0KindInference) ())- data BazSym0 :: (~>) Bool Bool- where- BazSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) =>- BazSym0 a0123456789876543210- type instance Apply BazSym0 a0123456789876543210 = Baz a0123456789876543210- type BarSym1 (a0123456789876543210 :: Bool) =- Bar a0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) Bool Bool- where- BarSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 a0123456789876543210- type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210- type FooSym1 (a0123456789876543210 :: Bool) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) Bool Bool- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Ban (a :: Bool) :: Bool where- Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x- type family Baz (a :: Bool) :: Bool where- Baz x = Apply (Apply ($!@#@$) NotSym0) x- type family Bar (a :: Bool) :: Bool where- Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x- type family Foo (a :: Bool) :: Bool where- Foo x = Apply (Apply ($@#@$) NotSym0) x- sBan ::- forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool)- sBaz ::- forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool)- sBar ::- forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool)- sFoo ::- forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool)- sBan (sX :: Sing x)- = (applySing- ((applySing ((singFun2 @($!@#@$)) (%$!)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @NotSym0) sNot)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @NotSym0) sNot)))- ((singFun1 @NotSym0) sNot)))))- sX- sBaz (sX :: Sing x)- = (applySing- ((applySing ((singFun2 @($!@#@$)) (%$!)))- ((singFun1 @NotSym0) sNot)))- sX- sBar (sX :: Sing x)- = (applySing- ((applySing ((singFun2 @($@#@$)) (%$)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @NotSym0) sNot)))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((singFun1 @NotSym0) sNot)))- ((singFun1 @NotSym0) sNot)))))- sX- sFoo (sX :: Sing x)- = (applySing- ((applySing ((singFun2 @($@#@$)) (%$)))- ((singFun1 @NotSym0) sNot)))- sX- instance SingI (BanSym0 :: (~>) Bool Bool) where- sing = (singFun1 @BanSym0) sBan- instance SingI (BazSym0 :: (~>) Bool Bool) where- sing = (singFun1 @BazSym0) sBaz- instance SingI (BarSym0 :: (~>) Bool Bool) where- sing = (singFun1 @BarSym0) sBar- instance SingI (FooSym0 :: (~>) Bool Bool) where- sing = (singFun1 @FooSym0) sFoo
− tests/compile-and-dump/Singletons/T29.hs
@@ -1,44 +0,0 @@-module Singletons.T29 where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|- foo :: Bool -> Bool- foo x = not $ x-- -- test that $ works with function composition- bar :: Bool -> Bool- bar x = not . not . not $ x-- baz :: Bool -> Bool- baz x = not $! x-- -- test that $! works with function composition- ban :: Bool -> Bool- ban x = not . not . not $! x- |])--foo1a :: Proxy (Foo True)-foo1a = Proxy--foo1b :: Proxy False-foo1b = foo1b--bar1a :: Proxy (Bar True)-bar1a = Proxy--bar1b :: Proxy False-bar1b = bar1b--baz1a :: Proxy (Baz True)-baz1a = Proxy--baz1b :: Proxy False-baz1b = baz1b--ban1a :: Proxy (Ban True)-ban1a = Proxy--ban1b :: Proxy False-ban1b = ban1b
− tests/compile-and-dump/Singletons/T297.ghc86.template
@@ -1,59 +0,0 @@-Singletons/T297.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| f MyProxy- = let- x = let- z :: MyProxy a- z = MyProxy- in z- in x- - data MyProxy (a :: Type) = MyProxy |]- ======>- data MyProxy (a :: Type) = MyProxy- f MyProxy- = let- x = let- z :: MyProxy a- z = MyProxy- in z- in x- type MyProxySym0 = MyProxy- type Let0123456789876543210ZSym0 = Let0123456789876543210Z- type family Let0123456789876543210Z :: MyProxy a where- Let0123456789876543210Z = MyProxySym0- type Let0123456789876543210XSym0 = Let0123456789876543210X- type family Let0123456789876543210X where- Let0123456789876543210X = Let0123456789876543210ZSym0- type FSym1 a0123456789876543210 = F a0123456789876543210- instance SuppressUnusedWarnings FSym0 where- suppressUnusedWarnings = snd (((,) FSym0KindInference) ())- data FSym0 a0123456789876543210- where- FSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>- FSym0 a0123456789876543210- type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210- type family F a where- F MyProxy = Let0123456789876543210XSym0- sF :: forall arg. Sing arg -> Sing (Apply FSym0 arg)- sF SMyProxy- = let- sX :: Sing Let0123456789876543210XSym0- sX- = let- sZ :: forall a. Sing (Let0123456789876543210ZSym0 :: MyProxy a)- sZ = SMyProxy- in sZ- in sX- instance SingI FSym0 where- sing = (singFun1 @FSym0) sF- data instance Sing :: MyProxy a -> Type- where SMyProxy :: Sing MyProxy- type SMyProxy = (Sing :: MyProxy a -> Type)- instance SingKind a => SingKind (MyProxy a) where- type Demote (MyProxy a) = MyProxy (Demote a)- fromSing SMyProxy = MyProxy- toSing MyProxy = SomeSing SMyProxy- instance SingI MyProxy where- sing = SMyProxy
− tests/compile-and-dump/Singletons/T297.hs
@@ -1,13 +0,0 @@-module T297 where--import Data.Kind-import Data.Singletons.TH--$(singletons [d|- data MyProxy (a :: Type) = MyProxy-- f MyProxy =- let x = let z :: MyProxy a -- When singled, this `a` should be explicitly quantified- z = MyProxy in z- in x- |])
− tests/compile-and-dump/Singletons/T312.ghc86.template
@@ -1,215 +0,0 @@-Singletons/T312.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class Foo a where- bar :: a -> b -> b- bar _ x = x- baz :: forall b. a -> b -> b- baz- = h- where- h :: forall c. c -> b -> b- h _ x = x |]- ======>- class Foo a where- bar :: a -> b -> b- baz :: forall b. a -> b -> b- bar _ x = x- baz- = h- where- h :: forall c. c -> b -> b- h _ x = x- type BarSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) =- Bar arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (BarSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) BarSym1KindInference) ())- data BarSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- BarSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (BarSym1 arg0123456789876543210) arg) (BarSym2 arg0123456789876543210 arg) =>- BarSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (BarSym1 arg0123456789876543210) arg0123456789876543210 = Bar arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- BarSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 arg0123456789876543210- type instance Apply BarSym0 arg0123456789876543210 = BarSym1 arg0123456789876543210- type BazSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) =- Baz arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings (BazSym1 arg0123456789876543210) where- suppressUnusedWarnings = snd (((,) BazSym1KindInference) ())- data BazSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- BazSym1KindInference :: forall arg0123456789876543210- arg0123456789876543210- arg. SameKind (Apply (BazSym1 arg0123456789876543210) arg) (BazSym2 arg0123456789876543210 arg) =>- BazSym1 arg0123456789876543210 arg0123456789876543210- type instance Apply (BazSym1 arg0123456789876543210) arg0123456789876543210 = Baz arg0123456789876543210 arg0123456789876543210- instance SuppressUnusedWarnings BazSym0 where- suppressUnusedWarnings = snd (((,) BazSym0KindInference) ())- data BazSym0 :: forall a0123456789876543210 b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- BazSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) =>- BazSym0 arg0123456789876543210- type instance Apply BazSym0 arg0123456789876543210 = BazSym1 arg0123456789876543210- type family Bar_0123456789876543210 (a :: a) (a :: b) :: b where- Bar_0123456789876543210 _ x = x- type Bar_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Bar_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Bar_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Bar_0123456789876543210Sym1KindInference) ())- data Bar_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Bar_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Bar_0123456789876543210Sym1 a0123456789876543210) arg) (Bar_0123456789876543210Sym2 a0123456789876543210 arg) =>- Bar_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Bar_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Bar_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Bar_0123456789876543210Sym0KindInference) ())- data Bar_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Bar_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) =>- Bar_0123456789876543210Sym0 a0123456789876543210- type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210- type Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210HSym3KindInference) ())- data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Let0123456789876543210HSym3KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) =>- Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210H a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210HSym2KindInference) ())- data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: forall b0123456789876543210- c0123456789876543210.- (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Let0123456789876543210HSym2KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- a0123456789876543210- arg. SameKind (Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210- type instance Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210HSym1KindInference) ())- data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- where- Let0123456789876543210HSym1KindInference :: forall a_01234567898765432100123456789876543210- a_01234567898765432100123456789876543210- arg. SameKind (Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 arg) =>- Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- type instance Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210HSym0 where- suppressUnusedWarnings- = snd (((,) Let0123456789876543210HSym0KindInference) ())- data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210- where- Let0123456789876543210HSym0KindInference :: forall a_01234567898765432100123456789876543210- arg. SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) =>- Let0123456789876543210HSym0 a_01234567898765432100123456789876543210- type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210- type family Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 (a :: c) (a :: b) :: b where- Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 _ x = x- type family Baz_0123456789876543210 (a :: a) (a :: b) :: b where- Baz_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210- type Baz_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) =- Baz_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (Baz_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) Baz_0123456789876543210Sym1KindInference) ())- data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210.- (~>) b0123456789876543210 b0123456789876543210- where- Baz_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (Baz_0123456789876543210Sym1 a0123456789876543210) arg) (Baz_0123456789876543210Sym2 a0123456789876543210 arg) =>- Baz_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (Baz_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Baz_0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Baz_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Baz_0123456789876543210Sym0KindInference) ())- data Baz_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)- where- Baz_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Baz_0123456789876543210Sym0 arg) (Baz_0123456789876543210Sym1 arg) =>- Baz_0123456789876543210Sym0 a0123456789876543210- type instance Apply Baz_0123456789876543210Sym0 a0123456789876543210 = Baz_0123456789876543210Sym1 a0123456789876543210- class PFoo (a :: GHC.Types.Type) where- type Bar (arg :: a) (arg :: b) :: b- type Baz (arg :: a) (arg :: b) :: b- type Bar a a = Apply (Apply Bar_0123456789876543210Sym0 a) a- type Baz a a = Apply (Apply Baz_0123456789876543210Sym0 a) a- class SFoo a where- sBar ::- forall b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b)- sBaz ::- forall b (t :: a) (t :: b).- Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b)- default sBar ::- forall b (t :: a) (t :: b).- (Apply (Apply BarSym0 t) t :: b)- ~ Apply (Apply Bar_0123456789876543210Sym0 t) t =>- Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b)- default sBaz ::- forall b (t :: a) (t :: b).- (Apply (Apply BazSym0 t) t :: b)- ~ Apply (Apply Baz_0123456789876543210Sym0 t) t =>- Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b)- sBar _ (sX :: Sing x) = sX- sBaz- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- (let- sH ::- forall c (t :: c) (t :: b).- Sing t- -> Sing t- -> Sing (Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) t) t :: b)- sH _ (sX :: Sing x) = sX- in- (singFun2- @(Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210))- sH))- sA_0123456789876543210))- sA_0123456789876543210- instance SFoo a => SingI (BarSym0 :: (~>) a ((~>) b b)) where- sing = (singFun2 @BarSym0) sBar- instance (SFoo a, SingI d) =>- SingI (BarSym1 (d :: a) :: (~>) b b) where- sing = (singFun1 @(BarSym1 (d :: a))) (sBar (sing @d))- instance SFoo a => SingI (BazSym0 :: (~>) a ((~>) b b)) where- sing = (singFun2 @BazSym0) sBaz- instance (SFoo a, SingI d) =>- SingI (BazSym1 (d :: a) :: (~>) b b) where- sing = (singFun1 @(BazSym1 (d :: a))) (sBaz (sing @d))
− tests/compile-and-dump/Singletons/T312.hs
@@ -1,14 +0,0 @@-module T312 where--import Data.Singletons.TH--$(singletons [d|- class Foo a where- bar :: a -> b -> b- bar _ x = x-- baz :: forall b. a -> b -> b- baz = h where- h :: forall c. c -> b -> b- h _ x = x- |])
− tests/compile-and-dump/Singletons/T313.ghc86.template
@@ -1,130 +0,0 @@-Singletons/T313.hs:(0,0)-(0,0): Splicing declarations- promote- [d| type PFoo1 a = Maybe a- type family PFoo2 a- type family PFoo3 a where- PFoo3 a = Maybe a- class PC (a :: Type) where- type PFoo4 a- type PFoo4 a = Maybe a- - type instance PFoo2 a = Maybe a- instance PC a where- type PFoo4 a = Maybe a |]- ======>- type PFoo1 a = Maybe a- type family PFoo2 a- type instance PFoo2 a = Maybe a- type family PFoo3 a where- PFoo3 a = Maybe a- class PC (a :: Type) where- type PFoo4 a- type PFoo4 a = Maybe a- instance PC a where- type PFoo4 a = Maybe a- type PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210- instance SuppressUnusedWarnings PFoo1Sym0 where- suppressUnusedWarnings = snd (((,) PFoo1Sym0KindInference) ())- data PFoo1Sym0 a0123456789876543210- where- PFoo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) =>- PFoo1Sym0 a0123456789876543210- type instance Apply PFoo1Sym0 a0123456789876543210 = PFoo1 a0123456789876543210- type PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210- instance SuppressUnusedWarnings PFoo3Sym0 where- suppressUnusedWarnings = snd (((,) PFoo3Sym0KindInference) ())- data PFoo3Sym0 a0123456789876543210- where- PFoo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) =>- PFoo3Sym0 a0123456789876543210- type instance Apply PFoo3Sym0 a0123456789876543210 = PFoo3 a0123456789876543210- type PFoo2Sym1 (a0123456789876543210 :: Type) =- PFoo2 a0123456789876543210- instance SuppressUnusedWarnings PFoo2Sym0 where- suppressUnusedWarnings = snd (((,) PFoo2Sym0KindInference) ())- data PFoo2Sym0 :: (~>) Type Type- where- PFoo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) =>- PFoo2Sym0 a0123456789876543210- type instance Apply PFoo2Sym0 a0123456789876543210 = PFoo2 a0123456789876543210- type PFoo4Sym1 (a0123456789876543210 :: Type) =- PFoo4 a0123456789876543210- instance SuppressUnusedWarnings PFoo4Sym0 where- suppressUnusedWarnings = snd (((,) PFoo4Sym0KindInference) ())- data PFoo4Sym0 :: (~>) Type Type- where- PFoo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) =>- PFoo4Sym0 a0123456789876543210- type instance Apply PFoo4Sym0 a0123456789876543210 = PFoo4 a0123456789876543210- class PPC (a :: Type)- instance PPC a-Singletons/T313.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| type SFoo1 a = Maybe a- type family SFoo2 a- type family SFoo3 a where- SFoo3 a = Maybe a- class SC (a :: Type) where- type SFoo4 a- type SFoo4 a = Maybe a- - type instance SFoo2 a = Maybe a- instance SC a where- type SFoo4 a = Maybe a |]- ======>- type SFoo1 a = Maybe a- type family SFoo2 a- type instance SFoo2 a = Maybe a- type family SFoo3 a where- SFoo3 a = Maybe a- class SC (a :: Type) where- type SFoo4 a- type SFoo4 a = Maybe a- instance SC a where- type SFoo4 a = Maybe a- type SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210- instance SuppressUnusedWarnings SFoo1Sym0 where- suppressUnusedWarnings = snd (((,) SFoo1Sym0KindInference) ())- data SFoo1Sym0 a0123456789876543210- where- SFoo1Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) =>- SFoo1Sym0 a0123456789876543210- type instance Apply SFoo1Sym0 a0123456789876543210 = SFoo1 a0123456789876543210- type SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210- instance SuppressUnusedWarnings SFoo3Sym0 where- suppressUnusedWarnings = snd (((,) SFoo3Sym0KindInference) ())- data SFoo3Sym0 a0123456789876543210- where- SFoo3Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) =>- SFoo3Sym0 a0123456789876543210- type instance Apply SFoo3Sym0 a0123456789876543210 = SFoo3 a0123456789876543210- type SFoo2Sym1 (a0123456789876543210 :: Type) =- SFoo2 a0123456789876543210- instance SuppressUnusedWarnings SFoo2Sym0 where- suppressUnusedWarnings = snd (((,) SFoo2Sym0KindInference) ())- data SFoo2Sym0 :: (~>) Type Type- where- SFoo2Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) =>- SFoo2Sym0 a0123456789876543210- type instance Apply SFoo2Sym0 a0123456789876543210 = SFoo2 a0123456789876543210- type SFoo4Sym1 (a0123456789876543210 :: Type) =- SFoo4 a0123456789876543210- instance SuppressUnusedWarnings SFoo4Sym0 where- suppressUnusedWarnings = snd (((,) SFoo4Sym0KindInference) ())- data SFoo4Sym0 :: (~>) Type Type- where- SFoo4Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) =>- SFoo4Sym0 a0123456789876543210- type instance Apply SFoo4Sym0 a0123456789876543210 = SFoo4 a0123456789876543210- class PSC (a :: Type)- instance PSC a- class SSC (a :: Type)- instance SSC a
− tests/compile-and-dump/Singletons/T313.hs
@@ -1,38 +0,0 @@-module T313 where--import Data.Kind-import Data.Singletons.TH--$(promote [d|- type PFoo1 a = Maybe a-- type family PFoo2 a- type instance PFoo2 a = Maybe a-- type family PFoo3 a where- PFoo3 a = Maybe a-- class PC (a :: Type) where- type PFoo4 a- type PFoo4 a = Maybe a-- instance PC a where- type PFoo4 a = Maybe a- |])--$(singletons [d|- type SFoo1 a = Maybe a-- type family SFoo2 a- type instance SFoo2 a = Maybe a-- type family SFoo3 a where- SFoo3 a = Maybe a-- class SC (a :: Type) where- type SFoo4 a- type SFoo4 a = Maybe a-- instance SC a where- type SFoo4 a = Maybe a- |])
− tests/compile-and-dump/Singletons/T316.ghc86.template
@@ -1,40 +0,0 @@-Singletons/T316.hs:(0,0)-(0,0): Splicing declarations- promoteOnly- [d| replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a]- replaceAllGTypes f types as = zipWith f as types |]- ======>- type ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a0123456789876543210]) =- ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ReplaceAllGTypesSym2KindInference) ())- data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) :: (~>) [a0123456789876543210] [a0123456789876543210]- where- ReplaceAllGTypesSym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) =>- ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ReplaceAllGTypesSym1KindInference) ())- data ReplaceAllGTypesSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) :: (~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210])- where- ReplaceAllGTypesSym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) =>- ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210- type instance Apply (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where- suppressUnusedWarnings- = snd (((,) ReplaceAllGTypesSym0KindInference) ())- data ReplaceAllGTypesSym0 :: forall a0123456789876543210.- (~>) ((~>) a0123456789876543210 ((~>) Type a0123456789876543210)) ((~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210]))- where- ReplaceAllGTypesSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) =>- ReplaceAllGTypesSym0 a0123456789876543210- type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210- type family ReplaceAllGTypes (a :: (~>) a ((~>) Type a)) (a :: [Type]) (a :: [a]) :: [a] where- ReplaceAllGTypes f types as = Apply (Apply (Apply ZipWithSym0 f) as) types
− tests/compile-and-dump/Singletons/T316.hs
@@ -1,10 +0,0 @@-module T316 where--import Data.Kind-import Data.Singletons.Prelude-import Data.Singletons.TH--$(promoteOnly [d|- replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a]- replaceAllGTypes f types as = zipWith f as types- |])
− tests/compile-and-dump/Singletons/T322.ghc86.template
@@ -1,49 +0,0 @@-Singletons/T322.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| infixr 2 !- - (!) :: Bool -> Bool -> Bool- (!) = (||) |]- ======>- (!) :: Bool -> Bool -> Bool- (!) = (||)- infixr 2 !- type (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) =- (:!) a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where- suppressUnusedWarnings = snd (((,) (:!@#@$$###)) ())- data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool- where- (:!@#@$$###) :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) =>- (!@#@$$) a0123456789876543210 a0123456789876543210- type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (:!) a0123456789876543210 a0123456789876543210- infixr 2 !@#@$$- instance SuppressUnusedWarnings (!@#@$) where- suppressUnusedWarnings = snd (((,) (:!@#@$###)) ())- data (!@#@$) :: (~>) Bool ((~>) Bool Bool)- where- (:!@#@$###) :: forall a0123456789876543210- arg. SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) =>- (!@#@$) a0123456789876543210- type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210- infixr 2 !@#@$- type family (:!) (a :: Bool) (a :: Bool) :: Bool where- (:!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210- infixr 2 :!- infixr 2 %!- (%!) ::- forall (t :: Bool) (t :: Bool).- Sing t -> Sing t -> Sing (Apply (Apply (!@#@$) t) t :: Bool)- (%!)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @(||@#@$)) (%||))) sA_0123456789876543210))- sA_0123456789876543210- instance SingI ((!@#@$) :: (~>) Bool ((~>) Bool Bool)) where- sing = (singFun2 @(!@#@$)) (%!)- instance SingI d =>- SingI ((!@#@$$) (d :: Bool) :: (~>) Bool Bool) where- sing = (singFun1 @((!@#@$$) (d :: Bool))) ((%!) (sing @d))
− tests/compile-and-dump/Singletons/T322.hs
@@ -1,13 +0,0 @@-module T322 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|- (!) :: Bool -> Bool -> Bool- (!) = (||)- infixr 2 !- |])--f1 :: (False && True :! True) :~: True-f1 = Refl
− tests/compile-and-dump/Singletons/T323.ghc86.template
− tests/compile-and-dump/Singletons/T323.hs
@@ -1,7 +0,0 @@-module T323 where--import Data.Singletons.Prelude-import Data.Type.Equality--test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h-test = Refl
− tests/compile-and-dump/Singletons/T33.ghc86.template
@@ -1,36 +0,0 @@-Singletons/T33.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: (Bool, Bool) -> ()- foo ~(_, _) = () |]- ======>- foo :: (Bool, Bool) -> ()- foo ~(_, _) = ()- type FooSym1 (a0123456789876543210 :: (Bool, Bool)) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) (Bool, Bool) ()- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Foo (a :: (Bool, Bool)) :: () where- Foo '(_, _) = Tuple0Sym0- sFoo ::- forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ())- sFoo (STuple2 _ _) = STuple0- instance SingI (FooSym0 :: (~>) (Bool, Bool) ()) where- sing = (singFun1 @FooSym0) sFoo--Singletons/T33.hs:0:0: warning:- Lazy pattern converted into regular pattern in promotion- |-6 | $(singletons [d|- | ^^^^^^^^^^^^^^...--Singletons/T33.hs:0:0: warning:- Lazy pattern converted into regular pattern during singleton generation.- |-6 | $(singletons [d|- | ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/T33.hs
@@ -1,9 +0,0 @@-module Singletons.T33 where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|- foo :: (Bool, Bool) -> ()- foo ~(_, _) = ()- |])
− tests/compile-and-dump/Singletons/T332.ghc86.template
@@ -1,57 +0,0 @@-Singletons/T332.hs:(0,0)-(0,0): Splicing declarations- promote- [d| f :: Foo -> ()- f MkFoo {} = ()- - data Foo = MkFoo |]- ======>- data Foo = MkFoo- f :: Foo -> ()- f MkFoo {} = ()- type FSym1 (a0123456789876543210 :: Foo) = F a0123456789876543210- instance SuppressUnusedWarnings FSym0 where- suppressUnusedWarnings = snd (((,) FSym0KindInference) ())- data FSym0 :: (~>) Foo ()- where- FSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>- FSym0 a0123456789876543210- type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210- type family F (a :: Foo) :: () where- F MkFoo = Tuple0Sym0- type MkFooSym0 = MkFoo-Singletons/T332.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| b :: Bar -> ()- b MkBar {} = ()- - data Bar = MkBar |]- ======>- data Bar = MkBar- b :: Bar -> ()- b MkBar {} = ()- type MkBarSym0 = MkBar- type BSym1 (a0123456789876543210 :: Bar) = B a0123456789876543210- instance SuppressUnusedWarnings BSym0 where- suppressUnusedWarnings = snd (((,) BSym0KindInference) ())- data BSym0 :: (~>) Bar ()- where- BSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BSym0 arg) (BSym1 arg) =>- BSym0 a0123456789876543210- type instance Apply BSym0 a0123456789876543210 = B a0123456789876543210- type family B (a :: Bar) :: () where- B MkBar = Tuple0Sym0- sB :: forall (t :: Bar). Sing t -> Sing (Apply BSym0 t :: ())- sB SMkBar = STuple0- instance SingI (BSym0 :: (~>) Bar ()) where- sing = (singFun1 @BSym0) sB- data instance Sing :: Bar -> GHC.Types.Type- where SMkBar :: Sing MkBar- type SBar = (Sing :: Bar -> GHC.Types.Type)- instance SingKind Bar where- type Demote Bar = Bar- fromSing SMkBar = MkBar- toSing MkBar = SomeSing SMkBar- instance SingI MkBar where- sing = SMkBar
− tests/compile-and-dump/Singletons/T332.hs
@@ -1,17 +0,0 @@-module T332 where--import Data.Singletons.TH--$(promote [d|- data Foo = MkFoo-- f :: Foo -> ()- f MkFoo{} = ()- |])--$(singletons [d|- data Bar = MkBar-- b :: Bar -> ()- b MkBar{} = ()- |])
− tests/compile-and-dump/Singletons/T342.ghc86.template
@@ -1,17 +0,0 @@-Singletons/T342.hs:(0,0)-(0,0): Splicing declarations- do synName <- newName "MyId"- a <- newName "a"- let syn = TySynD synName [PlainTV a] (VarT a)- defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName]- pure $ syn : defuns- ======>- type MyId a = a- type MyIdSym1 a0123456789876543210 = MyId a0123456789876543210- instance SuppressUnusedWarnings MyIdSym0 where- suppressUnusedWarnings = snd (((,) MyIdSym0KindInference) ())- data MyIdSym0 a0123456789876543210- where- MyIdSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) =>- MyIdSym0 a0123456789876543210- type instance Apply MyIdSym0 a0123456789876543210 = MyId a0123456789876543210
− tests/compile-and-dump/Singletons/T342.hs
@@ -1,12 +0,0 @@-module T342 where--import Data.Singletons.TH-import Language.Haskell.TH-import Language.Haskell.TH.Desugar--$(do synName <- newName "MyId"- a <- newName "a"- let syn = TySynD synName [PlainTV a] (VarT a)- defuns <- withLocalDeclarations [syn] $- genDefunSymbols [synName]- pure $ syn:defuns)
− tests/compile-and-dump/Singletons/T353.ghc86.template
@@ -1,104 +0,0 @@-Singletons/T353.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (a :: Proxy (t :: k))- :~:- (y :: Proxy (t :: k))) :: Type where- Symmetry a y _ = y :~: a |]- ======>- type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (:~:) (a :: Proxy (t :: k)) (y :: Proxy (t :: k))) :: Type where- Symmetry a y _ = (:~:) y a- type SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) =- Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210- instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ())- data SymmetrySym2 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type- where- SymmetrySym2KindInference :: forall a0123456789876543210- y0123456789876543210- e0123456789876543210- arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) =>- SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210- type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210- instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where- suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ())- data SymmetrySym1 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: forall (y0123456789876543210 :: Proxy t0123456789876543210).- (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)- where- SymmetrySym1KindInference :: forall a0123456789876543210- y0123456789876543210- arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) =>- SymmetrySym1 a0123456789876543210 y0123456789876543210- type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210- instance SuppressUnusedWarnings SymmetrySym0 where- suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ())- data SymmetrySym0 :: forall k0123456789876543210- (t0123456789876543210 :: k0123456789876543210)- (a0123456789876543210 :: Proxy t0123456789876543210)- (y0123456789876543210 :: Proxy t0123456789876543210).- (~>) (Proxy t0123456789876543210) ((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type))- where- SymmetrySym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) =>- SymmetrySym0 a0123456789876543210- type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210-Singletons/T353.hs:0:0:: Splicing declarations- genDefunSymbols [''Prod]- ======>- type MkProdSym2 (t0123456789876543210 :: f0123456789876543210 p0123456789876543210) (t0123456789876543210 :: g0123456789876543210 p0123456789876543210) =- 'MkProd t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkProdSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkProdSym1KindInference) ())- data MkProdSym1 (t0123456789876543210 :: (f0123456789876543210 :: k0123456789876543210- -> Type) (p0123456789876543210 :: k0123456789876543210)) :: forall (g0123456789876543210 :: k0123456789876543210- -> Type).- (~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210- -> Type) (g0123456789876543210 :: k0123456789876543210- -> Type) (p0123456789876543210 :: k0123456789876543210))- where- MkProdSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkProdSym1 t0123456789876543210) arg) (MkProdSym2 t0123456789876543210 arg) =>- MkProdSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkProdSym1 t0123456789876543210) t0123456789876543210 = 'MkProd t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkProdSym0 where- suppressUnusedWarnings = snd (((,) MkProdSym0KindInference) ())- data MkProdSym0 :: forall k0123456789876543210- (f0123456789876543210 :: k0123456789876543210 -> Type)- (g0123456789876543210 :: k0123456789876543210 -> Type)- (p0123456789876543210 :: k0123456789876543210).- (~>) (f0123456789876543210 p0123456789876543210) ((~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210- -> Type) (g0123456789876543210 :: k0123456789876543210- -> Type) (p0123456789876543210 :: k0123456789876543210)))- where- MkProdSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) =>- MkProdSym0 t0123456789876543210- type instance Apply MkProdSym0 t0123456789876543210 = MkProdSym1 t0123456789876543210-Singletons/T353.hs:0:0:: Splicing declarations- genDefunSymbols [''Foo]- ======>- type MkFooSym2 (t0123456789876543210 :: Proxy a0123456789876543210) (t0123456789876543210 :: Proxy b0123456789876543210) =- 'MkFoo t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (MkFooSym1 t0123456789876543210) where- suppressUnusedWarnings = snd (((,) MkFooSym1KindInference) ())- data MkFooSym1 (t0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) :: forall k0123456789876543210- (b0123456789876543210 :: k0123456789876543210).- (~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210))- where- MkFooSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (MkFooSym1 t0123456789876543210) arg) (MkFooSym2 t0123456789876543210 arg) =>- MkFooSym1 t0123456789876543210 t0123456789876543210- type instance Apply (MkFooSym1 t0123456789876543210) t0123456789876543210 = 'MkFoo t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings MkFooSym0 where- suppressUnusedWarnings = snd (((,) MkFooSym0KindInference) ())- data MkFooSym0 :: forall k0123456789876543210- (a0123456789876543210 :: k0123456789876543210)- k0123456789876543210- (b0123456789876543210 :: k0123456789876543210).- (~>) (Proxy a0123456789876543210) ((~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210)))- where- MkFooSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) =>- MkFooSym0 t0123456789876543210- type instance Apply MkFooSym0 t0123456789876543210 = MkFooSym1 t0123456789876543210
− tests/compile-and-dump/Singletons/T353.hs
@@ -1,17 +0,0 @@-module T353 where--import Data.Kind-import Data.Proxy-import Data.Singletons.TH--$(singletons [d|- type family Symmetry (a :: Proxy t) (y :: Proxy t)- (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where- Symmetry a y _ = y :~: a- |])--data Prod f g p = MkProd (f p) (g p)-$(genDefunSymbols [''Prod])--data Foo a b = MkFoo (Proxy a) (Proxy b)-$(genDefunSymbols [''Foo])
− tests/compile-and-dump/Singletons/T358.ghc86.template
@@ -1,118 +0,0 @@-Singletons/T358.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| class C1 (f :: k -> Type) where- method1 :: f a- class C2 a where- method2a, method2b :: forall b. b -> a- - instance C1 [] where- method1 :: [a]- method1 = []- instance C2 [a] where- method2a _ = []- method2b :: forall b. b -> [a]- method2b _ = [] |]- ======>- class C1 (f :: k -> Type) where- method1 :: f a- instance C1 [] where- method1 :: [a]- method1 = []- class C2 a where- method2a :: forall b. b -> a- method2b :: forall b. b -> a- instance C2 [a] where- method2b :: forall b. b -> [a]- method2a _ = []- method2b _ = []- type Method1Sym0 = Method1- class PC1 (f :: k -> Type) where- type Method1 :: f a- type Method2aSym1 (arg0123456789876543210 :: b0123456789876543210) =- Method2a arg0123456789876543210- instance SuppressUnusedWarnings Method2aSym0 where- suppressUnusedWarnings = snd (((,) Method2aSym0KindInference) ())- data Method2aSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Method2aSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) =>- Method2aSym0 arg0123456789876543210- type instance Apply Method2aSym0 arg0123456789876543210 = Method2a arg0123456789876543210- type Method2bSym1 (arg0123456789876543210 :: b0123456789876543210) =- Method2b arg0123456789876543210- instance SuppressUnusedWarnings Method2bSym0 where- suppressUnusedWarnings = snd (((,) Method2bSym0KindInference) ())- data Method2bSym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) b0123456789876543210 a0123456789876543210- where- Method2bSym0KindInference :: forall arg0123456789876543210- arg. SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) =>- Method2bSym0 arg0123456789876543210- type instance Apply Method2bSym0 arg0123456789876543210 = Method2b arg0123456789876543210- class PC2 (a :: Type) where- type Method2a (arg :: b) :: a- type Method2b (arg :: b) :: a- type family Method1_0123456789876543210 :: [a] where- Method1_0123456789876543210 = '[]- type Method1_0123456789876543210Sym0 = Method1_0123456789876543210- instance PC1 [] where- type Method1 = Method1_0123456789876543210Sym0- type family Method2a_0123456789876543210 (a :: b) :: [a] where- Method2a_0123456789876543210 _ = '[]- type Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) =- Method2a_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Method2a_0123456789876543210Sym0KindInference) ())- data Method2a_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) b0123456789876543210 [a0123456789876543210]- where- Method2a_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Method2a_0123456789876543210Sym0 arg) (Method2a_0123456789876543210Sym1 arg) =>- Method2a_0123456789876543210Sym0 a0123456789876543210- type instance Apply Method2a_0123456789876543210Sym0 a0123456789876543210 = Method2a_0123456789876543210 a0123456789876543210- type family Method2b_0123456789876543210 (a :: b) :: [a] where- Method2b_0123456789876543210 _ = '[]- type Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) =- Method2b_0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) Method2b_0123456789876543210Sym0KindInference) ())- data Method2b_0123456789876543210Sym0 :: forall a0123456789876543210- b0123456789876543210.- (~>) b0123456789876543210 [a0123456789876543210]- where- Method2b_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply Method2b_0123456789876543210Sym0 arg) (Method2b_0123456789876543210Sym1 arg) =>- Method2b_0123456789876543210Sym0 a0123456789876543210- type instance Apply Method2b_0123456789876543210Sym0 a0123456789876543210 = Method2b_0123456789876543210 a0123456789876543210- instance PC2 [a] where- type Method2a a = Apply Method2a_0123456789876543210Sym0 a- type Method2b a = Apply Method2b_0123456789876543210Sym0 a- class SC1 (f :: k -> Type) where- sMethod1 :: forall a. Sing (Method1Sym0 :: f a)- class SC2 a where- sMethod2a ::- forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: a)- sMethod2b ::- forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: a)- instance SC1 [] where- sMethod1 :: forall a. Sing (Method1Sym0 :: [a])- sMethod1 = Data.Singletons.Prelude.Instances.SNil- instance SC2 [a] where- sMethod2a ::- forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: [a])- sMethod2b ::- forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: [a])- sMethod2a _- = Data.Singletons.Prelude.Instances.SNil- sMethod2b _- = Data.Singletons.Prelude.Instances.SNil- instance SC2 a => SingI (Method2aSym0 :: (~>) b a) where- sing = (singFun1 @Method2aSym0) sMethod2a- instance SC2 a => SingI (Method2bSym0 :: (~>) b a) where- sing = (singFun1 @Method2bSym0) sMethod2b
− tests/compile-and-dump/Singletons/T358.hs
@@ -1,24 +0,0 @@-module T358 where--import Data.Kind-import Data.Singletons.TH--$(singletons [d|- class C1 (f :: k -> Type) where- method1 :: f a-- instance C1 [] where- method1 :: [a]- method1 = []-- class C2 a where- method2a, method2b :: forall b. b -> a-- -- Test that variables bound by instance head aren't quantified by the- -- generated InstanceSigs- instance C2 [a] where- method2a _ = []-- method2b :: forall b. b -> [a]- method2b _ = []- |])
− tests/compile-and-dump/Singletons/T371.ghc86.template
@@ -1,233 +0,0 @@-Singletons/T371.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Y (a :: Type)- = Y1 | Y2 (X a)- deriving Show- data X (a :: Type)- = X1 | X2 (Y a)- deriving Show |]- ======>- data X (a :: Type)- = X1 | X2 (Y a)- deriving Show- data Y (a :: Type)- = Y1 | Y2 (X a)- deriving Show- type X1Sym0 = X1- type X2Sym1 (t0123456789876543210 :: Y a0123456789876543210) =- X2 t0123456789876543210- instance SuppressUnusedWarnings X2Sym0 where- suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ())- data X2Sym0 :: forall (a0123456789876543210 :: Type).- (~>) (Y a0123456789876543210) (X (a0123456789876543210 :: Type))- where- X2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) =>- X2Sym0 t0123456789876543210- type instance Apply X2Sym0 t0123456789876543210 = X2 t0123456789876543210- type Y1Sym0 = Y1- type Y2Sym1 (t0123456789876543210 :: X a0123456789876543210) =- Y2 t0123456789876543210- instance SuppressUnusedWarnings Y2Sym0 where- suppressUnusedWarnings = snd (((,) Y2Sym0KindInference) ())- data Y2Sym0 :: forall (a0123456789876543210 :: Type).- (~>) (X a0123456789876543210) (Y (a0123456789876543210 :: Type))- where- Y2Sym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply Y2Sym0 arg) (Y2Sym1 arg) =>- Y2Sym0 t0123456789876543210- type instance Apply Y2Sym0 t0123456789876543210 = Y2 t0123456789876543210- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: X a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ X1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "X1") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (X2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "X2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210.- (~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) GHC.Types.Nat ((~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (X a) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Y a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where- ShowsPrec_0123456789876543210 _ Y1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "Y1") a_0123456789876543210- ShowsPrec_0123456789876543210 p_0123456789876543210 (Y2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210- type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) =- ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ())- data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol- where- ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210- a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ())- data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210.- (~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)- where- ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210- a0123456789876543210- arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) =>- ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210- type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210- instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ())- data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210.- (~>) GHC.Types.Nat ((~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- where- ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>- ShowsPrec_0123456789876543210Sym0 a0123456789876543210- type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210- instance PShow (Y a) where- type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a- data instance Sing :: X a -> Type- where- SX1 :: Sing X1- SX2 :: forall a (n :: Y a). (Sing (n :: Y a)) -> Sing (X2 n)- type SX = (Sing :: X a -> Type)- instance SingKind a => SingKind (X a) where- type Demote (X a) = X (Demote a)- fromSing SX1 = X1- fromSing (SX2 b) = X2 (fromSing b)- toSing X1 = SomeSing SX1- toSing (X2 (b :: Demote (Y a)))- = case toSing b :: SomeSing (Y a) of {- SomeSing c -> SomeSing (SX2 c) }- data instance Sing :: Y a -> Type- where- SY1 :: Sing Y1- SY2 :: forall a (n :: X a). (Sing (n :: X a)) -> Sing (Y2 n)- type SY = (Sing :: Y a -> Type)- instance SingKind a => SingKind (Y a) where- type Demote (Y a) = Y (Demote a)- fromSing SY1 = Y1- fromSing (SY2 b) = Y2 (fromSing b)- toSing Y1 = SomeSing SY1- toSing (Y2 (b :: Demote (X a)))- = case toSing b :: SomeSing (X a) of {- SomeSing c -> SomeSing (SY2 c) }- instance SShow (Y a) => SShow (X a) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: X a) (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> Type) t1) t2) t3)- sShowsPrec- _- SX1- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "X1")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SX2 (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "X2 "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))- sA_0123456789876543210- instance SShow (X a) => SShow (Y a) where- sShowsPrec ::- forall (t1 :: GHC.Types.Nat) (t2 :: Y a) (t3 :: GHC.Types.Symbol).- Sing t1- -> Sing t2- -> Sing t3- -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol))- -> Type) t1) t2) t3)- sShowsPrec- _- SY1- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Y1")))- sA_0123456789876543210- sShowsPrec- (sP_0123456789876543210 :: Sing p_0123456789876543210)- (SY2 (sArg_0123456789876543210 :: Sing arg_0123456789876543210))- (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((applySing- ((applySing ((singFun3 @ShowParenSym0) sShowParen))- ((applySing- ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10)))))- ((applySing- ((applySing ((singFun3 @(.@#@$)) (%.)))- ((applySing ((singFun2 @ShowStringSym0) sShowString))- (sing :: Sing "Y2 "))))- ((applySing- ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec))- (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11))))- sArg_0123456789876543210))))- sA_0123456789876543210- deriving instance Data.Singletons.ShowSing.ShowSing (Y a) =>- Show (Sing (z :: X a))- deriving instance Data.Singletons.ShowSing.ShowSing (X a) =>- Show (Sing (z :: Y a))- instance SingI X1 where- sing = SX1- instance SingI n => SingI (X2 (n :: Y a)) where- sing = SX2 sing- instance SingI (X2Sym0 :: (~>) (Y a) (X (a :: Type))) where- sing = (singFun1 @X2Sym0) SX2- instance SingI (TyCon1 X2 :: (~>) (Y a) (X (a :: Type))) where- sing = (singFun1 @(TyCon1 X2)) SX2- instance SingI Y1 where- sing = SY1- instance SingI n => SingI (Y2 (n :: X a)) where- sing = SY2 sing- instance SingI (Y2Sym0 :: (~>) (X a) (Y (a :: Type))) where- sing = (singFun1 @Y2Sym0) SY2- instance SingI (TyCon1 Y2 :: (~>) (X a) (Y (a :: Type))) where- sing = (singFun1 @(TyCon1 Y2)) SY2
− tests/compile-and-dump/Singletons/T371.hs
@@ -1,16 +0,0 @@-module T371 where--import Data.Kind-import Data.Singletons.TH--$(singletons [d|- data X (a :: Type) = X1 | X2 (Y a) deriving Show- data Y (a :: Type) = Y1 | Y2 (X a) deriving Show- |])--main :: IO ()-main = do- print (sing :: Sing ('[] :: [Bool]))- print (sing :: Sing '[True])- print (sing :: Sing (X1 :: X Bool))- print (sing :: Sing (Y2 X1 :: Y Bool))
− tests/compile-and-dump/Singletons/T54.ghc86.template
@@ -1,53 +0,0 @@-Singletons/T54.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| g :: Bool -> Bool- g e = (case [not] of { [_] -> not }) e |]- ======>- g :: Bool -> Bool- g e = (case [not] of { [_] -> not }) e- type Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 =- Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210- instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where- suppressUnusedWarnings- = snd- (((,)- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)- ())- data Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210- where- Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall e0123456789876543210- arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>- Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210- type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210- type family Let0123456789876543210Scrutinee_0123456789876543210 e where- Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[]- type family Case_0123456789876543210 e t where- Case_0123456789876543210 e '[_] = NotSym0- type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210- instance SuppressUnusedWarnings GSym0 where- suppressUnusedWarnings = snd (((,) GSym0KindInference) ())- data GSym0 :: (~>) Bool Bool- where- GSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply GSym0 arg) (GSym1 arg) =>- GSym0 a0123456789876543210- type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210- type family G (a :: Bool) :: Bool where- G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e- sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool)- sG (sE :: Sing e)- = (applySing- (let- sScrutinee_0123456789876543210 ::- Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)- sScrutinee_0123456789876543210- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((singFun1 @NotSym0) sNot)))- SNil- in (case sScrutinee_0123456789876543210 of {- SCons _ SNil -> (singFun1 @NotSym0) sNot }) ::- Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e))))- sE- instance SingI (GSym0 :: (~>) Bool Bool) where- sing = (singFun1 @GSym0) sG
− tests/compile-and-dump/Singletons/T54.hs
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}--module Singletons.T54 where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|- g :: Bool -> Bool- g e = (case [not] of- [_] -> not) e- |])
− tests/compile-and-dump/Singletons/T78.ghc86.template
@@ -1,32 +0,0 @@-Singletons/T78.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: MaybeBool -> Bool- foo (Just False) = False- foo (Just True) = True- foo Nothing = False |]- ======>- foo :: MaybeBool -> Bool- foo (Just False) = False- foo (Just True) = True- foo Nothing = False- type FooSym1 (a0123456789876543210 :: Maybe Bool) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) (Maybe Bool) Bool- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Foo (a :: Maybe Bool) :: Bool where- Foo ( 'Just 'False) = FalseSym0- Foo ( 'Just 'True) = TrueSym0- Foo 'Nothing = FalseSym0- sFoo ::- forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool)- sFoo (SJust SFalse) = SFalse- sFoo (SJust STrue) = STrue- sFoo SNothing = SFalse- instance SingI (FooSym0 :: (~>) (Maybe Bool) Bool) where- sing = (singFun1 @FooSym0) sFoo
− tests/compile-and-dump/Singletons/T78.hs
@@ -1,13 +0,0 @@-module Singletons.T78 where--import Data.Singletons.TH-import Data.Singletons.Prelude--type MaybeBool = Maybe Bool--$(singletons [d|- foo :: MaybeBool -> Bool- foo (Just False) = False- foo (Just True) = True- foo Nothing = False- |])
− tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template
@@ -1,347 +0,0 @@-Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| data Bool = False | True- data Foo = Bar Bool Bool |]- ======>- data Bool = False | True- data Foo = Bar Bool Bool- type FalseSym0 = False- type TrueSym0 = True- type BarSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) =- Bar t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where- suppressUnusedWarnings- = Data.Tuple.snd (((,) BarSym1KindInference) ())- data BarSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo- where- BarSym1KindInference :: forall t0123456789876543210- t0123456789876543210- arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) =>- BarSym1 t0123456789876543210 t0123456789876543210- type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) Bool ((~>) Bool Foo)- where- BarSym0KindInference :: forall t0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 t0123456789876543210- type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210- data instance Sing :: Bool -> GHC.Types.Type- where- SFalse :: Sing False- STrue :: Sing True- type SBool = (Sing :: Bool -> GHC.Types.Type)- instance SingKind Bool where- type Demote Bool = Bool- fromSing SFalse = False- fromSing STrue = True- toSing False = SomeSing SFalse- toSing True = SomeSing STrue- data instance Sing :: Foo -> GHC.Types.Type- where- SBar :: forall (n :: Bool) (n :: Bool).- (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Bar n n)- type SFoo = (Sing :: Foo -> GHC.Types.Type)- instance SingKind Foo where- type Demote Foo = Foo- fromSing (SBar b b) = (Bar (fromSing b)) (fromSing b)- toSing (Bar (b :: Demote Bool) (b :: Demote Bool))- = case- ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool)- of {- (,) (SomeSing c) (SomeSing c) -> SomeSing ((SBar c) c) }- instance SingI False where- sing = SFalse- instance SingI True where- sing = STrue- instance (SingI n, SingI n) =>- SingI (Bar (n :: Bool) (n :: Bool)) where- sing = (SBar sing) sing- instance SingI (BarSym0 :: (~>) Bool ((~>) Bool Foo)) where- sing = (singFun2 @BarSym0) SBar- instance SingI (TyCon2 Bar :: (~>) Bool ((~>) Bool Foo)) where- sing = (singFun2 @(TyCon2 Bar)) SBar- instance SingI d =>- SingI (BarSym1 (d :: Bool) :: (~>) Bool Foo) where- sing = (singFun1 @(BarSym1 (d :: Bool))) (SBar (sing @d))- instance SingI d =>- SingI (TyCon1 (Bar (d :: Bool)) :: (~>) Bool Foo) where- sing = (singFun1 @(TyCon1 (Bar (d :: Bool)))) (SBar (sing @d))-Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| otherwise :: Bool- otherwise = True- id :: a -> a- id x = x- not :: Bool -> Bool- not True = False- not False = True- false_ = False- f, g :: Bool -> Bool- [f, g] = [not, id]- h, i :: Bool -> Bool- (h, i) = (f, g)- j, k :: Bool- (Bar j k) = Bar True (h False)- l, m :: Bool- [l, m] = [not True, id False] |]- ======>- otherwise :: Bool- otherwise = True- id :: a -> a- id x = x- not :: Bool -> Bool- not True = False- not False = True- false_ = False- f :: Bool -> Bool- g :: Bool -> Bool- [f, g] = [not, id]- h :: Bool -> Bool- i :: Bool -> Bool- (h, i) = (f, g)- j :: Bool- k :: Bool- Bar j k = (Bar True) (h False)- l :: Bool- m :: Bool- [l, m] = [not True, id False]- type family Case_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210,- _] = y_0123456789876543210- type family Case_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 a_0123456789876543210 '[_,- y_0123456789876543210] = y_0123456789876543210- type family Case_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210,- _) = y_0123456789876543210- type family Case_0123456789876543210 a_0123456789876543210 t where- Case_0123456789876543210 a_0123456789876543210 '(_,- y_0123456789876543210) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Bar y_0123456789876543210 _) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 ( 'Bar _ y_0123456789876543210) = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '[y_0123456789876543210,- _] = y_0123456789876543210- type family Case_0123456789876543210 t where- Case_0123456789876543210 '[_,- y_0123456789876543210] = y_0123456789876543210- type False_Sym0 = False_- type NotSym1 (a0123456789876543210 :: Bool) =- Not a0123456789876543210- instance SuppressUnusedWarnings NotSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) NotSym0KindInference) ())- data NotSym0 :: (~>) Bool Bool- where- NotSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) =>- NotSym0 a0123456789876543210- type instance Apply NotSym0 a0123456789876543210 = Not a0123456789876543210- type IdSym1 (a0123456789876543210 :: a0123456789876543210) =- Id a0123456789876543210- instance SuppressUnusedWarnings IdSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) IdSym0KindInference) ())- data IdSym0 :: forall a0123456789876543210.- (~>) a0123456789876543210 a0123456789876543210- where- IdSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) =>- IdSym0 a0123456789876543210- type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210- type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210- instance SuppressUnusedWarnings FSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) FSym0KindInference) ())- data FSym0 :: (~>) Bool Bool- where- FSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>- FSym0 a0123456789876543210- type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210- type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210- instance SuppressUnusedWarnings GSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) GSym0KindInference) ())- data GSym0 :: (~>) Bool Bool- where- GSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply GSym0 arg) (GSym1 arg) =>- GSym0 a0123456789876543210- type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210- type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210- instance SuppressUnusedWarnings HSym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) HSym0KindInference) ())- data HSym0 :: (~>) Bool Bool- where- HSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply HSym0 arg) (HSym1 arg) =>- HSym0 a0123456789876543210- type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210- type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210- instance SuppressUnusedWarnings ISym0 where- suppressUnusedWarnings- = Data.Tuple.snd (((,) ISym0KindInference) ())- data ISym0 :: (~>) Bool Bool- where- ISym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply ISym0 arg) (ISym1 arg) =>- ISym0 a0123456789876543210- type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210- type JSym0 = J- type KSym0 = K- type LSym0 = L- type MSym0 = M- type OtherwiseSym0 = Otherwise- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type X_0123456789876543210Sym0 = X_0123456789876543210- type family False_ where- False_ = FalseSym0- type family Not (a :: Bool) :: Bool where- Not 'True = FalseSym0- Not 'False = TrueSym0- type family Id (a :: a) :: a where- Id x = x- type family F (a :: Bool) :: Bool where- F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210- type family G (a :: Bool) :: Bool where- G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210- type family H (a :: Bool) :: Bool where- H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210- type family I (a :: Bool) :: Bool where- I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210- type family J :: Bool where- J = Case_0123456789876543210 X_0123456789876543210Sym0- type family K :: Bool where- K = Case_0123456789876543210 X_0123456789876543210Sym0- type family L :: Bool where- L = Case_0123456789876543210 X_0123456789876543210Sym0- type family M :: Bool where- M = Case_0123456789876543210 X_0123456789876543210Sym0- type family Otherwise :: Bool where- Otherwise = TrueSym0- type family X_0123456789876543210 where- X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[])- type family X_0123456789876543210 where- X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0- type family X_0123456789876543210 where- X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0)- type family X_0123456789876543210 where- X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[])- sFalse_ :: Sing False_Sym0- sNot ::- forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool)- sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a)- sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool)- sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool)- sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool)- sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool)- sJ :: Sing (JSym0 :: Bool)- sK :: Sing (KSym0 :: Bool)- sL :: Sing (LSym0 :: Bool)- sM :: Sing (MSym0 :: Bool)- sOtherwise :: Sing (OtherwiseSym0 :: Bool)- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sX_0123456789876543210 :: Sing X_0123456789876543210Sym0- sFalse_ = SFalse- sNot STrue = SFalse- sNot SFalse = STrue- sId (sX :: Sing x) = sX- sF (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((case sX_0123456789876543210 of {- SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)- (SCons _ SNil)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)))- sA_0123456789876543210- sG (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((case sX_0123456789876543210 of {- SCons _- (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)))- sA_0123456789876543210- sH (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((case sX_0123456789876543210 of {- STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)))- sA_0123456789876543210- sI (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (applySing- ((case sX_0123456789876543210 of {- STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)))- sA_0123456789876543210- sJ- = (case sX_0123456789876543210 of {- SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool)- sK- = (case sX_0123456789876543210 of {- SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool)- sL- = (case sX_0123456789876543210 of {- SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)- (SCons _ SNil)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool)- sM- = (case sX_0123456789876543210 of {- SCons _- (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil)- -> sY_0123456789876543210 }) ::- Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool)- sOtherwise = STrue- sX_0123456789876543210- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((singFun1 @NotSym0) sNot)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId)))- SNil)- sX_0123456789876543210- = (applySing- ((applySing ((singFun2 @Tuple2Sym0) STuple2))- ((singFun1 @FSym0) sF)))- ((singFun1 @GSym0) sG)- sX_0123456789876543210- = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue))- ((applySing ((singFun1 @HSym0) sH)) SFalse)- sX_0123456789876543210- = (applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @NotSym0) sNot)) STrue)))- ((applySing- ((applySing ((singFun2 @(:@#@$)) SCons))- ((applySing ((singFun1 @IdSym0) sId)) SFalse)))- SNil)- instance SingI (NotSym0 :: (~>) Bool Bool) where- sing = (singFun1 @NotSym0) sNot- instance SingI (IdSym0 :: (~>) a a) where- sing = (singFun1 @IdSym0) sId- instance SingI (FSym0 :: (~>) Bool Bool) where- sing = (singFun1 @FSym0) sF- instance SingI (GSym0 :: (~>) Bool Bool) where- sing = (singFun1 @GSym0) sG- instance SingI (HSym0 :: (~>) Bool Bool) where- sing = (singFun1 @HSym0) sH- instance SingI (ISym0 :: (~>) Bool Bool) where- sing = (singFun1 @ISym0) sI
− tests/compile-and-dump/Singletons/TopLevelPatterns.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}--module Singletons.TopLevelPatterns where--import Data.Singletons-import Data.Singletons.Prelude.List-import Data.Singletons.SuppressUnusedWarnings-import Data.Singletons.TH hiding (STrue, SFalse, TrueSym0, FalseSym0)--$(singletons [d|- data Bool = False | True- data Foo = Bar Bool Bool- |])--$(singletons [d|- otherwise :: Bool- otherwise = True-- id :: a -> a- id x = x-- not :: Bool -> Bool- not True = False- not False = True-- false_ = False-- f,g :: Bool -> Bool- [f,g] = [not, id]-- h,i :: Bool -> Bool- (h,i) = (f, g)-- j,k :: Bool- (Bar j k) = Bar True (h False)-- l,m :: Bool- [l,m] = [not True, id False]- |])
− tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template
− tests/compile-and-dump/Singletons/TypeRepTYPE.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE MagicHash #-}-module TypeRepTYPE where--import Data.Kind (Type)-import Data.Singletons.Decide-import Data.Singletons.Prelude-import Data.Singletons.TypeRepTYPE-import GHC.Exts (Char#, RuntimeRep(..), TYPE, Word#)-import Type.Reflection (Typeable, typeRep)--eqTYPETest1 :: (Type == Type) :~: 'True-eqTYPETest1 = Refl--eqTYPETest2 :: (Type == TYPE 'IntRep) :~: 'False-eqTYPETest2 = Refl--f :: Sing (a :: Type) -> Maybe a-f tr- | Proved Refl <- tr %~ sing @Bool- = Just True- | Proved Refl <- tr %~ sing @Ordering- = Just EQ- | otherwise- = Nothing--data MaybeWordRep (a :: TYPE 'WordRep)- = NothingWordRep- | JustWordRep a--g :: Sing (a :: TYPE 'WordRep) -> MaybeWordRep a-g tr- | Proved Refl <- tr %~ sing @Word#- = JustWordRep 42##- | Proved Refl <- tr %~ sing @Char#- = JustWordRep 'j'#- | otherwise- = NothingWordRep--h :: forall (rep :: RuntimeRep) (a :: TYPE rep). Typeable a => Sing a-h = STypeRep (typeRep @a)
− tests/compile-and-dump/Singletons/Undef.ghc86.template
@@ -1,47 +0,0 @@-Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations- singletons- [d| foo :: Bool -> Bool- foo = undefined- bar :: Bool -> Bool- bar = error "urk" |]- ======>- foo :: Bool -> Bool- foo = undefined- bar :: Bool -> Bool- bar = error "urk"- type BarSym1 (a0123456789876543210 :: Bool) =- Bar a0123456789876543210- instance SuppressUnusedWarnings BarSym0 where- suppressUnusedWarnings = snd (((,) BarSym0KindInference) ())- data BarSym0 :: (~>) Bool Bool- where- BarSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>- BarSym0 a0123456789876543210- type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210- type FooSym1 (a0123456789876543210 :: Bool) =- Foo a0123456789876543210- instance SuppressUnusedWarnings FooSym0 where- suppressUnusedWarnings = snd (((,) FooSym0KindInference) ())- data FooSym0 :: (~>) Bool Bool- where- FooSym0KindInference :: forall a0123456789876543210- arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>- FooSym0 a0123456789876543210- type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210- type family Bar (a :: Bool) :: Bool where- Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210- type family Foo (a :: Bool) :: Bool where- Foo a_0123456789876543210 = Apply UndefinedSym0 a_0123456789876543210- sBar ::- forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool)- sFoo ::- forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool)- sBar (sA_0123456789876543210 :: Sing a_0123456789876543210)- = (sError (sing :: Sing "urk")) sA_0123456789876543210- sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210)- = sUndefined sA_0123456789876543210- instance SingI (BarSym0 :: (~>) Bool Bool) where- sing = (singFun1 @BarSym0) sBar- instance SingI (FooSym0 :: (~>) Bool Bool) where- sing = (singFun1 @FooSym0) sFoo
− tests/compile-and-dump/Singletons/Undef.hs
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-module Singletons.Undef where--import Data.Singletons.TH--$(singletons [d|- foo :: Bool -> Bool- foo = undefined-- bar :: Bool -> Bool- bar = error "urk"- |])
− tests/compile-and-dump/buildGoldenFiles.awk
@@ -1,1 +0,0 @@-/INSERT/{while((getline line < $2) > 0 ){if(line !~ /INSERT/){print line}}close($2);next}1