singletons-base 3.2 → 3.5.1
raw patch · 325 files changed
Files
- CHANGES.md +296/−191
- LICENSE +27/−27
- README.md +31/−31
- Setup.hs +7/−138
- singletons-base.cabal +173/−167
- src/Control/Applicative/Singletons.hs +66/−66
- src/Control/Monad/Fail/Singletons.hs +64/−59
- src/Control/Monad/Singletons.hs +285/−285
- src/Control/Monad/Singletons/Internal.hs +509/−480
- src/Control/Monad/Zip/Singletons.hs +108/−103
- src/Data/Bool/Singletons.hs +114/−114
- src/Data/Either/Singletons.hs +105/−105
- src/Data/Eq/Singletons.hs +121/−121
- src/Data/Foldable/Singletons.hs +686/−662
- src/Data/Function/Singletons.hs +117/−117
- src/Data/Functor/Compose/Singletons.hs +84/−92
- src/Data/Functor/Const/Singletons.hs +101/−146
- src/Data/Functor/Identity/Singletons.hs +107/−107
- src/Data/Functor/Product/Singletons.hs +110/−112
- src/Data/Functor/Singletons.hs +194/−194
- src/Data/Functor/Sum/Singletons.hs +62/−95
- src/Data/List/NonEmpty/Singletons.hs +519/−519
- src/Data/List/Singletons.hs +279/−281
- src/Data/List/Singletons/Internal.hs +641/−641
- src/Data/List/Singletons/Internal/Disambiguation.hs +171/−171
- src/Data/Maybe/Singletons.hs +122/−122
- src/Data/Monoid/Singletons.hs +205/−205
- src/Data/Ord/Singletons.hs +102/−102
- src/Data/Ord/Singletons/Disambiguation.hs +33/−33
- src/Data/Proxy/Singletons.hs +150/−159
- src/Data/Semigroup/Singletons.hs +253/−247
- src/Data/Semigroup/Singletons/Internal/Classes.hs +117/−117
- src/Data/Semigroup/Singletons/Internal/Disambiguation.hs +44/−44
- src/Data/Semigroup/Singletons/Internal/Wrappers.hs +108/−108
- src/Data/Singletons/Base/CustomStar.hs +32/−32
- src/Data/Singletons/Base/Enum.hs +152/−152
- src/Data/Singletons/Base/Instances.hs +40/−40
- src/Data/Singletons/Base/PolyError.hs +28/−28
- src/Data/Singletons/Base/SomeSing.hs +81/−83
- src/Data/Singletons/Base/TH.hs +142/−144
- src/Data/Singletons/Base/TypeError.hs +188/−188
- src/Data/Singletons/Base/TypeRepTYPE.hs +97/−97
- src/Data/Singletons/Base/Util.hs +67/−67
- src/Data/String/Singletons.hs +55/−55
- src/Data/Traversable/Singletons.hs +307/−303
- src/Data/Tuple/Singletons.hs +74/−74
- src/Data/Void/Singletons.hs +46/−46
- src/GHC/Base/Singletons.hs +111/−111
- src/GHC/Num/Singletons.hs +131/−131
- src/GHC/TypeLits/Singletons.hs +259/−260
- src/GHC/TypeLits/Singletons/Internal.hs +288/−288
- src/Prelude/Singletons.hs +420/−421
- src/Text/Show/Singletons.hs +273/−273
- tests/README.md +65/−65
- tests/SingletonsBaseTestSuite.hs +185/−173
- tests/SingletonsBaseTestSuiteUtils.hs +202/−204
- tests/compile-and-dump/GradingClient/Database.golden +3264/−3487
- tests/compile-and-dump/GradingClient/Database.hs +545/−545
- tests/compile-and-dump/GradingClient/Main.golden +169/−169
- tests/compile-and-dump/GradingClient/Main.hs +52/−52
- tests/compile-and-dump/InsertionSort/InsertionSortImp.golden +192/−224
- tests/compile-and-dump/InsertionSort/InsertionSortImp.hs +199/−199
- tests/compile-and-dump/Promote/Constructors.golden +73/−73
- tests/compile-and-dump/Promote/Constructors.hs +12/−12
- tests/compile-and-dump/Promote/GenDefunSymbols.golden +63/−63
- tests/compile-and-dump/Promote/GenDefunSymbols.hs +16/−16
- tests/compile-and-dump/Promote/Newtypes.golden +52/−73
- tests/compile-and-dump/Promote/Newtypes.hs +9/−9
- tests/compile-and-dump/Promote/Pragmas.golden +15/−15
- tests/compile-and-dump/Promote/Pragmas.hs +10/−10
- tests/compile-and-dump/Promote/Prelude.golden +21/−21
- tests/compile-and-dump/Promote/Prelude.hs +132/−132
- tests/compile-and-dump/Promote/T180.golden +59/−59
- tests/compile-and-dump/Promote/T180.hs +10/−10
- tests/compile-and-dump/Promote/T361.golden +27/−27
- tests/compile-and-dump/Promote/T361.hs +11/−11
- tests/compile-and-dump/Promote/T601a.golden +73/−0
- tests/compile-and-dump/Promote/T601a.hs +14/−0
- tests/compile-and-dump/Promote/T605.golden +39/−0
- tests/compile-and-dump/Promote/T605.hs +11/−0
- tests/compile-and-dump/Promote/T613.golden +31/−0
- tests/compile-and-dump/Promote/T613.hs +12/−0
- tests/compile-and-dump/Singletons/AsPattern.golden +320/−405
- tests/compile-and-dump/Singletons/AsPattern.hs +30/−30
- tests/compile-and-dump/Singletons/BadBoundedDeriving.golden +6/−6
- tests/compile-and-dump/Singletons/BadBoundedDeriving.hs +7/−7
- tests/compile-and-dump/Singletons/BadEnumDeriving.golden +6/−6
- tests/compile-and-dump/Singletons/BadEnumDeriving.hs +8/−8
- tests/compile-and-dump/Singletons/BoundedDeriving.golden +246/−291
- tests/compile-and-dump/Singletons/BoundedDeriving.hs +52/−52
- tests/compile-and-dump/Singletons/BoxUnBox.golden +56/−56
- tests/compile-and-dump/Singletons/BoxUnBox.hs +9/−9
- tests/compile-and-dump/Singletons/CaseExpressions.golden +289/−325
- tests/compile-and-dump/Singletons/CaseExpressions.hs +64/−64
- tests/compile-and-dump/Singletons/Classes.golden +411/−616
- tests/compile-and-dump/Singletons/Classes.hs +97/−97
- tests/compile-and-dump/Singletons/Classes2.golden +66/−94
- tests/compile-and-dump/Singletons/Classes2.hs +21/−21
- tests/compile-and-dump/Singletons/Contains.golden +51/−53
- tests/compile-and-dump/Singletons/Contains.hs +12/−12
- tests/compile-and-dump/Singletons/DataValues.golden +163/−203
- tests/compile-and-dump/Singletons/DataValues.hs +19/−19
- tests/compile-and-dump/Singletons/Empty.golden +10/−10
- tests/compile-and-dump/Singletons/Empty.hs +7/−7
- tests/compile-and-dump/Singletons/EmptyShowDeriving.golden +46/−73
- tests/compile-and-dump/Singletons/EmptyShowDeriving.hs +7/−7
- tests/compile-and-dump/Singletons/EnumDeriving.golden +214/−223
- tests/compile-and-dump/Singletons/EnumDeriving.hs +11/−11
- tests/compile-and-dump/Singletons/EqInstances.golden +36/−88
- tests/compile-and-dump/Singletons/EqInstances.hs +8/−8
- tests/compile-and-dump/Singletons/Error.golden +31/−30
- tests/compile-and-dump/Singletons/Error.hs +11/−11
- tests/compile-and-dump/Singletons/Fixity.golden +93/−96
- tests/compile-and-dump/Singletons/Fixity.hs +16/−16
- tests/compile-and-dump/Singletons/FunDeps.golden +74/−106
- tests/compile-and-dump/Singletons/FunDeps.hs +21/−21
- tests/compile-and-dump/Singletons/FunctorLikeDeriving.golden +681/−1385
- tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs +16/−16
- tests/compile-and-dump/Singletons/HigherOrder.golden +495/−514
- tests/compile-and-dump/Singletons/HigherOrder.hs +55/−55
- tests/compile-and-dump/Singletons/LambdaCase.golden +189/−250
- tests/compile-and-dump/Singletons/LambdaCase.hs +38/−38
- tests/compile-and-dump/Singletons/Lambdas.golden +566/−787
- tests/compile-and-dump/Singletons/Lambdas.hs +92/−92
- tests/compile-and-dump/Singletons/LambdasComprehensive.golden +83/−84
- tests/compile-and-dump/Singletons/LambdasComprehensive.hs +27/−27
- tests/compile-and-dump/Singletons/LetStatements.golden +830/−1003
- tests/compile-and-dump/Singletons/LetStatements.hs +192/−192
- tests/compile-and-dump/Singletons/Maybe.golden +126/−186
- tests/compile-and-dump/Singletons/Maybe.hs +7/−7
- tests/compile-and-dump/Singletons/Nat.golden +235/−321
- tests/compile-and-dump/Singletons/Nat.hs +18/−18
- tests/compile-and-dump/Singletons/NatSymbolReflexive.hs +11/−11
- tests/compile-and-dump/Singletons/Natural.golden +80/−80
- tests/compile-and-dump/Singletons/Natural.hs +13/−13
- tests/compile-and-dump/Singletons/NegativeLiterals.golden +21/−21
- tests/compile-and-dump/Singletons/NegativeLiterals.hs +11/−11
- tests/compile-and-dump/Singletons/Operators.golden +137/−139
- tests/compile-and-dump/Singletons/Operators.hs +19/−19
- tests/compile-and-dump/Singletons/OrdDeriving.golden +1373/−1498
- tests/compile-and-dump/Singletons/OrdDeriving.hs +57/−57
- tests/compile-and-dump/Singletons/OverloadedStrings.golden +40/−41
- tests/compile-and-dump/Singletons/OverloadedStrings.hs +14/−14
- tests/compile-and-dump/Singletons/PatternMatching.golden +626/−600
- tests/compile-and-dump/Singletons/PatternMatching.hs +51/−51
- tests/compile-and-dump/Singletons/PolyKinds.golden +27/−27
- tests/compile-and-dump/Singletons/PolyKinds.hs +8/−8
- tests/compile-and-dump/Singletons/PolyKindsApp.golden +16/−15
- tests/compile-and-dump/Singletons/PolyKindsApp.hs +12/−12
- tests/compile-and-dump/Singletons/Records.golden +87/−89
- tests/compile-and-dump/Singletons/Records.hs +28/−28
- tests/compile-and-dump/Singletons/ReturnFunc.golden +105/−109
- tests/compile-and-dump/Singletons/ReturnFunc.hs +22/−22
- tests/compile-and-dump/Singletons/Sections.golden +146/−148
- tests/compile-and-dump/Singletons/Sections.hs +39/−39
- tests/compile-and-dump/Singletons/ShowDeriving.golden +522/−649
- tests/compile-and-dump/Singletons/ShowDeriving.hs +41/−41
- tests/compile-and-dump/Singletons/StandaloneDeriving.golden +361/−553
- tests/compile-and-dump/Singletons/StandaloneDeriving.hs +30/−30
- tests/compile-and-dump/Singletons/Star.golden +415/−507
- tests/compile-and-dump/Singletons/Star.hs +13/−13
- tests/compile-and-dump/Singletons/T124.golden +36/−37
- tests/compile-and-dump/Singletons/T124.hs +13/−13
- tests/compile-and-dump/Singletons/T136.golden +157/−186
- tests/compile-and-dump/Singletons/T136.hs +27/−27
- tests/compile-and-dump/Singletons/T136b.golden +39/−55
- tests/compile-and-dump/Singletons/T136b.hs +14/−14
- tests/compile-and-dump/Singletons/T145.golden +41/−42
- tests/compile-and-dump/Singletons/T145.hs +9/−9
- tests/compile-and-dump/Singletons/T150.golden +424/−417
- tests/compile-and-dump/Singletons/T150.hs +53/−53
- tests/compile-and-dump/Singletons/T153.hs +10/−10
- tests/compile-and-dump/Singletons/T157.hs +6/−6
- tests/compile-and-dump/Singletons/T159.golden +267/−267
- tests/compile-and-dump/Singletons/T159.hs +27/−27
- tests/compile-and-dump/Singletons/T160.golden +61/−70
- tests/compile-and-dump/Singletons/T160.hs +13/−13
- tests/compile-and-dump/Singletons/T163.golden +51/−51
- tests/compile-and-dump/Singletons/T163.hs +5/−5
- tests/compile-and-dump/Singletons/T166.golden +128/−154
- tests/compile-and-dump/Singletons/T166.hs +12/−12
- tests/compile-and-dump/Singletons/T167.golden +134/−199
- tests/compile-and-dump/Singletons/T167.hs +16/−16
- tests/compile-and-dump/Singletons/T172.golden +45/−46
- tests/compile-and-dump/Singletons/T172.hs +10/−10
- tests/compile-and-dump/Singletons/T175.golden +52/−55
- tests/compile-and-dump/Singletons/T175.hs +18/−18
- tests/compile-and-dump/Singletons/T176.golden +157/−175
- tests/compile-and-dump/Singletons/T176.hs +21/−21
- tests/compile-and-dump/Singletons/T178.golden +172/−259
- tests/compile-and-dump/Singletons/T178.hs +15/−15
- tests/compile-and-dump/Singletons/T183.golden +480/−532
- tests/compile-and-dump/Singletons/T183.hs +65/−65
- tests/compile-and-dump/Singletons/T184.golden +321/−476
- tests/compile-and-dump/Singletons/T184.hs +27/−27
- tests/compile-and-dump/Singletons/T187.golden +44/−93
- tests/compile-and-dump/Singletons/T187.hs +8/−8
- tests/compile-and-dump/Singletons/T190.golden +122/−233
- tests/compile-and-dump/Singletons/T190.hs +5/−5
- tests/compile-and-dump/Singletons/T197.golden +48/−49
- tests/compile-and-dump/Singletons/T197.hs +10/−10
- tests/compile-and-dump/Singletons/T197b.golden +105/−105
- tests/compile-and-dump/Singletons/T197b.hs +10/−10
- tests/compile-and-dump/Singletons/T200.golden +210/−220
- tests/compile-and-dump/Singletons/T200.hs +15/−15
- tests/compile-and-dump/Singletons/T204.golden +106/−106
- tests/compile-and-dump/Singletons/T204.hs +17/−17
- tests/compile-and-dump/Singletons/T206.hs +5/−5
- tests/compile-and-dump/Singletons/T209.golden +87/−90
- tests/compile-and-dump/Singletons/T209.hs +16/−17
- tests/compile-and-dump/Singletons/T216.golden +42/−42
- tests/compile-and-dump/Singletons/T216.hs +12/−12
- tests/compile-and-dump/Singletons/T226.golden +6/−6
- tests/compile-and-dump/Singletons/T226.hs +5/−5
- tests/compile-and-dump/Singletons/T229.golden +26/−27
- tests/compile-and-dump/Singletons/T229.hs +6/−6
- tests/compile-and-dump/Singletons/T249.golden +93/−90
- tests/compile-and-dump/Singletons/T249.hs +12/−12
- tests/compile-and-dump/Singletons/T271.golden +182/−287
- tests/compile-and-dump/Singletons/T271.hs +13/−13
- tests/compile-and-dump/Singletons/T287.golden +72/−118
- tests/compile-and-dump/Singletons/T287.hs +11/−11
- tests/compile-and-dump/Singletons/T29.golden +117/−121
- tests/compile-and-dump/Singletons/T29.hs +44/−44
- tests/compile-and-dump/Singletons/T296.golden +69/−74
- tests/compile-and-dump/Singletons/T296.hs +14/−14
- tests/compile-and-dump/Singletons/T297.golden +66/−67
- tests/compile-and-dump/Singletons/T297.hs +13/−13
- tests/compile-and-dump/Singletons/T312.golden +138/−199
- tests/compile-and-dump/Singletons/T312.hs +14/−14
- tests/compile-and-dump/Singletons/T313.golden +126/−126
- tests/compile-and-dump/Singletons/T313.hs +38/−38
- tests/compile-and-dump/Singletons/T316.golden +42/−42
- tests/compile-and-dump/Singletons/T316.hs +10/−10
- tests/compile-and-dump/Singletons/T322.golden +53/−54
- tests/compile-and-dump/Singletons/T322.hs +13/−13
- tests/compile-and-dump/Singletons/T323.hs +7/−7
- tests/compile-and-dump/Singletons/T326.golden +72/−73
- tests/compile-and-dump/Singletons/T326.hs +23/−23
- tests/compile-and-dump/Singletons/T33.golden +40/−40
- tests/compile-and-dump/Singletons/T33.hs +9/−9
- tests/compile-and-dump/Singletons/T332.golden +66/−67
- tests/compile-and-dump/Singletons/T332.hs +17/−17
- tests/compile-and-dump/Singletons/T342.golden +18/−18
- tests/compile-and-dump/Singletons/T342.hs +13/−13
- tests/compile-and-dump/Singletons/T353.golden +95/−99
- tests/compile-and-dump/Singletons/T353.hs +17/−17
- tests/compile-and-dump/Singletons/T358.golden +87/−119
- tests/compile-and-dump/Singletons/T358.hs +24/−24
- tests/compile-and-dump/Singletons/T367.golden +40/−41
- tests/compile-and-dump/Singletons/T367.hs +12/−12
- tests/compile-and-dump/Singletons/T371.golden +169/−247
- tests/compile-and-dump/Singletons/T371.hs +16/−16
- tests/compile-and-dump/Singletons/T376.golden +44/−44
- tests/compile-and-dump/Singletons/T376.hs +8/−8
- tests/compile-and-dump/Singletons/T378a.golden +90/−90
- tests/compile-and-dump/Singletons/T378a.hs +64/−64
- tests/compile-and-dump/Singletons/T378b.golden +117/−127
- tests/compile-and-dump/Singletons/T378b.hs +40/−40
- tests/compile-and-dump/Singletons/T401.golden +13/−13
- tests/compile-and-dump/Singletons/T401.hs +8/−8
- tests/compile-and-dump/Singletons/T401b.golden +13/−13
- tests/compile-and-dump/Singletons/T401b.hs +8/−8
- tests/compile-and-dump/Singletons/T402.golden +13/−13
- tests/compile-and-dump/Singletons/T402.hs +7/−7
- tests/compile-and-dump/Singletons/T410.golden +40/−61
- tests/compile-and-dump/Singletons/T410.hs +12/−12
- tests/compile-and-dump/Singletons/T412.golden +381/−399
- tests/compile-and-dump/Singletons/T412.hs +33/−33
- tests/compile-and-dump/Singletons/T414.golden +77/−77
- tests/compile-and-dump/Singletons/T414.hs +16/−16
- tests/compile-and-dump/Singletons/T433.golden +285/−0
- tests/compile-and-dump/Singletons/T433.hs +72/−0
- tests/compile-and-dump/Singletons/T443.golden +126/−127
- tests/compile-and-dump/Singletons/T443.hs +14/−14
- tests/compile-and-dump/Singletons/T445.golden +66/−74
- tests/compile-and-dump/Singletons/T445.hs +26/−26
- tests/compile-and-dump/Singletons/T450.golden +210/−212
- tests/compile-and-dump/Singletons/T450.hs +53/−53
- tests/compile-and-dump/Singletons/T453.golden +19/−19
- tests/compile-and-dump/Singletons/T453.hs +15/−15
- tests/compile-and-dump/Singletons/T470.golden +98/−96
- tests/compile-and-dump/Singletons/T470.hs +24/−24
- tests/compile-and-dump/Singletons/T480.golden +14/−14
- tests/compile-and-dump/Singletons/T480.hs +8/−8
- tests/compile-and-dump/Singletons/T487.golden +73/−74
- tests/compile-and-dump/Singletons/T487.hs +40/−40
- tests/compile-and-dump/Singletons/T489.golden +59/−61
- tests/compile-and-dump/Singletons/T489.hs +14/−14
- tests/compile-and-dump/Singletons/T492.hs +25/−25
- tests/compile-and-dump/Singletons/T511.golden +13/−13
- tests/compile-and-dump/Singletons/T511.hs +9/−9
- tests/compile-and-dump/Singletons/T536.golden +101/−97
- tests/compile-and-dump/Singletons/T536.hs +41/−41
- tests/compile-and-dump/Singletons/T54.golden +46/−57
- tests/compile-and-dump/Singletons/T54.hs +12/−12
- tests/compile-and-dump/Singletons/T555.golden +110/−203
- tests/compile-and-dump/Singletons/T555.hs +15/−15
- tests/compile-and-dump/Singletons/T559.golden +11/−11
- tests/compile-and-dump/Singletons/T559.hs +6/−6
- tests/compile-and-dump/Singletons/T563.golden +70/−0
- tests/compile-and-dump/Singletons/T563.hs +16/−0
- tests/compile-and-dump/Singletons/T565.golden +16/−0
- tests/compile-and-dump/Singletons/T565.hs +8/−0
- tests/compile-and-dump/Singletons/T567.golden +61/−0
- tests/compile-and-dump/Singletons/T567.hs +21/−0
- tests/compile-and-dump/Singletons/T571.golden +65/−0
- tests/compile-and-dump/Singletons/T571.hs +13/−0
- tests/compile-and-dump/Singletons/T581.golden +243/−0
- tests/compile-and-dump/Singletons/T581.hs +36/−0
- tests/compile-and-dump/Singletons/T582.golden +150/−0
- tests/compile-and-dump/Singletons/T582.hs +21/−0
- tests/compile-and-dump/Singletons/T585.golden +40/−0
- tests/compile-and-dump/Singletons/T585.hs +8/−0
- tests/compile-and-dump/Singletons/T78.golden +34/−35
- tests/compile-and-dump/Singletons/T78.hs +13/−13
- tests/compile-and-dump/Singletons/T89.golden +59/−79
- tests/compile-and-dump/Singletons/T89.hs +6/−6
- tests/compile-and-dump/Singletons/TopLevelPatterns.golden +500/−402
- tests/compile-and-dump/Singletons/TopLevelPatterns.hs +37/−37
- tests/compile-and-dump/Singletons/TypeAbstractions.golden +347/−0
- tests/compile-and-dump/Singletons/TypeAbstractions.hs +46/−0
- tests/compile-and-dump/Singletons/TypeRepTYPE.hs +41/−41
- tests/compile-and-dump/Singletons/Undef.golden +53/−53
- tests/compile-and-dump/Singletons/Undef.hs +12/−12
CHANGES.md view
@@ -1,191 +1,296 @@-Changelog for the `singletons-base` project -=========================================== - -3.2 [2023.03.12] ----------------- -* Require building with GHC 9.6. -* The kinds of the promoted `Error` and `ErrorWithoutStackTrace` functions have - been monomorphized to `Symbol`. A previous release generalized the kinds of - these arguments to allow passing arguments besides `Symbol`s, but this change - introduces ambiguity in derived code when `OverloadedString`s is enabled. - See [#89](https://github.com/goldfirere/singletons/issues/89) for the full - story. - - If you were relying on the previous, kind-polymorphic behavior of `Error`, you - can instead use the new `Data.Singletons.Base.PolyError` module that provides - `PolyError`, a version of `Error` with a kind-polymorphic argument. -* `Data.Ord.Singletons` and `Data.Singletons.Base.TH` no longer define a - `thenCmp :: Ordering -> Ordering -> Ordering` function, as this is not - something that has ever existed in `base`. The existence of a `thenCmp` - function was solely motivated by the code generated by derived `Ord` - instances, but `singletons-base` now uses `(<>) @Ordering` instead. -* `GHC.TypeLits.Singletons` now re-exports the `SChar`, `SNat`, and `SSymbol` - singleton types offered by `GHC.TypeLits` in `base-4.18.0.0` rather than - defining its own versions. The versions of `SChar`, `SNat`, and `SSymbol` - offered by `GHC.TypeLits` are nearly identical, minus some minor cosmetic - changes (e.g., `GHC.TypeLits` defines pattern synonyms for `SNat` _et a._ - instead of data constructors). -* `GHC.TypeLits.Singletons` now re-exports the `SSymbol` pattern synonym - from `GHC.TypeLits`. `GHC.TypeLits.Singletons` also continues to export `SSym` - for backwards compatibility. -* `Prelude.Singletons` now re-exports `LiftA2` and `sLiftA2`, mirroring the - fact that `Prelude` now re-exports `liftA2` in `base-4.18.0.0`. -* Provide `TestEquality` and `TestCoercion` instances for `SNat, `SSymbol`, and - `SChar`. - -3.1.1 [2022.08.23] ------------------- -* Require building with GHC 9.4. - -3.1 [2021.10.30] ----------------- -* Require building with GHC 9.2. -* `singletons-base` now supports type-level `Char`s, a feature added in - GHC 9.2. In particular: - - * Promoting and singling character literal expressions (e.g., `f = 'a'`) is - now supported. Promoting (but not singling) character patterns - (e.g., `g 'a' = ()`) is also supported. - * `GHC.TypeLits.Singletons` now offers singled versions of the `ConsSymbol`, - `UnconsSymbol`, `CharToNat`, and `NatToChar` type families that were - introduced to `GHC.TypeLits` in GHC 9.2. - * `Text.Show.Singletons` now makes use of type-level `Char`s, a feature added - in GHC 9.2. As a result, there is no longer any need for the `SChar` type - synonym, so it has been removed. - * The `PShow` and `SShow` instances for `Symbol` now display escape characters - properly rather than returning the input `Symbol` unchanged. - -* In GHC 9.2, `Nat` is now a synonym for `Natural`. As a result, the bogus - `Num`, `Eq`, `Ord`, `Enum`, and `Show` instances for `Nat` in - `GHC.TypeLits.Singletons` have been removed, as they have replaced by the - corresponding instances for `Natural`. -* Add `Data.Functor.{Compose,Product,Sum}.Singletons`. -* The types of various entities in `Data.Functor.Const.Singletons` and - `Data.Proxy.Singletons` have been tweaked slightly such that their - specificities match their term-level counterparts: - - ```diff - -SConst :: forall {k} {a} {b :: k} (x :: a). Sing x -> Sing ('Const @a @b x) - +SConst :: forall {k} a (b :: k) (x :: a). Sing x -> Sing ('Const @a @b x) - - -type ConstSym0 :: forall k a (b :: k). a ~> Const a b - +type ConstSym0 :: forall {k} a (b :: k). a ~> Const a b - - -type ConstSym1 :: forall k a (b :: k). a -> Const a b - +type ConstSym1 :: forall {k} a (b :: k). a -> Const a b - - -type ProxySym0 :: forall k (t :: k). Proxy t - +type ProxySym0 :: forall {k} (t :: k). Proxy t - ``` -* Define instances of `SingI1` and `SingI2` when possible. - -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` and `singletons-th` for changes - specific to those libraries. For more information on this split, see the - [relevant GitHub discussion](https://github.com/goldfirere/singletons/issues/420). -* Require building with GHC 9.0. -* The modules in `singletons-base` have been renamed to better reflect the - modules from `base` from which they take inspiration. In particular, the - following module renamings have been applied: - - * `Data.Singletons.CustomStar` -> `Data.Singletons.Base.CustomStar` - * `Data.Singletons.Prelude` -> `Prelude.Singletons` - * `Data.Singletons.Prelude.Applicative` -> `Control.Applicative.Singletons` - * `Data.Singletons.Prelude.Bool` -> `Data.Bool.Singletons` - * `Data.Singletons.Prelude.Const` -> `Data.Functor.Const.Singletons` - * `Data.Singletons.Prelude.Either` -> `Data.Either.Singletons` - * `Data.Singletons.Prelude.Enum` -> `Data.Singletons.Base.Enum` - * `Data.Singletons.Prelude.Eq` -> `Data.Eq.Singletons` - * `Data.Singletons.Prelude.Foldable` -> `Data.Foldable.Singletons` - * `Data.Singletons.Prelude.Function` -> `Data.Function.Singletons` - * `Data.Singletons.Prelude.Functor` -> `Data.Functor.Const.Singletons` - * `Data.Singletons.Prelude.Identity` -> `Data.Functor.Identity.Singletons` - * `Data.Singletons.Prelude.IsString` -> `Data.String.Singletons` - * `Data.Singletons.Prelude.Ord` -> `Data.Ord.Singletons` - * `Data.Singletons.Prelude.List` -> `Data.List.Singletons` - * `Data.Singletons.Prelude.List.NonEmpty` -> `Data.List.NonEmpty.Singletons` - * `Data.Singletons.Prelude.Maybe` -> `Data.Maybe.Singletons` - * `Data.Singletons.Prelude.Monad` -> `Control.Monad.Singletons` - * `Data.Singletons.Prelude.Monad.Fail` -> `Control.Monad.Fail.Singletons` - * `Data.Singletons.Prelude.Monad.Zip` -> `Control.Monad.Zip.Singletons` - * `Data.Singletons.Prelude.Monoid` -> `Data.Monoid.Singletons` - * `Data.Singletons.Prelude.Proxy` -> `Data.Proxy.Singletons` - * `Data.Singletons.Prelude.Semigroup` -> `Data.Semigroup.Singletons` - * `Data.Singletons.Prelude.Show` -> `Data.Show.Singletons` - * `Data.Singletons.Prelude.Traversable` -> `Data.Traversable.Singletons` - * `Data.Singletons.Prelude.Tuple` -> `Data.Tuple.Singletons` - * `Data.Singletons.Prelude.Void` -> `Data.Void.Singletons` - * `Data.Singletons.TH` -> `Data.Singletons.Base.TH` - * `Data.Singletons.TypeError` -> `Data.Singletons.Base.TypeError` - * `Data.Singletons.TypeLits` -> `GHC.TypeLits.Singletons` - * `Data.Singletons.TypeRepTYPE` -> `Data.Singletons.Base.TypeRepTYPE` - - Note that modules that do not correspond to any particular module in `base` - now have the prefix `Data.Singletons.Base.*`. This includes - `Data.Singletons.Base.Enum`, a special module that exists to provide a - home for the `Succ` and `Pred` promoted type families that is separate from - `Prelude.Singletons` (which exports everything from `PEnum` _except_ `Succ` - and `Pred`). This is done in an effort to make importing `Prelude.Singletons` - less likely to induce name clashes with code that works over unary natural - numbers, which often use the names "`Succ`" and "`Pred`". -* An effort has been made to make the API of `Prelude.Singletons` more closely - mirror that of the `Prelude` in `base`. As a result, `Prelude.Singletons` now - exports some different functions than it used to. In particular, it now - exports the following: - - * `Until`/`sUntil`/`UntilSym{N}` - * `type (++@#@$$$)` - * `type (.@#@$$$$)` - * `FlipSym3` - * `type (!!)`/`(%!!)`/`type (!!@#@{$})` - * `Length`/`sLength`/`LengthSym{N}` - * `DropWhile`/`sDropWhile` - * `LookupSym{N}` - * `Unzip3Sym{N}` - - `Prelude.Singletons` also used to export some things that were _not_ exported - by the `Prelude`. Accordingly, these exports have been removed from - `Prelude.Singletons`. They are: - - * `(^)`/`(%^)`/`type (^@#@{$})`. Although the `Prelude` does define a - function named `(^)`, it is more general than the one defined in - `singletons-base`, which only works on `Nat`s. Import - `GHC.TypeLits.Singletons` if you wish to use the `Nat`-specific versions. - * `DefaultEq`, which has no counterpart in the `Prelude`. - Import `Data.Eq.Singletons` if you wish to use this. - * `bool_`, which has no counterpart in the `Prelude`. - Import `Data.Bool.Singletons` if you wish to use this. -* Two previously public-facing modules—`Data.Singletons.Prelude.Base` and - `Data.Singletons.Prelude.Num`—have been turned into internal modules. The - contents of these modules are re-exported from `Prelude.Singletons`, so that - can be used instead. -* Due to the `singletons` package split, the `Eq`, `Ord`, etc. instances for - `SomeSing` are no longer provided in the `Data.Singletons` module in the - `singletons` library. Instead, they are now provided in a new - `Data.Singletons.Base.SomeSing` module, which defines `Eq`, `Ord`, etc. - instances for `SomeSing` as orphans. -* The `PEq` class no longer uses `DefaultEq` as its default implementation for - `(==)`. `DefaultEq`, despite its name, is actually not a suitable - implementation for `(==)` for a good majority of singleton types - (see the discussion in - [this GitHub issue](https://github.com/goldfirere/singletons/issues/457) - for more information). `(==)`'s default is now defined in terms of `(/=)`, - just like its term-level counterpart in the `Eq` class. -* Since `base-4.15.0.0` now deprecates `Data.Singletons.Option` (in - anticipation of its removal in a future version of `base`), this library no - longer offers a singleton type for `Option`. Accordingly, the `option_` - function has also been removed. +Changelog for the `singletons-base` project+===========================================++3.5.1 [2026.01.10]+------------------+* Require building with GHC 9.14.++3.5 [2024.12.11]+----------------+* Require building with GHC 9.12.+* Remove the use of a custom `Setup.hs` script. This script has now been+ replaced with a [`cabal` code+ generator](https://cabal.readthedocs.io/en/stable/cabal-package-description-file.html#pkg-field-test-suite-code-generators)+ As such, `singletons-base` now requires the use of `Cabal-3.8` or later in+ order to build.+* The types of `sError`, `sErrorWithoutStackTrace`, and `sUndefined` are now+ less polymorphic than they were before:++ ```diff+ -sError :: forall a (str :: Symbol). HasCallStack => Sing str -> a+ +sError :: forall a (str :: Symbol). HasCallStack => Sing str -> Sing (Error @a str)++ -sErrorWithoutStackTrace :: forall a (str :: Symbol). Sing str -> a+ +sErrorWithoutStackTrace :: forall a (str :: Symbol). Sing str -> Sing (ErrorWithoutStackTrace @a str)++ -sUndefined :: forall a. HasCallStack => a+ +sUndefined :: forall a. HasCallStack => Sing (Undefined @a)+ ```++ This is because the old type signatures were _too_ polymorphic, and they+ required _ad hoc_ special casing in `singletons-th` in order to make them+ work in generated code. The more specific type signatures that these functions+ now have improve type inference and avoid the need for special casing. If you+ truly need the full polymorphism of the old type signatures, use `error`,+ `errorWithoutStackTrace`, or `undefined` instead.+* The kinds of `PAlternative` (and other classes in `singletons-base` that are+ parameterized over a higher-kinded type variable) are less polymorphic than+ they were before:++ ```diff+ -type PAlternative :: (k -> Type) -> Constraint+ +type PAlternative :: (Type -> Type) -> Constraint++ -type PMonadZip :: (k -> Type) -> Constraint+ +type PMonadZip :: (Type -> Type) -> Constraint++ -type PMonadPlus :: (k -> Type) -> Constraint+ +type PMonadPlus :: (Type -> Type) -> Constraint+ ```++ Similarly, the kinds of defunctionalization symbols for these classes (e.g.,+ `EmptySym0` and `(<|>@#@$)`) now use `Type -> Type` instead of `k -> Type`.+ The fact that these were kind-polymorphic to begin with was an oversight, as+ these could not be used when `k` was instantiated to any other kind besides+ `Type`.+* The kinds in the `PFunctor` instance for `Compose` are less polymorphic than+ they were before:++ ```diff+ -instance PFunctor (Compose (f :: k -> Type) (g :: Type -> k))+ +instance PFunctor (Compose (f :: Type -> Type) (g :: Type -> Type))+ ```++ Similarly for the `PFoldable`, `PTraversable`, `PApplicative`, and+ `PAlternative` instances for `Compose`. The fact that these instances were so+ polymorphic to begin with was an oversight, as these instances could not be+ used when `k` was instantiated to any other kind besides `Type`.+* The kinds of `Asum` and `Msum` are less polymorphic than they were before:++ ```diff+ -type Asum :: forall {j} {k} (t :: k -> Type) (f :: j -> k) (a :: j). t (f a) -> f a+ +type Asum :: forall (t :: Type -> Type) (f :: Type -> Type) (a :: Type). t (f a) -> f a++ -type Msum :: forall {j} {k} (t :: k -> Type) (m :: j -> k) (a :: j). t (m a) -> m a+ +type Msum :: forall (t :: Type -> Type) (m :: Type -> Type) (a :: Type). t (m a) -> m a+ ```++ Similarly, the kinds of defunctionalization symbols for these definitions+ (e.g., `AsumSym0` and `MSym0`) are less polymorphic. The fact that these were+ kind-polymorphic to begin with was an oversight, as these definitions could+ not be used when `j` or `k` was instantiated to any other kind besides `Type`.+* Define hand-written `Sing` instances such that they explicitly match on their+ types on the left-hand sides (e.g., define `type instance Sing @Symbol =+ SSymbol` instead of `type instance Sing = SSymbol`. Doing so will make+ `singletons-base` future-proof once+ [GHC#23515](https://gitlab.haskell.org/ghc/ghc/-/issues/23515) is fixed.++3.4 [2024.05.12]+----------------+* Require building with GHC 9.10.++3.3 [2023.10.13]+----------------+* Require building with GHC 9.8.+* All singleton types with `SEq` or `SOrd` instances now have `Eq` or `Ord`+ instances of the form:++ ```hs+ instance Eq (SExample a) where+ _ == _ = True++ instance Ord (SExample a) where+ compare _ _ = EQ+ ```+* Define `{P,S}Eq` and `{P,S}Ord` instances for `Sum`, `Product`, and `Compose`.+* Define `TestEquality` and `TestOrdering` instances for `SSum`, `SProduct`, and+ `SCompose`.++3.2 [2023.03.12]+----------------+* Require building with GHC 9.6.+* The kinds of the promoted `Error` and `ErrorWithoutStackTrace` functions have+ been monomorphized to `Symbol`. A previous release generalized the kinds of+ these arguments to allow passing arguments besides `Symbol`s, but this change+ introduces ambiguity in derived code when `OverloadedString`s is enabled.+ See [#89](https://github.com/goldfirere/singletons/issues/89) for the full+ story.++ If you were relying on the previous, kind-polymorphic behavior of `Error`, you+ can instead use the new `Data.Singletons.Base.PolyError` module that provides+ `PolyError`, a version of `Error` with a kind-polymorphic argument.+* `Data.Ord.Singletons` and `Data.Singletons.Base.TH` no longer define a+ `thenCmp :: Ordering -> Ordering -> Ordering` function, as this is not+ something that has ever existed in `base`. The existence of a `thenCmp`+ function was solely motivated by the code generated by derived `Ord`+ instances, but `singletons-base` now uses `(<>) @Ordering` instead.+* `GHC.TypeLits.Singletons` now re-exports the `SChar`, `SNat`, and `SSymbol`+ singleton types offered by `GHC.TypeLits` in `base-4.18.0.0` rather than+ defining its own versions. The versions of `SChar`, `SNat`, and `SSymbol`+ offered by `GHC.TypeLits` are nearly identical, minus some minor cosmetic+ changes (e.g., `GHC.TypeLits` defines pattern synonyms for `SNat` _et a._+ instead of data constructors).+* `GHC.TypeLits.Singletons` now re-exports the `SSymbol` pattern synonym+ from `GHC.TypeLits`. `GHC.TypeLits.Singletons` also continues to export `SSym`+ for backwards compatibility.+* `Prelude.Singletons` now re-exports `LiftA2` and `sLiftA2`, mirroring the+ fact that `Prelude` now re-exports `liftA2` in `base-4.18.0.0`.+* Provide `TestEquality` and `TestCoercion` instances for `SNat, `SSymbol`, and+ `SChar`.++3.1.1 [2022.08.23]+------------------+* Require building with GHC 9.4.++3.1 [2021.10.30]+----------------+* Require building with GHC 9.2.+* `singletons-base` now supports type-level `Char`s, a feature added in+ GHC 9.2. In particular:++ * Promoting and singling character literal expressions (e.g., `f = 'a'`) is+ now supported. Promoting (but not singling) character patterns+ (e.g., `g 'a' = ()`) is also supported.+ * `GHC.TypeLits.Singletons` now offers singled versions of the `ConsSymbol`,+ `UnconsSymbol`, `CharToNat`, and `NatToChar` type families that were+ introduced to `GHC.TypeLits` in GHC 9.2.+ * `Text.Show.Singletons` now makes use of type-level `Char`s, a feature added+ in GHC 9.2. As a result, there is no longer any need for the `SChar` type+ synonym, so it has been removed.+ * The `PShow` and `SShow` instances for `Symbol` now display escape characters+ properly rather than returning the input `Symbol` unchanged.++* In GHC 9.2, `Nat` is now a synonym for `Natural`. As a result, the bogus+ `Num`, `Eq`, `Ord`, `Enum`, and `Show` instances for `Nat` in+ `GHC.TypeLits.Singletons` have been removed, as they have replaced by the+ corresponding instances for `Natural`.+* Add `Data.Functor.{Compose,Product,Sum}.Singletons`.+* The types of various entities in `Data.Functor.Const.Singletons` and+ `Data.Proxy.Singletons` have been tweaked slightly such that their+ specificities match their term-level counterparts:++ ```diff+ -SConst :: forall {k} {a} {b :: k} (x :: a). Sing x -> Sing ('Const @a @b x)+ +SConst :: forall {k} a (b :: k) (x :: a). Sing x -> Sing ('Const @a @b x)++ -type ConstSym0 :: forall k a (b :: k). a ~> Const a b+ +type ConstSym0 :: forall {k} a (b :: k). a ~> Const a b++ -type ConstSym1 :: forall k a (b :: k). a -> Const a b+ +type ConstSym1 :: forall {k} a (b :: k). a -> Const a b++ -type ProxySym0 :: forall k (t :: k). Proxy t+ +type ProxySym0 :: forall {k} (t :: k). Proxy t+ ```+* Define instances of `SingI1` and `SingI2` when possible.++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` and `singletons-th` for changes+ specific to those libraries. For more information on this split, see the+ [relevant GitHub discussion](https://github.com/goldfirere/singletons/issues/420).+* Require building with GHC 9.0.+* The modules in `singletons-base` have been renamed to better reflect the+ modules from `base` from which they take inspiration. In particular, the+ following module renamings have been applied:++ * `Data.Singletons.CustomStar` -> `Data.Singletons.Base.CustomStar`+ * `Data.Singletons.Prelude` -> `Prelude.Singletons`+ * `Data.Singletons.Prelude.Applicative` -> `Control.Applicative.Singletons`+ * `Data.Singletons.Prelude.Bool` -> `Data.Bool.Singletons`+ * `Data.Singletons.Prelude.Const` -> `Data.Functor.Const.Singletons`+ * `Data.Singletons.Prelude.Either` -> `Data.Either.Singletons`+ * `Data.Singletons.Prelude.Enum` -> `Data.Singletons.Base.Enum`+ * `Data.Singletons.Prelude.Eq` -> `Data.Eq.Singletons`+ * `Data.Singletons.Prelude.Foldable` -> `Data.Foldable.Singletons`+ * `Data.Singletons.Prelude.Function` -> `Data.Function.Singletons`+ * `Data.Singletons.Prelude.Functor` -> `Data.Functor.Const.Singletons`+ * `Data.Singletons.Prelude.Identity` -> `Data.Functor.Identity.Singletons`+ * `Data.Singletons.Prelude.IsString` -> `Data.String.Singletons`+ * `Data.Singletons.Prelude.Ord` -> `Data.Ord.Singletons`+ * `Data.Singletons.Prelude.List` -> `Data.List.Singletons`+ * `Data.Singletons.Prelude.List.NonEmpty` -> `Data.List.NonEmpty.Singletons`+ * `Data.Singletons.Prelude.Maybe` -> `Data.Maybe.Singletons`+ * `Data.Singletons.Prelude.Monad` -> `Control.Monad.Singletons`+ * `Data.Singletons.Prelude.Monad.Fail` -> `Control.Monad.Fail.Singletons`+ * `Data.Singletons.Prelude.Monad.Zip` -> `Control.Monad.Zip.Singletons`+ * `Data.Singletons.Prelude.Monoid` -> `Data.Monoid.Singletons`+ * `Data.Singletons.Prelude.Proxy` -> `Data.Proxy.Singletons`+ * `Data.Singletons.Prelude.Semigroup` -> `Data.Semigroup.Singletons`+ * `Data.Singletons.Prelude.Show` -> `Data.Show.Singletons`+ * `Data.Singletons.Prelude.Traversable` -> `Data.Traversable.Singletons`+ * `Data.Singletons.Prelude.Tuple` -> `Data.Tuple.Singletons`+ * `Data.Singletons.Prelude.Void` -> `Data.Void.Singletons`+ * `Data.Singletons.TH` -> `Data.Singletons.Base.TH`+ * `Data.Singletons.TypeError` -> `Data.Singletons.Base.TypeError`+ * `Data.Singletons.TypeLits` -> `GHC.TypeLits.Singletons`+ * `Data.Singletons.TypeRepTYPE` -> `Data.Singletons.Base.TypeRepTYPE`++ Note that modules that do not correspond to any particular module in `base`+ now have the prefix `Data.Singletons.Base.*`. This includes+ `Data.Singletons.Base.Enum`, a special module that exists to provide a+ home for the `Succ` and `Pred` promoted type families that is separate from+ `Prelude.Singletons` (which exports everything from `PEnum` _except_ `Succ`+ and `Pred`). This is done in an effort to make importing `Prelude.Singletons`+ less likely to induce name clashes with code that works over unary natural+ numbers, which often use the names "`Succ`" and "`Pred`".+* An effort has been made to make the API of `Prelude.Singletons` more closely+ mirror that of the `Prelude` in `base`. As a result, `Prelude.Singletons` now+ exports some different functions than it used to. In particular, it now+ exports the following:++ * `Until`/`sUntil`/`UntilSym{N}`+ * `type (++@#@$$$)`+ * `type (.@#@$$$$)`+ * `FlipSym3`+ * `type (!!)`/`(%!!)`/`type (!!@#@{$})`+ * `Length`/`sLength`/`LengthSym{N}`+ * `DropWhile`/`sDropWhile`+ * `LookupSym{N}`+ * `Unzip3Sym{N}`++ `Prelude.Singletons` also used to export some things that were _not_ exported+ by the `Prelude`. Accordingly, these exports have been removed from+ `Prelude.Singletons`. They are:++ * `(^)`/`(%^)`/`type (^@#@{$})`. Although the `Prelude` does define a+ function named `(^)`, it is more general than the one defined in+ `singletons-base`, which only works on `Nat`s. Import+ `GHC.TypeLits.Singletons` if you wish to use the `Nat`-specific versions.+ * `DefaultEq`, which has no counterpart in the `Prelude`.+ Import `Data.Eq.Singletons` if you wish to use this.+ * `bool_`, which has no counterpart in the `Prelude`.+ Import `Data.Bool.Singletons` if you wish to use this.+* Two previously public-facing modules—`Data.Singletons.Prelude.Base` and+ `Data.Singletons.Prelude.Num`—have been turned into internal modules. The+ contents of these modules are re-exported from `Prelude.Singletons`, so that+ can be used instead.+* Due to the `singletons` package split, the `Eq`, `Ord`, etc. instances for+ `SomeSing` are no longer provided in the `Data.Singletons` module in the+ `singletons` library. Instead, they are now provided in a new+ `Data.Singletons.Base.SomeSing` module, which defines `Eq`, `Ord`, etc.+ instances for `SomeSing` as orphans.+* The `PEq` class no longer uses `DefaultEq` as its default implementation for+ `(==)`. `DefaultEq`, despite its name, is actually not a suitable+ implementation for `(==)` for a good majority of singleton types+ (see the discussion in+ [this GitHub issue](https://github.com/goldfirere/singletons/issues/457)+ for more information). `(==)`'s default is now defined in terms of `(/=)`,+ just like its term-level counterpart in the `Eq` class.+* Since `base-4.15.0.0` now deprecates `Data.Singletons.Option` (in+ anticipation of its removal in a future version of `base`), this library no+ longer offers a singleton type for `Option`. Accordingly, the `option_`+ function has also been removed.
LICENSE view
@@ -1,27 +1,27 @@-Copyright (c) 2012-2020, Richard Eisenberg -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -3. Neither the name of the author nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2012-2020, Richard Eisenberg+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,31 +1,31 @@-`singletons-base` -================= - -[](http://hackage.haskell.org/package/singletons-base) - -`singletons-base` uses `singletons-th` to define promoted and singled -functions from the @base@ library, including the `Prelude`. 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. See also -[the paper published at Haskell Symposium, 2014](https://richarde.dev/papers/2014/promotion/promotion.pdf), -which describes how promotion works in greater detail. - -WARNING: `singletons-base` defines orphan instances for `Sing`, `SingKind`, etc. -for common types such as `Bool`, `[]`, `Maybe`, etc. If you define -instances of these types in your code, you will likely not be able to use -that code with `singletons-base`. - -`singletons-base` uses code that relies on bleeding-edge GHC language -extensions. As such, `singletons-base` only supports the latest major version -of GHC (currently GHC 9.6). For more information, -consult the `singletons` -[`README`](https://github.com/goldfirere/singletons/blob/master/README.md). - -You may also be interested in the following related libraries: - -* The `singletons` library is a small, foundational library that defines - basic singleton-related types and definitions. -* 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. +`singletons-base`+=================++[](http://hackage.haskell.org/package/singletons-base)++`singletons-base` uses `singletons-th` to define promoted and singled+functions from the @base@ library, including the `Prelude`. 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. See also+[the paper published at Haskell Symposium, 2014](https://richarde.dev/papers/2014/promotion/promotion.pdf),+which describes how promotion works in greater detail.++WARNING: `singletons-base` defines orphan instances for `Sing`, `SingKind`, etc.+for common types such as `Bool`, `[]`, `Maybe`, etc. If you define+instances of these types in your code, you will likely not be able to use+that code with `singletons-base`.++`singletons-base` uses code that relies on bleeding-edge GHC language+extensions. As such, `singletons-base` only supports the latest major version+of GHC (currently GHC 9.14). For more information,+consult the `singletons`+[`README`](https://github.com/goldfirere/singletons/blob/master/README.md).++You may also be interested in the following related libraries:++* The `singletons` library is a small, foundational library that defines+ basic singleton-related types and definitions.+* 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.
Setup.hs view
@@ -1,138 +1,7 @@-{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -import Control.Monad - -import qualified Data.List as 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" : "-package-env=-" : 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 buildSingletonsBaseFile = testAutogenDir </> buildSingletonsBaseModule <.> "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 - singletonsBaseUnitId = componentUnitId libCLBI - deps = formatDeps (singletonsBaseUnitId:libTransDeps) - allFlags = dbFlags ++ deps - writeFile buildSingletonsBaseFile $ unlines - [ "module Build_singletons_base 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 - -buildSingletonsBaseModule :: FilePath -buildSingletonsBaseModule = "Build_singletons_base" - -testSuiteName :: String -testSuiteName = "singletons-base-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' = List.nub $ mn : om - am' = List.nub $ mn : am - - mn = fromString buildSingletonsBaseModule - - bi' = bi { otherModules = om', autogenModules = am' } - testSuite' = testSuite { testBuildInfo = bi' } - condTree' = condTree { condTreeData = testSuite' } +{-# OPTIONS_GHC -Wall #-}+module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain
singletons-base.cabal view
@@ -1,167 +1,173 @@-name: singletons-base -version: 3.2 -cabal-version: 1.24 -synopsis: A promoted and singled version of the base library -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 == 9.6.1 -extra-source-files: README.md, CHANGES.md, tests/README.md, - 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/*.golden, - tests/compile-and-dump/InsertionSort/*.golden, - tests/compile-and-dump/Promote/*.golden, - tests/compile-and-dump/Singletons/*.golden -license: BSD3 -license-file: LICENSE -build-type: Custom -description: - @singletons-base@ uses @singletons-th@ to define promoted and singled - functions from the @base@ library, including the "Prelude". 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>) - See also the paper published at Haskell Symposium, 2014, which describes - how promotion works in greater detail: - <https://richarde.dev/papers/2014/promotion/promotion.pdf>. - . - WARNING: @singletons-base@ defines orphan instances for @Sing@, @SingKind@, - etc. for common types such as @Bool@, @[]@, @Maybe@, etc. If you define - instances of these types in your code, you will likely not be able to use - that code with @singletons-base@. - . - @singletons-base@ uses code that relies on bleeding-edge GHC language - extensions. As such, @singletons-base@ only supports the latest major version - of GHC (currently GHC 9.6). 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@ library is a small, foundational library that defines - basic singleton-related types and definitions. - . - * 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. - -source-repository this - type: git - location: https://github.com/goldfirere/singletons.git - subdir: singletons-base - tag: v3.1.2 - -source-repository head - type: git - location: https://github.com/goldfirere/singletons.git - subdir: singletons-base - branch: master - -custom-setup - setup-depends: - base >= 4.18 && < 4.19, - Cabal >= 3.0 && < 3.11, - directory >= 1, - filepath >= 1.3 - -library - hs-source-dirs: src - build-depends: base >= 4.18 && < 4.19, - pretty, - singletons == 3.0.*, - singletons-th >= 3.2 && < 3.3, - template-haskell >= 2.20 && < 2.21, - text >= 1.2, - th-desugar >= 1.15 && < 1.16 - default-language: GHC2021 - other-extensions: TemplateHaskell - exposed-modules: Data.Singletons.Base.CustomStar - Data.Singletons.Base.Enum - Data.Singletons.Base.TH - Data.Singletons.Base.PolyError - Data.Singletons.Base.SomeSing - Data.Singletons.Base.TypeError - Data.Singletons.Base.TypeRepTYPE - - Control.Applicative.Singletons - Control.Monad.Singletons - Control.Monad.Fail.Singletons - Control.Monad.Zip.Singletons - Data.Bool.Singletons - Data.Either.Singletons - Data.Eq.Singletons - Data.Foldable.Singletons - Data.Function.Singletons - Data.Functor.Compose.Singletons - Data.Functor.Const.Singletons - Data.Functor.Identity.Singletons - Data.Functor.Product.Singletons - Data.Functor.Singletons - Data.Functor.Sum.Singletons - Data.List.Singletons - Data.List.NonEmpty.Singletons - Data.Maybe.Singletons - Data.Monoid.Singletons - Data.Ord.Singletons - Data.Proxy.Singletons - Data.Semigroup.Singletons - Data.String.Singletons - Data.Traversable.Singletons - Data.Tuple.Singletons - Data.Void.Singletons - GHC.TypeLits.Singletons - Prelude.Singletons - Text.Show.Singletons - - other-modules: Data.Singletons.Base.Instances - Data.Singletons.Base.Util - - Control.Monad.Singletons.Internal - Data.List.Singletons.Internal - Data.List.Singletons.Internal.Disambiguation - Data.Ord.Singletons.Disambiguation - Data.Semigroup.Singletons.Internal.Classes - Data.Semigroup.Singletons.Internal.Disambiguation - Data.Semigroup.Singletons.Internal.Wrappers - GHC.Base.Singletons - GHC.Num.Singletons - GHC.TypeLits.Singletons.Internal - - -- singletons re-exports - reexported-modules: Data.Singletons - , Data.Singletons.Decide - , Data.Singletons.ShowSing - , Data.Singletons.Sigma - - -- singletons-th re-exports - reexported-modules: Data.Singletons.TH - , Data.Singletons.TH.CustomStar - , Data.Singletons.TH.Options - , Data.Singletons.TH.SuppressUnusedWarnings - - ghc-options: -Wall -Wcompat -Wno-redundant-constraints - -test-suite singletons-base-test-suite - type: exitcode-stdio-1.0 - hs-source-dirs: tests - ghc-options: -Wall -Wcompat -threaded -with-rtsopts=-maxN16 - default-language: GHC2021 - main-is: SingletonsBaseTestSuite.hs - other-modules: SingletonsBaseTestSuiteUtils - - build-depends: base >= 4.18 && < 4.19, - bytestring >= 0.10.9, - deepseq >= 1.4.4, - filepath >= 1.3, - process >= 1.1, - turtle >= 1.5, - text >= 1.2, - singletons-base, - tasty >= 1.2, - tasty-golden >= 2.2 +cabal-version: 3.8+name: singletons-base+version: 3.5.1+synopsis: A promoted and singled version of the base library+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 == 9.14.1+extra-doc-files: CHANGES.md+extra-source-files: README.md+ tests/README.md+ 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/*.golden+ tests/compile-and-dump/InsertionSort/*.golden+ tests/compile-and-dump/Promote/*.golden+ tests/compile-and-dump/Singletons/*.golden+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+description:+ @singletons-base@ uses @singletons-th@ to define promoted and singled+ functions from the @base@ library, including the "Prelude". 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>)+ See also the paper published at Haskell Symposium, 2014, which describes+ how promotion works in greater detail:+ <https://richarde.dev/papers/2014/promotion/promotion.pdf>.+ .+ WARNING: @singletons-base@ defines orphan instances for @Sing@, @SingKind@,+ etc. for common types such as @Bool@, @[]@, @Maybe@, etc. If you define+ instances of these types in your code, you will likely not be able to use+ that code with @singletons-base@.+ .+ @singletons-base@ uses code that relies on bleeding-edge GHC language+ extensions. As such, @singletons-base@ only supports the latest major version+ of GHC (currently GHC 9.14). 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@ library is a small, foundational library that defines+ basic singleton-related types and definitions.+ .+ * 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.++source-repository this+ type: git+ location: https://github.com/goldfirere/singletons.git+ subdir: singletons-base+ tag: v3.1.2++source-repository head+ type: git+ location: https://github.com/goldfirere/singletons.git+ subdir: singletons-base+ branch: master++library+ hs-source-dirs: src+ build-depends: base >= 4.22 && < 4.23,+ pretty,+ singletons == 3.0.*,+ singletons-th >= 3.5.1 && < 3.6,+ template-haskell >= 2.24 && < 2.25,+ text >= 1.2+ default-language: GHC2024+ other-extensions: TemplateHaskell+ exposed-modules: Data.Singletons.Base.CustomStar+ Data.Singletons.Base.Enum+ Data.Singletons.Base.TH+ Data.Singletons.Base.PolyError+ Data.Singletons.Base.SomeSing+ Data.Singletons.Base.TypeError+ Data.Singletons.Base.TypeRepTYPE++ Control.Applicative.Singletons+ Control.Monad.Singletons+ Control.Monad.Fail.Singletons+ Control.Monad.Zip.Singletons+ Data.Bool.Singletons+ Data.Either.Singletons+ Data.Eq.Singletons+ Data.Foldable.Singletons+ Data.Function.Singletons+ Data.Functor.Compose.Singletons+ Data.Functor.Const.Singletons+ Data.Functor.Identity.Singletons+ Data.Functor.Product.Singletons+ Data.Functor.Singletons+ Data.Functor.Sum.Singletons+ Data.List.Singletons+ Data.List.NonEmpty.Singletons+ Data.Maybe.Singletons+ Data.Monoid.Singletons+ Data.Ord.Singletons+ Data.Proxy.Singletons+ Data.Semigroup.Singletons+ Data.String.Singletons+ Data.Traversable.Singletons+ Data.Tuple.Singletons+ Data.Void.Singletons+ GHC.TypeLits.Singletons+ Prelude.Singletons+ Text.Show.Singletons++ other-modules: Data.Singletons.Base.Instances+ Data.Singletons.Base.Util++ Control.Monad.Singletons.Internal+ Data.List.Singletons.Internal+ Data.List.Singletons.Internal.Disambiguation+ Data.Ord.Singletons.Disambiguation+ Data.Semigroup.Singletons.Internal.Classes+ Data.Semigroup.Singletons.Internal.Disambiguation+ Data.Semigroup.Singletons.Internal.Wrappers+ GHC.Base.Singletons+ GHC.Num.Singletons+ GHC.TypeLits.Singletons.Internal++ -- singletons re-exports+ reexported-modules: Data.Singletons+ , Data.Singletons.Decide+ , Data.Singletons.ShowSing+ , Data.Singletons.Sigma++ -- singletons-th re-exports+ reexported-modules: Data.Singletons.TH+ , Data.Singletons.TH.CustomStar+ , Data.Singletons.TH.Options+ , Data.Singletons.TH.SuppressUnusedWarnings++ ghc-options: -Wall -Wcompat -Wno-redundant-constraints++test-suite singletons-base-test-suite+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ ghc-options: -Wall -Wcompat -threaded -with-rtsopts=-maxN16+ default-language: GHC2024+ main-is: SingletonsBaseTestSuite.hs+ other-modules: SingletonsBaseTestSuiteUtils++ build-depends: base >= 4.22 && < 4.23,+ bytestring >= 0.10.9,+ deepseq >= 1.4.4,+ filepath >= 1.3,+ ghc-paths >= 0.1,+ process >= 1.1,+ turtle >= 1.5,+ text >= 1.2,+ singletons-base,+ tasty >= 1.2,+ tasty-golden >= 2.2,++ -- Dependencies only used when invoking GHC in the test+ -- suite+ ghc-prim,+ ghc-internal,+ mtl,+ template-haskell,+ th-desugar,+ transformers+ build-tool-depends: singletons-base-code-generator:singletons-base-code-generator+ code-generators: singletons-base-code-generator
src/Control/Applicative/Singletons.hs view
@@ -1,66 +1,66 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Control.Applicative.Singletons --- 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 Control.Applicative.Singletons ( - PApplicative(..), SApplicative(..), - PAlternative(..), SAlternative(..), - Sing, SConst(..), Const, GetConst, sGetConst, - 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 Control.Monad.Singletons.Internal -import Data.Functor.Const.Singletons -import Data.Functor.Singletons -import Data.Monoid.Singletons -import Data.Ord (Down(..)) -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH - -$(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) - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Control.Applicative.Singletons+-- 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 Control.Applicative.Singletons (+ PApplicative(..), SApplicative(..),+ PAlternative(..), SAlternative(..),+ Sing, SConst(..), Const, GetConst, sGetConst,+ 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 Control.Monad.Singletons.Internal+import Data.Functor.Const.Singletons+import Data.Functor.Singletons+import Data.Monoid.Singletons+import Data.Ord (Down(..))+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH++$(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/Control/Monad/Fail/Singletons.hs view
@@ -1,59 +1,64 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Fail.Singletons --- Copyright : (C) 2019 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Defines the promoted and singled versions of the 'MonadFail' type class. --- ----------------------------------------------------------------------------- - -module Control.Monad.Fail.Singletons ( - PMonadFail(..), SMonadFail(..), - - -- * Defunctionalization symbols - FailSym0, FailSym1 - ) where - -import Control.Monad.Singletons.Internal -import Data.Singletons.Base.Instances -import Data.Singletons.TH - -$(singletonsOnly [d| - -- -| When a value is bound in @do@-notation, the pattern on the left - -- hand side of @<-@ might not match. In this case, this class - -- provides a function to recover. - -- - -- A 'Monad' without a 'MonadFail' instance may only be used in conjunction - -- with pattern that always match, such as newtypes, tuples, data types with - -- only a single data constructor, and irrefutable patterns (@~pat@). - -- - -- Instances of 'MonadFail' should satisfy the following law: @fail s@ should - -- be a left zero for 'Control.Monad.>>=', - -- - -- @ - -- fail s >>= f = fail s - -- @ - -- - -- If your 'Monad' is also 'Control.Monad.MonadPlus', a popular definition is - -- - -- @ - -- fail _ = mzero - -- @ - class Monad m => MonadFail m where - fail :: String -> m a - - instance MonadFail Maybe where - fail _ = Nothing - - instance MonadFail [] where - fail _ = [] - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Fail.Singletons+-- Copyright : (C) 2019 Ryan Scott+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Defines the promoted and singled versions of the 'MonadFail' type class.+--+----------------------------------------------------------------------------++module Control.Monad.Fail.Singletons (+ PMonadFail(..), SMonadFail(..),++ -- * Defunctionalization symbols+ FailSym0, FailSym1+ ) where++import Control.Monad.Singletons.Internal+import Data.Kind+import Data.Singletons.Base.Instances+import Data.Singletons.TH++$(singletonsOnly [d|+ -- -| When a value is bound in @do@-notation, the pattern on the left+ -- hand side of @<-@ might not match. In this case, this class+ -- provides a function to recover.+ --+ -- A 'Monad' without a 'MonadFail' instance may only be used in conjunction+ -- with pattern that always match, such as newtypes, tuples, data types with+ -- only a single data constructor, and irrefutable patterns (@~pat@).+ --+ -- Instances of 'MonadFail' should satisfy the following law: @fail s@ should+ -- be a left zero for 'Control.Monad.>>=',+ --+ -- @+ -- fail s >>= f = fail s+ -- @+ --+ -- If your 'Monad' is also 'Control.Monad.MonadPlus', a popular definition is+ --+ -- @+ -- fail _ = mzero+ -- @++ -- See Note [Using standalone kind signatures not present in the base library]+ -- in Control.Monad.Singletons.Internal.+ type MonadFail :: (Type -> Type) -> Constraint+ class Monad m => MonadFail m where+ fail :: String -> m a++ instance MonadFail Maybe where+ fail _ = Nothing++ instance MonadFail [] where+ fail _ = []+ |])
src/Control/Monad/Singletons.hs view
@@ -1,285 +1,285 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Singletons --- 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 Control.Monad.Singletons ( - PFunctor(Fmap), SFunctor(sFmap), - PMonad(..), SMonad(..), PMonadPlus(..), SMonadPlus(..), - PMonadFail(Fail), SMonadFail(sFail), - - 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.Singletons () -import Control.Monad -import Control.Monad.Fail.Singletons -import Control.Monad.Singletons.Internal -import Data.Foldable.Singletons -import Data.Functor.Singletons -import Data.List.Singletons (UnzipSym0, sUnzip, ZipWithSym0, sZipWith) -import Data.Monoid.Singletons -import Data.Ord (Down(..)) -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH hiding (Void) -import Data.Traversable.Singletons -import GHC.Base.Singletons hiding (Foldr, FoldrSym0, sFoldr) -import GHC.Num.Singletons -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 :: forall m a. (Applicative m) => Natural -> m a -> m [a] - replicateM cnt0 f = - loop cnt0 - where - loop :: Natural -> m [a] - loop cnt - | cnt <= 0 = pure [] - | otherwise = liftA2 (:) f (loop (cnt - 1)) - - -- -| Like 'replicateM', but discards the result. - replicateM_ :: forall m a. (Applicative m) => Natural -> m a -> m () - replicateM_ cnt0 f = - loop cnt0 - where - loop :: Natural -> m () - 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 - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Singletons+-- 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 Control.Monad.Singletons (+ PFunctor(Fmap), SFunctor(sFmap),+ PMonad(..), SMonad(..), PMonadPlus(..), SMonadPlus(..),+ PMonadFail(Fail), SMonadFail(sFail),++ 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.Singletons ()+import Control.Monad+import Control.Monad.Fail.Singletons+import Control.Monad.Singletons.Internal+import Data.Foldable.Singletons+import Data.Functor.Singletons+import Data.List.Singletons (UnzipSym0, sUnzip, ZipWithSym0, sZipWith)+import Data.Monoid.Singletons+import Data.Ord (Down(..))+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH hiding (Void)+import Data.Traversable.Singletons+import GHC.Base.Singletons hiding (Foldr, FoldrSym0, sFoldr)+import GHC.Num.Singletons+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 :: forall m a. (Applicative m) => Natural -> m a -> m [a]+ replicateM cnt0 f =+ loop cnt0+ where+ loop :: Natural -> m [a]+ loop cnt+ | cnt <= 0 = pure []+ | otherwise = liftA2 (:) f (loop (cnt - 1))++ -- -| Like 'replicateM', but discards the result.+ replicateM_ :: forall m a. (Applicative m) => Natural -> m a -> m ()+ replicateM_ cnt0 f =+ loop cnt0+ where+ loop :: Natural -> m ()+ 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+ |])
src/Control/Monad/Singletons/Internal.hs view
@@ -1,480 +1,509 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Singletons.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 Control.Monad.Singletons.Internal where - -import Control.Applicative -import Control.Monad -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import GHC.Base.Singletons - -$(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 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 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 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 - - {- 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 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 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 = (<|>) - |]) - -$(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 - m *> k = m >>= \_ -> k - - 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 - - (>>) = (*>) - - 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 - - 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 [] - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Singletons.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 Control.Monad.Singletons.Internal where++import Control.Applicative+import Control.Monad+import Data.Kind+import Data.List.NonEmpty (NonEmpty(..))+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import GHC.Base.Singletons++$(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.+ -}++ -- See Note [Using standalone kind signatures not present in the base library]+ type Functor :: (Type -> Type) -> Constraint+ class Functor f 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).++ -- See Note [Using standalone kind signatures not present in the base library]+ type Applicative :: (Type -> Type) -> Constraint+ class Functor f => Applicative f 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.+ -}++ -- See Note [Using standalone kind signatures not present in the base library]+ type Monad :: (Type -> Type) -> Constraint+ class Applicative m => Monad m 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++ {- 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' []@++ -- See Note [Using standalone kind signatures not present in the base library]+ type Alternative :: (Type -> Type) -> Constraint+ class Applicative f => Alternative f 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.++ -- See Note [Using standalone kind signatures not present in the base library]+ type MonadPlus :: (Type -> Type) -> Constraint+ class (Alternative m, Monad m) => MonadPlus m 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 = (<|>)+ |])++$(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+ m *> k = m >>= \_ -> k++ 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++ (>>) = (*>)++ 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++ 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 []+ |])++{-+Note [Using standalone kind signatures not present in the base library]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Various type class definitions in singletons-base (Functor, Foldable,+Alternative, etc.) are defined using standalone kind signatures. These+standalone kind signatures are /not/ present in the original `base` library,+however: these are specifically required by singletons-th. More precisely, all+of these classes are parameterized by a type variable of kind `Type -> Type`,+and we want to ensure that the promoted class (and the defunctionalization+symbols for its class methods) all use `Type -> Type` in their kinds as well.+For more details on why singletons-th requires this, see Note [Propagating kind+information from class standalone kind signatures] in D.S.TH.Promote in+singletons-th.+-}
src/Control/Monad/Zip/Singletons.hs view
@@ -1,103 +1,108 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.Zip.Singletons --- 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 Control.Monad.Zip.Singletons ( - PMonadZip(..), SMonadZip(..), - - -- * Defunctionalization symbols - MzipSym0, MzipSym1, MzipSym2, - MzipWithSym0, MzipWithSym1, MzipWithSym2, MzipWithSym3, - MunzipSym0, MunzipSym1, - ) where - -import Control.Monad.Singletons.Internal -import Data.Functor.Identity -import Data.Functor.Identity.Singletons -import Data.List.Singletons - ( ZipSym0, ZipWithSym0, UnzipSym0 - , sZip, sZipWith, sUnzip ) -import Data.Monoid -import Data.Monoid.Singletons () -import Data.Proxy -import Data.Proxy.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import Data.Tuple.Singletons - -$(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 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 - - instance MonadZip Proxy where - mzipWith _ _ _ = Proxy - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Zip.Singletons+-- 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 Control.Monad.Zip.Singletons (+ PMonadZip(..), SMonadZip(..),++ -- * Defunctionalization symbols+ MzipSym0, MzipSym1, MzipSym2,+ MzipWithSym0, MzipWithSym1, MzipWithSym2, MzipWithSym3,+ MunzipSym0, MunzipSym1,+ ) where++import Control.Monad.Singletons.Internal+import Data.Functor.Identity+import Data.Functor.Identity.Singletons+import Data.Kind+import Data.List.Singletons+ ( ZipSym0, ZipWithSym0, UnzipSym0+ , sZip, sZipWith, sUnzip )+import Data.Monoid+import Data.Monoid.Singletons ()+import Data.Proxy+import Data.Proxy.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import Data.Tuple.Singletons++$(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)+ --++ -- See Note [Using standalone kind signatures not present in the base library]+ -- in Control.Monad.Singletons.Internal.+ type MonadZip :: (Type -> Type) -> Constraint+ class Monad m => MonadZip m 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++ instance MonadZip Proxy where+ mzipWith _ _ _ = Proxy+ |])
src/Data/Bool/Singletons.hs view
@@ -1,114 +1,114 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Bool.Singletons --- 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 singled versions 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.Bool.Singletons ( - -- * The 'Bool' singleton - Sing, SBool(..), - - -- * 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, - - IfSym0, IfSym1, IfSym2, IfSym3, - NotSym0, NotSym1, - type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), - type (||@#@$), type (||@#@$$), type (||@#@$$$), - Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3, - OtherwiseSym0 - ) where - -import Data.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH -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 -$(genDefunSymbols [''If]) -instance SingI IfSym0 where - sing = singFun3 sIf -instance SingI c => SingI (IfSym1 c) where - sing = singFun2 $ sIf (sing @c) -instance (SingI c, SingI t) => SingI (IfSym2 c t) where - sing = singFun1 $ sIf (sing @c) (sing @t) -instance SingI1 IfSym1 where - liftSing s = singFun2 $ sIf s -instance SingI c => SingI1 (IfSym2 c) where - liftSing s = singFun1 $ sIf (sing @c) s -instance SingI2 IfSym2 where - liftSing2 s1 s2 = singFun1 $ sIf s1 s2 +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Bool.Singletons+-- 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 singled versions 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.Bool.Singletons (+ -- * The 'Bool' singleton+ Sing, SBool(..),++ -- * 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,++ IfSym0, IfSym1, IfSym2, IfSym3,+ NotSym0, NotSym1,+ type (&&@#@$), type (&&@#@$$), type (&&@#@$$$),+ type (||@#@$), type (||@#@$$), type (||@#@$$$),+ Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3,+ OtherwiseSym0+ ) where++import Data.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH+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+$(genDefunSymbols [''If])+instance SingI IfSym0 where+ sing = singFun3 sIf+instance SingI c => SingI (IfSym1 c) where+ sing = singFun2 $ sIf (sing @c)+instance (SingI c, SingI t) => SingI (IfSym2 c t) where+ sing = singFun1 $ sIf (sing @c) (sing @t)+instance SingI1 IfSym1 where+ liftSing s = singFun2 $ sIf s+instance SingI c => SingI1 (IfSym2 c) where+ liftSing s = singFun1 $ sIf (sing @c) s+instance SingI2 IfSym2 where+ liftSing2 s1 s2 = singFun1 $ sIf s1 s2
src/Data/Either/Singletons.hs view
@@ -1,105 +1,105 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Either.Singletons --- 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 singled versions 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.Either.Singletons ( - -- * The 'Either' singleton - Sing, SEither(..), - - -- * 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.Base.Instances -import Data.Singletons.TH -import GHC.Base.Singletons - --- 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 - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Either.Singletons+-- 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 singled versions 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.Either.Singletons (+ -- * The 'Either' singleton+ Sing, SEither(..),++ -- * 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.Base.Instances+import Data.Singletons.TH+import GHC.Base.Singletons++-- 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/Eq/Singletons.hs view
@@ -1,121 +1,121 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Eq.Singletons --- Copyright : (C) 2013 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Defines the promoted version of 'Eq', 'PEq', and the singleton version, --- 'SEq'. Also defines the 'DefaultEq' type family, which is useful for --- implementing boolean equality for non-inductively defined data types. --- ------------------------------------------------------------------------------ - -module Data.Eq.Singletons ( - PEq(..), SEq(..), - DefaultEq, - - -- * Defunctionalization symbols - type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (/=@#@$), type (/=@#@$$), type (/=@#@$$$), - DefaultEqSym0, DefaultEqSym1, DefaultEqSym2 - ) where - -import Data.Bool.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH --- The imports below are only needed for Haddock purposes. -import qualified Data.Kind as Kind () -import qualified Data.Type.Equality as DTE () -import qualified GHC.TypeLits as Lit () - -$(singletonsOnly [d| - infix 4 ==, /= - - -- -| The 'Eq' class defines equality ('==') and inequality ('/='). - -- All the basic datatypes exported by the "Prelude" are instances of 'Eq', - -- and 'Eq' may be derived for any datatype whose constituents are also - -- instances of 'Eq'. - -- - -- The Haskell Report defines no laws for 'Eq'. However, '==' is customarily - -- expected to implement an equivalence relationship where two values comparing - -- equal are indistinguishable by "public" functions, with a "public" function - -- being one not allowing to see implementation details. For example, for a - -- type representing non-normalised natural numbers modulo 100, a "public" - -- function doesn't make the difference between 1 and 201. It is expected to - -- have the following properties: - -- - -- [__Reflexivity__]: @x == x@ = 'True' - -- [__Symmetry__]: @x == y@ = @y == x@ - -- [__Transitivity__]: if @x == y && y == z@ = 'True', then @x == z@ = 'True' - -- [__Substitutivity__]: if @x == y@ = 'True' and @f@ is a "public" function - -- whose return type is an instance of 'Eq', then @f x == f y@ = 'True' - -- [__Negation__]: @x /= y@ = @not (x == y)@ - -- - -- Minimal complete definition: either '==' or '/='. - -- - class Eq a where - (==), (/=) :: a -> a -> Bool - - {-# INLINE (/=) #-} - {-# INLINE (==) #-} - x /= y = not (x == y) - x == y = not (x /= y) - -- {-# MINIMAL (==) | (/=) #-} - |]) - --- | One way to compute Boolean equality for types of any kind. This will --- return 'True' if the two arguments are known to be the same type and 'False' --- if they are known to be apart. Examples: --- --- @ --- >>> 'DefaultEq' 'Nothing' 'Nothing' --- 'True' --- >>> 'DefaultEq' 'Nothing' ('Just' a) --- 'False' --- >>> 'DefaultEq' a a --- 'True' --- @ --- --- 'DefaultEq' is most suited for data types that are not inductively defined. --- Four concrete examples of this are 'Natural', 'Lit.Symbol', 'Lit.Char', and --- 'Kind.Type'. One cannot implement boolean equality for these types by --- pattern matching alone, so 'DefaultEq' is a good fit instead. --- --- The downside to 'DefaultEq' is that it can fail to reduce if it is unable --- to determine if two types are equal or apart. Here is one such example: --- --- @ --- 'DefaultEq' ('Just' a) ('Just' b) --- @ --- --- What should this reduce to? It depends on what @a@ and @b@ are. 'DefaultEq' --- has no way of knowing what these two types are, and as a result, this type --- will be stuck. This is a pitfall that you can run into if you use --- 'DefaultEq' to implement boolean equality for an inductive data type like --- 'Maybe'. For this reason, it is usually recommended to implement boolean --- equality for inductive data types using pattern matching and recursion, not --- 'DefaultEq'. --- --- 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 DefaultEq :: k -> k -> Bool -type family DefaultEq (a :: k) (b :: k) :: Bool where - DefaultEq a a = 'True - DefaultEq a b = 'False -$(genDefunSymbols [''DefaultEq]) - -$(singEqInstances basicTypes) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Eq.Singletons+-- Copyright : (C) 2013 Richard Eisenberg+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Defines the promoted version of 'Eq', 'PEq', and the singleton version,+-- 'SEq'. Also defines the 'DefaultEq' type family, which is useful for+-- implementing boolean equality for non-inductively defined data types.+--+-----------------------------------------------------------------------------++module Data.Eq.Singletons (+ PEq(..), SEq(..),+ DefaultEq,++ -- * Defunctionalization symbols+ type (==@#@$), type (==@#@$$), type (==@#@$$$),+ type (/=@#@$), type (/=@#@$$), type (/=@#@$$$),+ DefaultEqSym0, DefaultEqSym1, DefaultEqSym2+ ) where++import Data.Bool.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH+-- The imports below are only needed for Haddock purposes.+import qualified Data.Kind as Kind ()+import qualified Data.Type.Equality as DTE ()+import qualified GHC.TypeLits as Lit ()++$(singletonsOnly [d|+ infix 4 ==, /=++ -- -| The 'Eq' class defines equality ('==') and inequality ('/=').+ -- All the basic datatypes exported by the "Prelude" are instances of 'Eq',+ -- and 'Eq' may be derived for any datatype whose constituents are also+ -- instances of 'Eq'.+ --+ -- The Haskell Report defines no laws for 'Eq'. However, '==' is customarily+ -- expected to implement an equivalence relationship where two values comparing+ -- equal are indistinguishable by "public" functions, with a "public" function+ -- being one not allowing to see implementation details. For example, for a+ -- type representing non-normalised natural numbers modulo 100, a "public"+ -- function doesn't make the difference between 1 and 201. It is expected to+ -- have the following properties:+ --+ -- [__Reflexivity__]: @x == x@ = 'True'+ -- [__Symmetry__]: @x == y@ = @y == x@+ -- [__Transitivity__]: if @x == y && y == z@ = 'True', then @x == z@ = 'True'+ -- [__Substitutivity__]: if @x == y@ = 'True' and @f@ is a "public" function+ -- whose return type is an instance of 'Eq', then @f x == f y@ = 'True'+ -- [__Negation__]: @x /= y@ = @not (x == y)@+ --+ -- Minimal complete definition: either '==' or '/='.+ --+ class Eq a where+ (==), (/=) :: a -> a -> Bool++ {-# INLINE (/=) #-}+ {-# INLINE (==) #-}+ x /= y = not (x == y)+ x == y = not (x /= y)+ -- {-# MINIMAL (==) | (/=) #-}+ |])++-- | One way to compute Boolean equality for types of any kind. This will+-- return 'True' if the two arguments are known to be the same type and 'False'+-- if they are known to be apart. Examples:+--+-- @+-- >>> 'DefaultEq' 'Nothing' 'Nothing'+-- 'True'+-- >>> 'DefaultEq' 'Nothing' ('Just' a)+-- 'False'+-- >>> 'DefaultEq' a a+-- 'True'+-- @+--+-- 'DefaultEq' is most suited for data types that are not inductively defined.+-- Four concrete examples of this are 'Natural', 'Lit.Symbol', 'Lit.Char', and+-- 'Kind.Type'. One cannot implement boolean equality for these types by+-- pattern matching alone, so 'DefaultEq' is a good fit instead.+--+-- The downside to 'DefaultEq' is that it can fail to reduce if it is unable+-- to determine if two types are equal or apart. Here is one such example:+--+-- @+-- 'DefaultEq' ('Just' a) ('Just' b)+-- @+--+-- What should this reduce to? It depends on what @a@ and @b@ are. 'DefaultEq'+-- has no way of knowing what these two types are, and as a result, this type+-- will be stuck. This is a pitfall that you can run into if you use+-- 'DefaultEq' to implement boolean equality for an inductive data type like+-- 'Maybe'. For this reason, it is usually recommended to implement boolean+-- equality for inductive data types using pattern matching and recursion, not+-- 'DefaultEq'.+--+-- 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 DefaultEq :: k -> k -> Bool+type family DefaultEq (a :: k) (b :: k) :: Bool where+ DefaultEq a a = 'True+ DefaultEq a b = 'False+$(genDefunSymbols [''DefaultEq])++$(singEqInstances basicTypes)
src/Data/Foldable/Singletons.hs view
@@ -1,662 +1,686 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Foldable.Singletons --- 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.Foldable.Singletons ( - 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 Control.Monad.Singletons.Internal -import Data.Bool.Singletons -import Data.Either.Singletons -import Data.Eq.Singletons -import Data.Kind -import Data.List.NonEmpty (NonEmpty(..)) -import Data.List.Singletons.Internal.Disambiguation -import Data.Maybe.Singletons -import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..)) -import Data.Monoid.Singletons - hiding ( AllSym0, AllSym1 - , AnySym0, AnySym1 - , ProductSym0, ProductSym1 - , SumSym0, SumSym1 ) -import qualified Data.Monoid as Monoid (Product(..), Sum(..)) -import Data.Ord.Singletons - hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax - , Min, MinSym0, MinSym1, MinSym2, sMin ) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Semigroup.Singletons.Internal.Disambiguation -import Data.Singletons -import Data.Singletons.Base.Instances - hiding (Foldl, FoldlSym0(..), FoldlSym1(..), FoldlSym2(..), FoldlSym3, sFoldl) -import Data.Singletons.TH -import GHC.Base.Singletons - hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) -import GHC.Num.Singletons -import GHC.TypeLits.Singletons.Internal - -type Endo :: Type -> Type -newtype Endo a = Endo (a ~> a) -type SEndo :: Endo a -> Type -data SEndo e where - SEndo :: Sing x -> SEndo ('Endo x) -type instance Sing = SEndo -type EndoSym0 :: (a ~> a) ~> Endo a -data EndoSym0 tf -type instance Apply EndoSym0 x = 'Endo x - -$(singletonsOnly [d| - appEndo :: Endo a -> (a -> a) - appEndo (Endo x) = x - - instance Semigroup (Endo a) where - Endo x <> Endo y = Endo (x . y) - - instance Monoid (Endo a) where - mempty = Endo id - |]) - -$(singletons [d| - newtype MaxInternal a = MaxInternal { getMaxInternal :: Maybe a } - newtype MinInternal a = MinInternal { getMinInternal :: Maybe a } - |]) - -$(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 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 = appEndo (foldMap (Endo . f) t) 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 = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) 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 -> Natural - 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 = fromMaybe (errorWithoutStackTrace "maximum: empty structure") . - getMaxInternal . foldMap (MaxInternal . mkJust) - where - mkJust :: a -> Maybe a - mkJust = Just - - -- -| The least element of a non-empty structure. - minimum :: forall a . Ord a => t a -> a - minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") . - getMinInternal . foldMap (MinInternal . mkJust) - where - mkJust :: a -> Maybe a - mkJust = Just - - -- -| The 'sum' function computes the sum of the numbers of a structure. - sum :: Num a => t a -> a - sum = getSum . foldMap sum_ - - -- -| The 'product' function computes the product of the numbers of a - -- structure. - product :: Num a => t a -> a - product = getProduct . foldMap product_ - - -- 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 Proxy where - foldMap _ _ = mempty - fold _ = mempty - foldr _ z _ = z - foldl _ z _ = z - foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy" - foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy" - - -- Why do we give length (and null) an instance signature here? If we - -- didn't, singletons-th would generate one for us when singling it: - -- - -- instance SFoldable Proxy where - -- sLength :: forall a (x :: Proxy a). Sing x -> Sing (Length x) - -- sLength = ... - -- - -- If you squint, you'll notice that that instance signature is actually - -- /too/ general. This is because GHC will infer that `a` should be - -- kind-polymorphic, but Length is only defined when `a` is of kind - -- `Type`! Ugh. To force GHC to come to its senses, we explicitly inform - -- it that `a :: Type` through our own instance signature. - length :: forall (a :: Type). Proxy a -> Natural - length _ = 0 - - null :: forall (a :: Type). Proxy a -> Bool - null _ = True - - elem _ _ = False - sum _ = 0 - product _ = 1 - - instance Foldable Dual where - foldMap f (Dual x) = f x - - elem = (. getDual) . (==) - foldl f z (Dual x) = f z x - foldl' f z (Dual x) = f z x - foldl1 _ = getDual - foldr f z (Dual x) = f x z - foldr' = foldr - foldr1 _ = getDual - length _ = 1 - maximum = getDual - minimum = getDual - null _ = False - product = getDual - sum = getDual - toList (Dual x) = [x] - - instance Foldable Monoid.Sum where - foldMap f (Monoid.Sum x) = f x - - elem = (. getSum) . (==) - foldl f z (Monoid.Sum x) = f z x - foldl' f z (Monoid.Sum x) = f z x - foldl1 _ = getSum - foldr f z (Monoid.Sum x) = f x z - foldr' = foldr - foldr1 _ = getSum - length _ = 1 - maximum = getSum - minimum = getSum - null _ = False - product = getSum - sum = getSum - toList (Monoid.Sum x) = [x] - - instance Foldable Monoid.Product where - foldMap f (Monoid.Product x) = f x - - elem = (. getProduct) . (==) - foldl f z (Monoid.Product x) = f z x - foldl' f z (Monoid.Product x) = f z x - foldl1 _ = getProduct - foldr f z (Monoid.Product x) = f x z - foldr' = foldr - foldr1 _ = getProduct - length _ = 1 - maximum = getProduct - minimum = getProduct - null _ = False - product = getProduct - sum = getProduct - 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 = getAll . foldMap all_ - - -- -| '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 = getAny . foldMap any_ - - -- -| Determines whether any element of the structure satisfies the predicate. - any :: Foldable t => (a -> Bool) -> t a -> Bool - any p = getAny . foldMap (any_ . p) - - -- -| Determines whether all elements of the structure satisfy the predicate. - all :: Foldable t => (a -> Bool) -> t a -> Bool - all p = getAll . foldMap (all_ . p) - - -- -| 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 = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) - |]) - -$(singletonsOnly [d| - -- instances for Prelude types (part 2) - - deriving instance Foldable ((,) a) - deriving instance Foldable First - deriving instance Foldable Last - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Foldable.Singletons+-- 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.Foldable.Singletons (+ 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 Control.Monad.Singletons.Internal+import Data.Bool.Singletons+import Data.Either.Singletons+import Data.Eq.Singletons+import Data.Kind+import Data.List.NonEmpty (NonEmpty(..))+import Data.List.Singletons.Internal.Disambiguation+import Data.Maybe.Singletons+import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..))+import Data.Monoid.Singletons+ hiding ( AllSym0, AllSym1+ , AnySym0, AnySym1+ , ProductSym0, ProductSym1+ , SumSym0, SumSym1 )+import qualified Data.Monoid as Monoid (Product(..), Sum(..))+import Data.Ord.Singletons+ hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax+ , Min, MinSym0, MinSym1, MinSym2, sMin )+import Data.Semigroup.Singletons.Internal.Classes+import Data.Semigroup.Singletons.Internal.Disambiguation+import Data.Singletons+import Data.Singletons.Base.Instances+ hiding (Foldl, FoldlSym0(..), FoldlSym1(..), FoldlSym2(..), FoldlSym3, sFoldl)+import Data.Singletons.TH+import GHC.Base.Singletons+ hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)+import GHC.Num.Singletons+import GHC.TypeLits.Singletons.Internal++type Endo :: Type -> Type+newtype Endo a = Endo (a ~> a)+type SEndo :: Endo a -> Type+data SEndo e where+ SEndo :: Sing x -> SEndo ('Endo x)+type instance Sing @(Endo a) = SEndo+type EndoSym0 :: (a ~> a) ~> Endo a+data EndoSym0 tf+type instance Apply EndoSym0 x = 'Endo x++$(singletonsOnly [d|+ appEndo :: Endo a -> (a -> a)+ appEndo (Endo x) = x++ instance Semigroup (Endo a) where+ Endo x <> Endo y = Endo (x . y)++ instance Monoid (Endo a) where+ mempty = Endo id+ |])++$(singletons [d|+ newtype MaxInternal a = MaxInternal { getMaxInternal :: Maybe a }+ newtype MinInternal a = MinInternal { getMinInternal :: Maybe a }+ |])++$(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)++ -- See Note [Using standalone kind signatures not present in the base library]+ -- in Control.Monad.Singletons.Internal.+ type Foldable :: (Type -> Type) -> Constraint+ class Foldable t 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 = appEndo (foldMap (Endo . f) t) 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 = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) 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 -> Natural+ 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 = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .+ getMaxInternal . foldMap (MaxInternal . mkJust)+ where+ mkJust :: a -> Maybe a+ mkJust = Just++ -- -| The least element of a non-empty structure.+ minimum :: forall a . Ord a => t a -> a+ minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .+ getMinInternal . foldMap (MinInternal . mkJust)+ where+ mkJust :: a -> Maybe a+ mkJust = Just++ -- -| The 'sum' function computes the sum of the numbers of a structure.+ sum :: Num a => t a -> a+ sum = getSum . foldMap sum_++ -- -| The 'product' function computes the product of the numbers of a+ -- structure.+ product :: Num a => t a -> a+ product = getProduct . foldMap product_++ -- 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 Proxy where+ foldMap _ _ = mempty+ fold _ = mempty+ foldr _ z _ = z+ foldl _ z _ = z+ foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy"+ foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy"++ -- Why do we give length (and null) an instance signature here? If we+ -- didn't, singletons-th would generate one for us when singling it:+ --+ -- instance SFoldable Proxy where+ -- sLength :: forall a (x :: Proxy a). Sing x -> Sing (Length x)+ -- sLength = ...+ --+ -- If you squint, you'll notice that that instance signature is actually+ -- /too/ general. This is because GHC will infer that `a` should be+ -- kind-polymorphic, but Length is only defined when `a` is of kind+ -- `Type`! Ugh. To force GHC to come to its senses, we explicitly inform+ -- it that `a :: Type` through our own instance signature.+ length :: forall (a :: Type). Proxy a -> Natural+ length _ = 0++ null :: forall (a :: Type). Proxy a -> Bool+ null _ = True++ elem _ _ = False+ sum _ = 0+ product _ = 1++ instance Foldable Dual where+ foldMap f (Dual x) = f x++ elem = (. getDual) . (==)+ foldl f z (Dual x) = f z x+ foldl' f z (Dual x) = f z x+ foldl1 _ = getDual+ foldr f z (Dual x) = f x z+ foldr' = foldr+ foldr1 _ = getDual+ length _ = 1+ maximum = getDual+ minimum = getDual+ null _ = False+ product = getDual+ sum = getDual+ toList (Dual x) = [x]++ instance Foldable Monoid.Sum where+ foldMap f (Monoid.Sum x) = f x++ elem = (. getSum) . (==)+ foldl f z (Monoid.Sum x) = f z x+ foldl' f z (Monoid.Sum x) = f z x+ foldl1 _ = getSum+ foldr f z (Monoid.Sum x) = f x z+ foldr' = foldr+ foldr1 _ = getSum+ length _ = 1+ maximum = getSum+ minimum = getSum+ null _ = False+ product = getSum+ sum = getSum+ toList (Monoid.Sum x) = [x]++ instance Foldable Monoid.Product where+ foldMap f (Monoid.Product x) = f x++ elem = (. getProduct) . (==)+ foldl f z (Monoid.Product x) = f z x+ foldl' f z (Monoid.Product x) = f z x+ foldl1 _ = getProduct+ foldr f z (Monoid.Product x) = f x z+ foldr' = foldr+ foldr1 _ = getProduct+ length _ = 1+ maximum = getProduct+ minimum = getProduct+ null _ = False+ product = getProduct+ sum = getProduct+ 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 ())++ -- Note that in the type signatures for `asum` and `msum` below, we explicitly+ -- annotate `f` and `m` with the kind (Type -> Type), which is not something+ -- that is done in the original base library. This is because when+ -- singletons-th promotes type signatures, it omits constraints such as+ -- `Alternative f` and `MonadPlus m`, which are essential for inferring that+ -- `f` and `m` are of kind `Type -> Type`. Without these constraints, we may+ -- end up with a promoted definition that looks like this:+ --+ -- type Asum :: t (f a) -> f a+ --+ -- This will result in Asum having a more polymorphic kind than intended,+ -- since GHC will generalize Asum's kind to:+ --+ -- type Asum :: forall {j} {k} (t :: k -> Type) (f :: j -> k) (a :: j). t (f a) -> f a+ --+ -- Annotating `f :: Type -> Type` (and similarly for `m`) is a clunky but+ -- reliable way of preventing this. See also Note [Using standalone kind+ -- signatures not present in the base library] in+ -- Control.Monad.Singletons.Internal for a similar situation where class+ -- definitions can become overly polymorphic unless given an explicit kind.++ -- -| The sum of a collection of actions, generalizing 'concat'.+ --+ -- asum [Just "Hello", Nothing, Just "World"]+ -- Just "Hello"+ asum :: forall t (f :: Type -> Type) a. (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 :: forall t (m :: Type -> Type) a. (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 = getAll . foldMap all_++ -- -| '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 = getAny . foldMap any_++ -- -| Determines whether any element of the structure satisfies the predicate.+ any :: Foldable t => (a -> Bool) -> t a -> Bool+ any p = getAny . foldMap (any_ . p)++ -- -| Determines whether all elements of the structure satisfy the predicate.+ all :: Foldable t => (a -> Bool) -> t a -> Bool+ all p = getAll . foldMap (all_ . p)++ -- -| 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 = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))+ |])++$(singletonsOnly [d|+ -- instances for Prelude types (part 2)++ deriving instance Foldable ((,) a)+ deriving instance Foldable First+ deriving instance Foldable Last+ |])
src/Data/Function/Singletons.hs view
@@ -1,117 +1,117 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Function.Singletons --- 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. --- ----------------------------------------------------------------------------- - -module Data.Function.Singletons ( - -- * "Prelude" re-exports - Id, sId, Const, sConst, type (.), (%.), 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.TH -import GHC.Base.Singletons - -$(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 & - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Function.Singletons+-- 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.+--+----------------------------------------------------------------------------++module Data.Function.Singletons (+ -- * "Prelude" re-exports+ Id, sId, Const, sConst, type (.), (%.), 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.TH+import GHC.Base.Singletons++$(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 &+ |])
src/Data/Functor/Compose/Singletons.hs view
@@ -1,92 +1,84 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Compose.Singletons --- Copyright : (C) 2021 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 'Compose' data type. --- ------------------------------------------------------------------------------ - -module Data.Functor.Compose.Singletons ( - -- * The 'Compose' singleton - Sing, SCompose(..), GetCompose, sGetCompose, - - -- * Defunctionalization symbols - ComposeSym0, ComposeSym1, - GetComposeSym0, GetComposeSym1 - ) where - -import Control.Applicative -import Control.Applicative.Singletons -import Data.Foldable.Singletons -import Data.Functor.Compose -import Data.Functor.Singletons -import Data.Kind -import Data.Singletons -import Data.Singletons.TH -import Data.Traversable.Singletons - -{- -In order to keep the type arguments to Compose poly-kinded and with inferred -specificities, we define the singleton version of Compose, as well as its -defunctionalization symbols, by hand. This is very much in the spirit of the -code in Data.Functor.Const.Singletons. (See the comments above SConst in that -module for more details on this choice.) --} -infixr 9 `SCompose` -type SCompose :: Compose f g a -> Type -data SCompose :: Compose f g a -> Type where - SCompose :: forall f g a (x :: f (g a)). - Sing x -> SCompose ('Compose @f @g @a x) -type instance Sing = SCompose -instance SingI x => SingI ('Compose x) where - sing = SCompose sing -instance SingI1 'Compose where - liftSing = SCompose - -infixr 9 `ComposeSym0` -type ComposeSym0 :: f (g a) ~> Compose f g a -data ComposeSym0 z -type instance Apply ComposeSym0 x = 'Compose x -instance SingI ComposeSym0 where - sing = singFun1 SCompose - -infixr 9 `ComposeSym1` -type ComposeSym1 :: f (g a) -> Compose f g a -type family ComposeSym1 x where - ComposeSym1 x = 'Compose x - -$(singletonsOnly [d| - getCompose :: Compose f g a -> f (g a) - getCompose (Compose x) = x - - instance (Functor f, Functor g) => Functor (Compose f g) where - fmap f (Compose x) = Compose (fmap (fmap f) x) - a <$ (Compose x) = Compose (fmap (a <$) x) - - instance (Foldable f, Foldable g) => Foldable (Compose f g) where - foldMap f (Compose t) = foldMap (foldMap f) t - - instance (Traversable f, Traversable g) => Traversable (Compose f g) where - traverse f (Compose t) = Compose <$> traverse (traverse f) t - - instance (Applicative f, Applicative g) => Applicative (Compose f g) where - pure x = Compose (pure (pure x)) - Compose f <*> Compose x = Compose (liftA2 (<*>) f x) - liftA2 f (Compose x) (Compose y) = - Compose (liftA2 (liftA2 f) x y) - - instance (Alternative f, Applicative g) => Alternative (Compose f g) where - empty = Compose empty - Compose x <|> Compose y = Compose (x <|> y) - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Compose.Singletons+-- Copyright : (C) 2021 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 'Compose' data type.+--+-----------------------------------------------------------------------------++module Data.Functor.Compose.Singletons (+ -- * The 'Compose' singleton+ Sing, SCompose(..), GetCompose, sGetCompose,++ -- * Defunctionalization symbols+ ComposeSym0, ComposeSym1,+ GetComposeSym0, GetComposeSym1+ ) where++import Control.Applicative+import Control.Applicative.Singletons+import Data.Eq.Singletons+import Data.Foldable.Singletons+import Data.Functor.Compose+import Data.Functor.Singletons+import Data.Ord.Singletons+import Data.Kind+import Data.Semigroup.Singletons+import Data.Singletons.Base.Instances (SList(..), (:@#@$), NilSym0)+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Data.Traversable.Singletons++$(withOptions defaultOptions{genSingKindInsts = False}+ (genSingletons [''Compose]))++$(singletonsOnly [d|+ deriving instance Eq (f (g a)) => Eq (Compose f g a)+ deriving instance Ord (f (g a)) => Ord (Compose f g a)++ -- Note that in the instances below, we explicitly annotate `f` with its kind+ -- (Type -> Type), which is not something that is done in the original base+ -- library. This is because when singletons-th promotes instance declarations,+ -- it omits the instance contexts. As such, the instance declarations (as well+ -- as the associated defunctionalization symbols) would be given overly+ -- polymorphic kinds due to kind generalization, e.g.,+ --+ -- instance PFunctor (Compose (f :: k -> Type) (g :: Type -> k)) where ...+ --+ -- Annotating `f :: Type -> Type` is a clunky but reliable way of preventing+ -- this. See also Note [Using standalone kind signatures not present in the+ -- base library] in Control.Monad.Singletons.Internal for a similar situation+ -- where class definitions can become overly polymorphic unless given an+ -- explicit kind.++ instance (Functor f, Functor g) => Functor (Compose (f :: Type -> Type) g) where+ fmap f (Compose x) = Compose (fmap (fmap f) x)+ a <$ (Compose x) = Compose (fmap (a <$) x)++ instance (Foldable f, Foldable g) => Foldable (Compose (f :: Type -> Type) g) where+ foldMap f (Compose t) = foldMap (foldMap f) t++ instance (Traversable f, Traversable g) => Traversable (Compose (f :: Type -> Type) g) where+ traverse f (Compose t) = Compose <$> traverse (traverse f) t++ instance (Applicative f, Applicative g) => Applicative (Compose (f :: Type -> Type) g) where+ pure x = Compose (pure (pure x))+ Compose f <*> Compose x = Compose (liftA2 (<*>) f x)+ liftA2 f (Compose x) (Compose y) =+ Compose (liftA2 (liftA2 f) x y)++ instance (Alternative f, Applicative g) => Alternative (Compose (f :: Type -> Type) g) where+ empty = Compose empty+ Compose x <|> Compose y = Compose (x <|> y)+ |])
src/Data/Functor/Const/Singletons.hs view
@@ -1,146 +1,101 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Const.Singletons --- 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.Functor.Const.Singletons ( - -- * The 'Const' singleton - Sing, SConst(..), GetConst, sGetConst, - - -- * Defunctionalization symbols - ConstSym0, ConstSym1, - GetConstSym0, GetConstSym1 - ) where - -import Control.Applicative -import Control.Monad.Singletons.Internal -import Data.Eq.Singletons -import Data.Foldable.Singletons -import Data.Kind (Type) -import Data.Monoid.Singletons -import Data.Ord.Singletons -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons -import Data.Singletons.Base.Instances hiding (FoldlSym0, sFoldl) -import Data.Singletons.Base.Enum -import Data.Singletons.TH -import GHC.Base.Singletons - hiding ( Const, ConstSym0, ConstSym1 - , Foldr, FoldrSym0, sFoldr ) -import GHC.Num.Singletons -import Text.Show.Singletons - -{- -Const's argument `b` is poly-kinded, and as a result, we have a choice as to -what singleton type to give it. We could use either - -1. type SConst :: forall {k :: Type} (a :: Type) (b :: k). Const a b -> Type -2. type SConst :: forall (a :: Type) (b :: Type). Const a b -> Type - -Option (1) is the more permissive one, so we opt for that. However, singletons-th's -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 singleton type by -hand. - -Note that we cannot use genSingletons to generate this code because we -would end up with the wrong specificity for the kind of `a` when singling the -Const constructor. See Note [Preserve the order of type variables during -singling] in D.S.TH.Single.Type, wrinkle 2. Similarly, we must define the -defunctionalization symbols for the Const data constructor by hand to get the -specificities right. --} -type SConst :: Const a b -> Type -data SConst :: Const a b -> Type where - SConst :: forall {k} a (b :: k) (x :: a). - Sing x -> SConst ('Const @a @b x) -type instance Sing = SConst -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 -instance SingI1 'Const where - liftSing = SConst - -type ConstSym0 :: a ~> Const a b -data ConstSym0 z -type instance Apply ConstSym0 x = 'Const x -instance SingI ConstSym0 where - sing = singFun1 SConst - -type ConstSym1 :: a -> Const a b -type family ConstSym1 x where - ConstSym1 x = 'Const x - -$(singletonsOnly [d| - getConst :: Const a b -> a - getConst (Const x) = x - - 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) - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Const.Singletons+-- 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.Functor.Const.Singletons (+ -- * The 'Const' singleton+ Sing, SConst(..), GetConst, sGetConst,++ -- * Defunctionalization symbols+ ConstSym0, ConstSym1,+ GetConstSym0, GetConstSym1+ ) where++import Control.Applicative+import Control.Monad.Singletons.Internal+import Data.Eq.Singletons+import Data.Foldable.Singletons+import Data.Monoid.Singletons+import Data.Ord.Singletons+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons.Base.Instances hiding (FoldlSym0, sFoldl)+import Data.Singletons.Base.Enum+import Data.Singletons.TH+import Data.Singletons.TH.Options+import GHC.Base.Singletons+ hiding ( Const, ConstSym0, ConstSym1+ , Foldr, FoldrSym0, sFoldr )+import GHC.Num.Singletons+import Text.Show.Singletons++$(withOptions defaultOptions{genSingKindInsts = False}+ (genSingletons [''Const]))++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++$(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/Functor/Identity/Singletons.hs view
@@ -1,107 +1,107 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Identity.Singletons --- 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.Functor.Identity.Singletons ( - -- * The 'Identity' singleton - Sing, SIdentity(..), RunIdentity, sRunIdentity, - - -- * Defunctionalization symbols - IdentitySym0, IdentitySym1, - RunIdentitySym0, RunIdentitySym1 - ) where - -import Control.Monad.Singletons.Internal -import Data.Eq.Singletons -import Data.Foldable (Foldable(..)) -import Data.Foldable.Singletons -import Data.Functor.Identity -import Data.Monoid.Singletons -import Data.Ord.Singletons -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons.Base.Instances hiding (Foldl, sFoldl) -import Data.Singletons.Base.Enum -import Data.Singletons.TH -import GHC.Base.Singletons hiding (Foldr, FoldrSym0, sFoldr) -import GHC.Num.Singletons -import Text.Show.Singletons - -$(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 - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Identity.Singletons+-- 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.Functor.Identity.Singletons (+ -- * The 'Identity' singleton+ Sing, SIdentity(..), RunIdentity, sRunIdentity,++ -- * Defunctionalization symbols+ IdentitySym0, IdentitySym1,+ RunIdentitySym0, RunIdentitySym1+ ) where++import Control.Monad.Singletons.Internal+import Data.Eq.Singletons+import Data.Foldable (Foldable(..))+import Data.Foldable.Singletons+import Data.Functor.Identity+import Data.Monoid.Singletons+import Data.Ord.Singletons+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons.Base.Instances hiding (Foldl, sFoldl)+import Data.Singletons.Base.Enum+import Data.Singletons.TH+import GHC.Base.Singletons hiding (Foldr, FoldrSym0, sFoldr)+import GHC.Num.Singletons+import Text.Show.Singletons++$(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/Functor/Product/Singletons.hs view
@@ -1,112 +1,110 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Product.Singletons --- Copyright : (C) 2021 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 'Product' data type. --- ------------------------------------------------------------------------------ - -module Data.Functor.Product.Singletons ( - -- * The 'Product' singleton - Sing, SProduct(..), - - -- * Defunctionalization symbols - PairSym0, PairSym1, PairSym2 - ) where - -import Control.Applicative -import Control.Applicative.Singletons -import Control.Monad -import Control.Monad.Singletons -import Control.Monad.Zip -import Control.Monad.Zip.Singletons -import Data.Foldable.Singletons hiding (Product) -import Data.Function.Singletons -import Data.Functor.Product -import Data.Kind -import Data.Monoid.Singletons hiding (SProduct(..)) -import Data.Singletons -import Data.Singletons.TH -import Data.Traversable.Singletons - -{- -In order to keep the type arguments to Product poly-kinded and with inferred -specificities, we define the singleton version of Product, as well as its -defunctionalization symbols, by hand. This is very much in the spirit of the -code in Data.Functor.Const.Singletons. (See the comments above SConst in that -module for more details on this choice.) --} -type SProduct :: Product f g a -> Type -data SProduct :: Product f g a -> Type where - SPair :: forall f g a (x :: f a) (y :: g a). - Sing x -> Sing y -> SProduct ('Pair @f @g @a x y) -type instance Sing = SProduct -instance (SingI x, SingI y) => SingI ('Pair x y) where - sing = SPair sing sing -instance SingI x => SingI1 ('Pair x) where - liftSing = SPair sing -instance SingI2 'Pair where - liftSing2 = SPair - -type PairSym0 :: forall f g a. f a ~> g a ~> Product f g a -data PairSym0 z -type instance Apply PairSym0 x = PairSym1 x -instance SingI PairSym0 where - sing = singFun2 SPair - -type PairSym1 :: forall f g a. f a -> g a ~> Product f g a -data PairSym1 fa z -type instance Apply (PairSym1 x) y = 'Pair x y -instance SingI x => SingI (PairSym1 x) where - sing = singFun1 $ SPair (sing @x) -instance SingI1 PairSym1 where - liftSing s = singFun1 $ SPair s - -type PairSym2 :: forall f g a. f a -> g a -> Product f g a -type family PairSym2 x y where - PairSym2 x y = 'Pair x y - -$(singletonsOnly [d| - instance (Functor f, Functor g) => Functor (Product f g) where - fmap f (Pair x y) = Pair (fmap f x) (fmap f y) - a <$ (Pair x y) = Pair (a <$ x) (a <$ y) - - instance (Foldable f, Foldable g) => Foldable (Product f g) where - foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y - - instance (Traversable f, Traversable g) => Traversable (Product f g) where - traverse f (Pair x y) = liftA2 Pair (traverse f x) (traverse f y) - - instance (Applicative f, Applicative g) => Applicative (Product f g) where - pure x = Pair (pure x) (pure x) - Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y) - liftA2 f (Pair a b) (Pair x y) = Pair (liftA2 f a x) (liftA2 f b y) - - instance (Alternative f, Alternative g) => Alternative (Product f g) where - empty = Pair empty empty - Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2) - - instance (Monad f, Monad g) => Monad (Product f g) where - Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f) - where - fstP (Pair a _) = a - sndP (Pair _ b) = b - - instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where - mzero = Pair mzero mzero - Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2) - - instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where - mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2) - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Product.Singletons+-- Copyright : (C) 2021 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 'Product' data type.+--+-----------------------------------------------------------------------------++module Data.Functor.Product.Singletons (+ -- * The 'Product' singleton+ Sing, SProduct(..),++ -- * Defunctionalization symbols+ PairSym0, PairSym1, PairSym2+ ) where++import Control.Applicative+import Control.Applicative.Singletons+import Control.Monad+import Control.Monad.Singletons+import Control.Monad.Zip+import Control.Monad.Zip.Singletons+import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Foldable.Singletons hiding (Product)+import Data.Function.Singletons+import Data.Functor.Product+import Data.Kind+import Data.Monoid.Singletons hiding (SProduct(..))+import Data.Semigroup.Singletons hiding (SProduct(..))+import Data.Singletons.Base.Instances (SList(..), (:@#@$), NilSym0)+import Data.Ord.Singletons+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Data.Traversable.Singletons++$(withOptions defaultOptions{genSingKindInsts = False}+ (genSingletons [''Product]))++$(singletonsOnly [d|+ deriving instance (Eq (f a), Eq (g a)) => Eq (Product f g a)+ deriving instance (Ord (f a), Ord (g a)) => Ord (Product f g a)++ instance (Functor f, Functor g) => Functor (Product f g) where+ fmap f (Pair x y) = Pair (fmap f x) (fmap f y)+ a <$ (Pair x y) = Pair (a <$ x) (a <$ y)++ instance (Foldable f, Foldable g) => Foldable (Product f g) where+ foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y++ instance (Traversable f, Traversable g) => Traversable (Product f g) where+ traverse f (Pair x y) = liftA2 Pair (traverse f x) (traverse f y)++ instance (Applicative f, Applicative g) => Applicative (Product f g) where+ pure x = Pair (pure x) (pure x)+ Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y)+ liftA2 f (Pair a b) (Pair x y) = Pair (liftA2 f a x) (liftA2 f b y)++ instance (Monad f, Monad g) => Monad (Product f g) where+ Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f)+ where+ fstP (Pair a _) = a+ sndP (Pair _ b) = b++ instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where+ mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)++ -- Note that in the instances below, we explicitly annotate `f` with its kind+ -- (Type -> Type), which is not something that is done in the original base+ -- library. This is because when singletons-th promotes instance declarations,+ -- it omits the instance contexts when generating the helper type families.+ -- This can lead to the helper type families having overly polymorphic kinds.+ -- For example, if the Alternative instance below lacked the explicit+ -- (f :: Type -> Type) kind signature, the generated code would look like:+ --+ -- instance PAlternative (Product f g) where+ -- type Empty = EmptyHelper+ -- ...+ --+ -- type EmptyHelper :: forall f g a. Product f g a+ --+ -- This will result in EmptyHelper having a more polymorphic kind than+ -- intended, since GHC will generalize EmptyHelper's kind to:+ --+ -- type EmptyHelper :: forall {k} (f :: k -> Type) (g :: k -> Type) (a :: k). Product f g a+ --+ -- Annotating `f :: Type -> Type` is a clunky but reliable way of preventing+ -- this. See also Note [Using standalone kind signatures not present in the+ -- base library] in Control.Monad.Singletons.Internal for a similar situation+ -- where class definitions can become overly polymorphic unless given an+ -- explicit kind.+ instance (Alternative f, Alternative g) => Alternative (Product (f :: Type -> Type) g) where+ empty = Pair empty empty+ Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2)++ instance (MonadPlus f, MonadPlus g) => MonadPlus (Product (f :: Type -> Type) g) where+ mzero = Pair mzero mzero+ Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2)+ |])
src/Data/Functor/Singletons.hs view
@@ -1,194 +1,194 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Singletons --- 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.Functor.Singletons ( - 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 Control.Monad.Singletons.Internal -import Data.Ord (Down(..)) -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH hiding (Void) -import GHC.Base.Singletons - -$(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 - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Singletons+-- 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.Functor.Singletons (+ 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 Control.Monad.Singletons.Internal+import Data.Ord (Down(..))+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH hiding (Void)+import GHC.Base.Singletons++$(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+ |])
src/Data/Functor/Sum/Singletons.hs view
@@ -1,95 +1,62 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Sum.Singletons --- Copyright : (C) 2021 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 'Sum' data type. --- ------------------------------------------------------------------------------ - -module Data.Functor.Sum.Singletons ( - -- * The 'Product' singleton - Sing, SSum(..), - - -- * Defunctionalization symbols - InLSym0, InLSym1, - InRSym0, InRSym1, - ) where - -import Data.Foldable.Singletons hiding (Sum) -import Data.Functor.Singletons -import Data.Functor.Sum -import Data.Kind -import Data.Singletons -import Data.Singletons.TH -import Data.Traversable.Singletons - -{- -In order to keep the type arguments to Sum poly-kinded and with inferred -specificities, we define the singleton version of Sum, as well as its -defunctionalization symbols, by hand. This is very much in the spirit of the -code in Data.Functor.Const.Singletons. (See the comments above SConst in that -module for more details on this choice.) --} -type SSum :: Sum f g a -> Type -data SSum :: Sum f g a -> Type where - SInL :: forall f g a (x :: f a). - Sing x -> SSum ('InL @f @g @a x) - SInR :: forall f g a (y :: g a). - Sing y -> SSum ('InR @f @g @a y) -type instance Sing = SSum -instance SingI x => SingI ('InL x) where - sing = SInL sing -instance SingI1 'InL where - liftSing = SInL -instance SingI y => SingI ('InR y) where - sing = SInR sing -instance SingI1 'InR where - liftSing = SInR - -type InLSym0 :: forall f g a. f a ~> Sum f g a -data InLSym0 z -type instance Apply InLSym0 x = 'InL x -instance SingI InLSym0 where - sing = singFun1 SInL - -type InLSym1 :: forall f g a. f a -> Sum f g a -type family InLSym1 x where - InLSym1 x = 'InL x - -type InRSym0 :: forall f g a. g a ~> Sum f g a -data InRSym0 z -type instance Apply InRSym0 y = 'InR y -instance SingI InRSym0 where - sing = singFun1 SInR - -type InRSym1 :: forall f g a. g a -> Sum f g a -type family InRSym1 x where - InRSym1 y = 'InR y - -$(singletonsOnly [d| - instance (Functor f, Functor g) => Functor (Sum f g) where - fmap f (InL x) = InL (fmap f x) - fmap f (InR y) = InR (fmap f y) - - a <$ (InL x) = InL (a <$ x) - a <$ (InR y) = InR (a <$ y) - - instance (Foldable f, Foldable g) => Foldable (Sum f g) where - foldMap f (InL x) = foldMap f x - foldMap f (InR y) = foldMap f y - - instance (Traversable f, Traversable g) => Traversable (Sum f g) where - traverse f (InL x) = InL <$> traverse f x - traverse f (InR y) = InR <$> traverse f y - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor.Sum.Singletons+-- Copyright : (C) 2021 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 'Sum' data type.+--+-----------------------------------------------------------------------------++module Data.Functor.Sum.Singletons (+ -- * The 'Product' singleton+ Sing, SSum(..),++ -- * Defunctionalization symbols+ InLSym0, InLSym1,+ InRSym0, InRSym1,+ ) where++import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Foldable.Singletons hiding (Sum)+import Data.Functor.Singletons+import Data.Functor.Sum+import Data.Ord.Singletons+import Data.Semigroup.Singletons hiding (SSum(..))+import Data.Singletons.Base.Instances (SList(..), (:@#@$), NilSym0)+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Data.Traversable.Singletons++$(withOptions defaultOptions{genSingKindInsts = False}+ (genSingletons [''Sum]))++$(singletonsOnly [d|+ deriving instance (Eq (f a), Eq (g a)) => Eq (Sum f g a)+ deriving instance (Ord (f a), Ord (g a)) => Ord (Sum f g a)++ instance (Functor f, Functor g) => Functor (Sum f g) where+ fmap f (InL x) = InL (fmap f x)+ fmap f (InR y) = InR (fmap f y)++ a <$ (InL x) = InL (a <$ x)+ a <$ (InR y) = InR (a <$ y)++ instance (Foldable f, Foldable g) => Foldable (Sum f g) where+ foldMap f (InL x) = foldMap f x+ foldMap f (InR y) = foldMap f y++ instance (Traversable f, Traversable g) => Traversable (Sum f g) where+ traverse f (InL x) = InL <$> traverse f x+ traverse f (InR y) = InR <$> traverse f y+ |])
src/Data/List/NonEmpty/Singletons.hs view
@@ -1,519 +1,519 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.List.NonEmpty.Singletons --- 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 singled versions 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.List.NonEmpty.Singletons ( - -- * The 'NonEmpty' singleton - Sing, SNonEmpty(..), - - -- * 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 Control.Monad.Zip.Singletons -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Function.Singletons -import Data.List.NonEmpty -import Data.List.Singletons.Internal.Disambiguation -import Data.Maybe.Singletons -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Function -import Data.Ord -import Data.Singletons.TH -import GHC.Base.Singletons hiding ( MapSym0, MapSym1, MapSym2, Map, sMap ) -import GHC.Num.Singletons -import GHC.TypeLits.Singletons - -$(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 -> Natural - 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 - - -- -| 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 :: Natural -> NonEmpty a -> [a] - take n = listtake n . toList - - -- -| @'drop' n xs@ drops the first @n@ elements off the front of - -- the sequence @xs@. - drop :: Natural -> 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 :: Natural -> 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 -> Natural -> 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 - - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.List.NonEmpty.Singletons+-- 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 singled versions 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.List.NonEmpty.Singletons (+ -- * The 'NonEmpty' singleton+ Sing, SNonEmpty(..),++ -- * 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 Control.Monad.Zip.Singletons+import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Function.Singletons+import Data.List.NonEmpty+import Data.List.Singletons.Internal.Disambiguation+import Data.Maybe.Singletons+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Function+import Data.Ord+import Data.Singletons.TH+import GHC.Base.Singletons hiding ( MapSym0, MapSym1, MapSym2, Map, sMap )+import GHC.Num.Singletons+import GHC.TypeLits.Singletons++$(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 -> Natural+ 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++ -- -| 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 :: Natural -> NonEmpty a -> [a]+ take n = listtake n . toList++ -- -| @'drop' n xs@ drops the first @n@ elements off the front of+ -- the sequence @xs@.+ drop :: Natural -> 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 :: Natural -> 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 -> Natural -> 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/List/Singletons.hs view
@@ -1,281 +1,279 @@-{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.List.Singletons --- 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 singled versions 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.List.Singletons ( - -- * The singleton for lists - Sing, SList(..), - - -- * 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, - - -- * 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 - ) where - -import Data.Foldable.Singletons -import Data.Singletons.Base.Instances - (Sing, SList(..), NilSym0, type (:@#@$), type (:@#@$$), type (:@#@$$$)) -import Data.Traversable.Singletons -import GHC.Base.Singletons - ( Map, MapSym0, MapSym1, MapSym2, sMap - , type (++), type (++@#@$), type (++@#@$$), type (++@#@$$$), (%++) - ) - -import Data.List.Singletons.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 - ) +-----------------------------------------------------------------------------+-- |+-- Module : Data.List.Singletons+-- 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 singled versions 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.List.Singletons (+ -- * The singleton for lists+ Sing, SList(..),++ -- * 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,++ -- * 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+ ) where++import Data.Foldable.Singletons+import Data.Singletons.Base.Instances+ (Sing, SList(..), NilSym0, type (:@#@$), type (:@#@$$), type (:@#@$$$))+import Data.Traversable.Singletons+import GHC.Base.Singletons+ ( Map, MapSym0, MapSym1, MapSym2, sMap+ , type (++), type (++@#@$), type (++@#@$$), type (++@#@$$$), (%++)+ )++import Data.List.Singletons.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/List/Singletons/Internal.hs view
@@ -1,641 +1,641 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -O0 #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.List.Singletons.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 singled versions of a few of the definitions in @Data.List@. --- --- All of the functions defined in this module are specialized for lists, --- unlike "Data.List.Singletons", which uses 'Foldable' and --- 'Traversable' contexts when available. --- ----------------------------------------------------------------------------- - -module Data.List.Singletons.Internal where - -import Control.Monad.Singletons.Internal -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Maybe -import Data.Maybe.Singletons -import Data.Ord.Singletons -import Data.Semigroup.Singletons.Internal.Classes (SSemigroup(..), type (<>@#@$)) -import Data.Semigroup.Singletons.Internal.Wrappers () -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import Data.Tuple.Singletons -import GHC.Base.Singletons -import GHC.Num.Singletons -import GHC.TypeLits.Singletons - -$(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 - - 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 Natural - elemIndex x = findIndex (x==) - - elemIndices :: Eq a => a -> [a] -> [Natural] - elemIndices x = findIndices (x==) - - findIndex :: (a -> Bool) -> [a] -> Maybe Natural - 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] -> [Natural] - findIndices p xs = map snd (filter (\(x,_) -> p x) - (zip xs (buildList 0 xs))) - where buildList :: Natural -> [b] -> [Natural] - 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 :: Natural -> [a] -> [a] - take _ [] = [] - take n (x:xs) = if n == 0 then [] else x : take (n-1) xs - - drop :: Natural -> [a] -> [a] - drop _ [] = [] - drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs - - splitAt :: Natural -> [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] -> Natural - 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 :: Natural -> 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] -> Natural -> 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 - - |]) - --- 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 _ _ _ _ _ _ _ _ = [] - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -O0 #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.List.Singletons.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 singled versions of a few of the definitions in @Data.List@.+--+-- All of the functions defined in this module are specialized for lists,+-- unlike "Data.List.Singletons", which uses 'Foldable' and+-- 'Traversable' contexts when available.+--+----------------------------------------------------------------------------++module Data.List.Singletons.Internal where++import Control.Monad.Singletons.Internal+import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Maybe+import Data.Maybe.Singletons+import Data.Ord.Singletons+import Data.Semigroup.Singletons.Internal.Classes (SSemigroup(..), type (<>@#@$))+import Data.Semigroup.Singletons.Internal.Wrappers ()+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import Data.Tuple.Singletons+import GHC.Base.Singletons+import GHC.Num.Singletons+import GHC.TypeLits.Singletons++$(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++ 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 Natural+ elemIndex x = findIndex (x==)++ elemIndices :: Eq a => a -> [a] -> [Natural]+ elemIndices x = findIndices (x==)++ findIndex :: (a -> Bool) -> [a] -> Maybe Natural+ 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] -> [Natural]+ findIndices p xs = map snd (filter (\(x,_) -> p x)+ (zip xs (buildList 0 xs)))+ where buildList :: Natural -> [b] -> [Natural]+ 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 :: Natural -> [a] -> [a]+ take _ [] = []+ take n (x:xs) = if n == 0 then [] else x : take (n-1) xs++ drop :: Natural -> [a] -> [a]+ drop _ [] = []+ drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs++ splitAt :: Natural -> [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] -> Natural+ 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 :: Natural -> 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] -> Natural -> 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++ |])++-- 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 _ _ _ _ _ _ _ _ = []+ |])
src/Data/List/Singletons/Internal/Disambiguation.hs view
@@ -1,171 +1,171 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.List.Singletons.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. :( --- ----------------------------------------------------------------------------- - -module Data.List.Singletons.Internal.Disambiguation where - -import Data.Eq.Singletons -import Data.List ( foldl', inits, insert, intersperse, isPrefixOf - , nubBy, partition, sort, sortBy, tails, transpose ) -import Data.List.Singletons.Internal -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import GHC.Base.Singletons -import GHC.Num.Singletons -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 :: Natural -> [a] -> [a] - listtake = take - - listdrop :: Natural -> [a] -> [a] - listdrop = drop - - listsplitAt :: Natural -> [a] -> ([a], [a]) - listsplitAt = splitAt - - listindex :: [a] -> Natural -> a - listindex = (!!) - - listlength :: [a] -> Nat - listlength = length - |]) - -listtake :: Natural -> [a] -> [a] -listtake = undefined - -listdrop :: Natural -> [a] -> [a] -listdrop = undefined - -listsplitAt :: Natural -> [a] -> ([a], [a]) -listsplitAt = undefined - -listindex :: [a] -> Natural -> a -listindex = undefined - -listlength :: [a] -> Nat -listlength = undefined +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.List.Singletons.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. :(+--+----------------------------------------------------------------------------++module Data.List.Singletons.Internal.Disambiguation where++import Data.Eq.Singletons+import Data.List ( inits, insert, intersperse, isPrefixOf+ , nubBy, partition, sort, sortBy, tails, transpose )+import Data.List.Singletons.Internal+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import GHC.Base.Singletons+import GHC.Num.Singletons+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 :: Natural -> [a] -> [a]+ listtake = take++ listdrop :: Natural -> [a] -> [a]+ listdrop = drop++ listsplitAt :: Natural -> [a] -> ([a], [a])+ listsplitAt = splitAt++ listindex :: [a] -> Natural -> a+ listindex = (!!)++ listlength :: [a] -> Nat+ listlength = length+ |])++listtake :: Natural -> [a] -> [a]+listtake = undefined++listdrop :: Natural -> [a] -> [a]+listdrop = undefined++listsplitAt :: Natural -> [a] -> ([a], [a])+listsplitAt = undefined++listindex :: [a] -> Natural -> a+listindex = undefined++listlength :: [a] -> Nat+listlength = undefined
src/Data/Maybe/Singletons.hs view
@@ -1,122 +1,122 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Maybe.Singletons --- 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 singled versions 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.Maybe.Singletons ( - -- The 'Maybe' singleton - Sing, SMaybe(..), - - -- * 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.Base.Instances -import Data.Singletons.TH -import GHC.TypeLits.Singletons - -$(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 - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Maybe.Singletons+-- 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 singled versions 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.Maybe.Singletons (+ -- The 'Maybe' singleton+ Sing, SMaybe(..),++ -- * 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.Base.Instances+import Data.Singletons.TH+import GHC.TypeLits.Singletons++$(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/Monoid/Singletons.hs view
@@ -1,205 +1,205 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Monoid.Singletons --- 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.Monoid.Singletons ( - PMonoid(..), SMonoid(..), - - Sing, SDual(..), SAll(..), SAny(..), - SSum(..), SProduct(..), SFirst(..), SLast(..), - GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast, - sGetDual, sGetAll, sGetAny, sGetSum, sGetProduct, sGetFirst, sGetLast, - - -- ** 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 Control.Monad.Singletons.Internal -import Data.Eq.Singletons -import Data.Monoid (First(..), Last(..)) -import Data.Ord (Down(..)) -import Data.Ord.Singletons -import Data.Semigroup hiding (First(..), Last(..)) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Semigroup.Singletons.Internal.Wrappers hiding - (SFirst, SLast, - FirstSym0, FirstSym1, FirstSym0KindInference, - LastSym0, LastSym1, LastSym0KindInference, - GetFirst, sGetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference, - GetLast, sGetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference) -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH -import GHC.Base.Singletons -import GHC.Num.Singletons -import GHC.TypeLits (Symbol) -import Text.Show.Singletons - -$(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 - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Monoid.Singletons+-- 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.Monoid.Singletons (+ PMonoid(..), SMonoid(..),++ Sing, SDual(..), SAll(..), SAny(..),+ SSum(..), SProduct(..), SFirst(..), SLast(..),+ GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast,+ sGetDual, sGetAll, sGetAny, sGetSum, sGetProduct, sGetFirst, sGetLast,++ -- ** 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 Control.Monad.Singletons.Internal+import Data.Eq.Singletons+import Data.Monoid (First(..), Last(..))+import Data.Ord (Down(..))+import Data.Ord.Singletons+import Data.Semigroup hiding (First(..), Last(..))+import Data.Semigroup.Singletons.Internal.Classes+import Data.Semigroup.Singletons.Internal.Wrappers hiding+ (SFirst, SLast,+ FirstSym0, FirstSym1, FirstSym0KindInference,+ LastSym0, LastSym1, LastSym0KindInference,+ GetFirst, sGetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference,+ GetLast, sGetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference)+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH+import GHC.Base.Singletons+import GHC.Num.Singletons+import GHC.TypeLits (Symbol)+import Text.Show.Singletons++$(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/Ord/Singletons.hs view
@@ -1,102 +1,102 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Ord.Singletons --- 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.Ord.Singletons ( - POrd(..), SOrd(..), - - Comparing, sComparing, - - Sing, SOrdering(..), SDown(..), GetDown, sGetDown, - - -- ** Defunctionalization symbols - 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, - GetDownSym0, GetDownSym1 - ) where - -import Data.Eq.Singletons -import Data.Ord (Down(..)) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH - -$(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) - |]) - -$(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 - - -- deriving newtype instance Semigroup a => Semigroup (Down a) - instance Semigroup a => Semigroup (Down a) where - Down a <> Down b = Down (a <> b) - |]) - -$(singOrdInstances basicTypes) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Ord.Singletons+-- 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.Ord.Singletons (+ POrd(..), SOrd(..),++ Comparing, sComparing,++ Sing, SOrdering(..), SDown(..), GetDown, sGetDown,++ -- ** Defunctionalization symbols+ 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,+ GetDownSym0, GetDownSym1+ ) where++import Data.Eq.Singletons+import Data.Ord (Down(..))+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH++$(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)+ |])++$(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++ -- deriving newtype instance Semigroup a => Semigroup (Down a)+ instance Semigroup a => Semigroup (Down a) where+ Down a <> Down b = Down (a <> b)+ |])++$(singOrdInstances basicTypes)
src/Data/Ord/Singletons/Disambiguation.hs view
@@ -1,33 +1,33 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Ord.Singletons.Disambiguation --- Copyright : (C) 2019 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Provides aliases for 'Min' and 'Max' that do not clash with the data --- types of the same names in "Data.Semigroup.Singletons". --- ----------------------------------------------------------------------------- - -module Data.Ord.Singletons.Disambiguation where - -import Data.Ord.Singletons -import Data.Singletons.TH - --- We need these in Data.Semigroup.Singletons, 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. -$(singletons [d| - min_, max_ :: Ord a => a -> a -> a - min_ = min - max_ = max - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Ord.Singletons.Disambiguation+-- Copyright : (C) 2019 Ryan Scott+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Provides aliases for 'Min' and 'Max' that do not clash with the data+-- types of the same names in "Data.Semigroup.Singletons".+--+----------------------------------------------------------------------------++module Data.Ord.Singletons.Disambiguation where++import Data.Ord.Singletons+import Data.Singletons.TH++-- We need these in Data.Semigroup.Singletons, 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.+$(singletons [d|+ min_, max_ :: Ord a => a -> a -> a+ min_ = min+ max_ = max+ |])
src/Data/Proxy/Singletons.hs view
@@ -1,159 +1,150 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Proxy.Singletons --- Copyright : (C) 2020 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) --- Stability : experimental --- Portability : non-portable --- --- Exports promoted and singled versions of the definitions in "Data.Proxy". --- ------------------------------------------------------------------------------ - -module Data.Proxy.Singletons ( - -- * The 'Proxy' singleton - Sing, SProxy(..) - , AsProxyTypeOf, sAsProxyTypeOf - - -- * Defunctionalization symbols - , ProxySym0 - , AsProxyTypeOfSym0, AsProxyTypeOfSym1, AsProxyTypeOfSym2 - ) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Singletons.Internal -import Data.Eq.Singletons -import Data.Kind -import Data.Monoid.Singletons -import Data.Ord.Singletons -import Data.Proxy -import Data.Semigroup (Semigroup(..)) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons.Decide -import Data.Singletons -import Data.Singletons.Base.Enum -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import Data.Type.Coercion -import Data.Type.Equality hiding (type (==)) -import GHC.Base.Singletons -import GHC.Num.Singletons -import GHC.TypeLits.Singletons.Internal -import Text.Show.Singletons - -{- -In order to keep the type argument to Proxy poly-kinded and with an inferred -specificity, we define the singleton version of Proxy, as well as its -defunctionalization symbols, by hand. This is very much in the spirit of the -code in Data.Functor.Const.Singletons. (See the comments above SConst in that -module for more details on this choice.) --} -type SProxy :: Proxy t -> Type -data SProxy :: Proxy t -> Type where - SProxy :: forall t. SProxy ('Proxy @t) -type instance Sing = SProxy -instance SingKind (Proxy t) where - type Demote (Proxy t) = Proxy t - fromSing SProxy = Proxy - toSing Proxy = SomeSing SProxy -instance SingI 'Proxy where - sing = SProxy - -type ProxySym0 :: Proxy t -type family ProxySym0 where - ProxySym0 = 'Proxy - -instance SDecide (Proxy t) where - SProxy %~ SProxy = Proved Refl - -instance TestEquality SProxy where - testEquality = decideEquality - -instance TestCoercion SProxy where - testCoercion = decideCoercion - -instance Show (SProxy z) where - showsPrec _ _ = showString "SProxy" - -$(singletonsOnly [d| - deriving instance Bounded (Proxy s) - - -- It's common to use (undefined :: Proxy t) and (Proxy :: Proxy t) - -- interchangeably, so all of these instances are hand-written to be - -- lazy in Proxy arguments. - - instance Eq (Proxy s) where - _ == _ = True - - instance Ord (Proxy s) where - compare _ _ = EQ - - instance Show (Proxy s) where - showsPrec _ _ = showString "Proxy" - - instance Enum (Proxy s) where - succ _ = errorWithoutStackTrace "Proxy.succ" - pred _ = errorWithoutStackTrace "Proxy.pred" - fromEnum _ = 0 - -- toEnum 0 = Proxy - -- toEnum _ = errorWithoutStackTrace "Proxy.toEnum: 0 expected" - toEnum n = if n == 0 - then Proxy - else errorWithoutStackTrace "Proxy.toEnum: 0 expected" - -- enumFrom _ = [Proxy] - -- enumFromThen _ _ = [Proxy] - enumFromThenTo _ _ _ = [Proxy] - enumFromTo _ _ = [Proxy] - - instance Semigroup (Proxy s) where - _ <> _ = Proxy - sconcat _ = Proxy - -- stimes _ _ = Proxy - - instance Monoid (Proxy s) where - mempty = Proxy - mconcat _ = Proxy - - instance Functor Proxy where - fmap _ _ = Proxy - - instance Applicative Proxy where - pure _ = Proxy - _ <*> _ = Proxy - - instance Alternative Proxy where - empty = Proxy - _ <|> _ = Proxy - - instance Monad Proxy where - _ >>= _ = Proxy - - instance MonadPlus Proxy - - -- -| 'asProxyTypeOf' is a type-restricted version of 'const'. - -- It is usually used as an infix operator, and its typing forces its first - -- argument (which is usually overloaded) to have the same type as the tag - -- of the second. - -- - -- >>> import Data.Word - -- >>> :type asProxyTypeOf 123 (Proxy :: Proxy Word8) - -- asProxyTypeOf 123 (Proxy :: Proxy Word8) :: Word8 - -- - -- Note the lower-case @proxy@ in the definition. This allows any type - -- constructor with just one argument to be passed to the function, for example - -- we could also write - -- - -- >>> import Data.Word - -- >>> :type asProxyTypeOf 123 (Just (undefined :: Word8)) - -- asProxyTypeOf 123 (Just (undefined :: Word8)) :: Word8 - asProxyTypeOf :: a -> proxy a -> a - asProxyTypeOf = const - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Proxy.Singletons+-- Copyright : (C) 2020 Ryan Scott+-- License : BSD-style (see LICENSE)+-- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu)+-- Stability : experimental+-- Portability : non-portable+--+-- Exports promoted and singled versions of the definitions in "Data.Proxy".+--+-----------------------------------------------------------------------------++module Data.Proxy.Singletons (+ -- * The 'Proxy' singleton+ Sing, SProxy(..)+ , AsProxyTypeOf, sAsProxyTypeOf++ -- * Defunctionalization symbols+ , ProxySym0+ , AsProxyTypeOfSym0, AsProxyTypeOfSym1, AsProxyTypeOfSym2+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Singletons.Internal+import Data.Eq.Singletons+import Data.Monoid.Singletons+import Data.Ord.Singletons+import Data.Proxy+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons.Decide+import Data.Singletons.Base.Enum+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Data.Type.Coercion+import Data.Type.Equality hiding (type (==))+import GHC.Base.Singletons+import GHC.Num.Singletons+import GHC.TypeLits.Singletons.Internal+import Text.Show.Singletons++$(withOptions defaultOptions{genSingKindInsts = False}+ (genSingletons [''Proxy]))++instance SingKind (Proxy t) where+ type Demote (Proxy t) = Proxy t+ fromSing SProxy = Proxy+ toSing Proxy = SomeSing SProxy++instance Eq (SProxy z) where+ _ == _ = True++instance SDecide (Proxy t) where+ SProxy %~ SProxy = Proved Refl++instance TestEquality SProxy where+ testEquality = decideEquality++instance TestCoercion SProxy where+ testCoercion = decideCoercion++instance Ord (SProxy z) where+ compare _ _ = EQ++instance Show (SProxy z) where+ showsPrec _ _ = showString "SProxy"++$(singletonsOnly [d|+ deriving instance Bounded (Proxy s)++ -- It's common to use (undefined :: Proxy t) and (Proxy :: Proxy t)+ -- interchangeably, so all of these instances are hand-written to be+ -- lazy in Proxy arguments.++ instance Eq (Proxy s) where+ _ == _ = True++ instance Ord (Proxy s) where+ compare _ _ = EQ++ instance Show (Proxy s) where+ showsPrec _ _ = showString "Proxy"++ instance Enum (Proxy s) where+ succ _ = errorWithoutStackTrace "Proxy.succ"+ pred _ = errorWithoutStackTrace "Proxy.pred"+ fromEnum _ = 0+ -- toEnum 0 = Proxy+ -- toEnum _ = errorWithoutStackTrace "Proxy.toEnum: 0 expected"+ toEnum n = if n == 0+ then Proxy+ else errorWithoutStackTrace "Proxy.toEnum: 0 expected"+ -- enumFrom _ = [Proxy]+ -- enumFromThen _ _ = [Proxy]+ enumFromThenTo _ _ _ = [Proxy]+ enumFromTo _ _ = [Proxy]++ instance Semigroup (Proxy s) where+ _ <> _ = Proxy+ sconcat _ = Proxy+ -- stimes _ _ = Proxy++ instance Monoid (Proxy s) where+ mempty = Proxy+ mconcat _ = Proxy++ instance Functor Proxy where+ fmap _ _ = Proxy++ instance Applicative Proxy where+ pure _ = Proxy+ _ <*> _ = Proxy++ instance Alternative Proxy where+ empty = Proxy+ _ <|> _ = Proxy++ instance Monad Proxy where+ _ >>= _ = Proxy++ instance MonadPlus Proxy++ -- -| 'asProxyTypeOf' is a type-restricted version of 'const'.+ -- It is usually used as an infix operator, and its typing forces its first+ -- argument (which is usually overloaded) to have the same type as the tag+ -- of the second.+ --+ -- >>> import Data.Word+ -- >>> :type asProxyTypeOf 123 (Proxy :: Proxy Word8)+ -- asProxyTypeOf 123 (Proxy :: Proxy Word8) :: Word8+ --+ -- Note the lower-case @proxy@ in the definition. This allows any type+ -- constructor with just one argument to be passed to the function, for example+ -- we could also write+ --+ -- >>> import Data.Word+ -- >>> :type asProxyTypeOf 123 (Just (undefined :: Word8))+ -- asProxyTypeOf 123 (Just (undefined :: Word8)) :: Word8+ asProxyTypeOf :: a -> proxy a -> a+ asProxyTypeOf = const+ |])
src/Data/Semigroup/Singletons.hs view
@@ -1,247 +1,253 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Semigroup.Singletons --- 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.Semigroup.Singletons ( - PSemigroup(..), SSemigroup(..), - - Sing, SMin(..), SMax(..), SFirst(..), SLast(..), - SWrappedMonoid(..), SDual(..), SAll(..), SAny(..), - SSum(..), SProduct(..), SArg(..), - GetMin, GetMax, GetFirst, GetLast, UnwrapMonoid, GetDual, - GetAll, GetAny, GetSum, GetProduct, - sGetMin, sGetMax, sGetFirst, sGetLast, sUnwrapMonoid, sGetDual, - sGetAll, sGetAny, sGetSum, sGetProduct, - - -- ** 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, - ArgSym0, ArgSym1, ArgSym2 - ) where - -import Control.Monad.Singletons.Internal -import Data.Eq.Singletons -import Data.Foldable.Singletons hiding - ( All, AllSym0, AllSym1 - , Any, AnySym0, AnySym1 - , Product, ProductSym0, ProductSym1 - , Sum, SumSym0, SumSym1 ) -import Data.Monoid.Singletons hiding - (SFirst(..), SLast(..), - FirstSym0, FirstSym1, LastSym0, LastSym1, - GetFirst, sGetFirst, GetFirstSym0, GetFirstSym1, - GetLast, sGetLast, GetLastSym0, GetLastSym1) -import Data.Ord.Singletons hiding - (MinSym0, MinSym1, MaxSym0, MaxSym1) -import Data.Ord.Singletons.Disambiguation -import qualified Data.Semigroup as Semi (Min(..), Max(..)) -import Data.Semigroup (First(..), Last(..), WrappedMonoid(..), Arg(..)) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Semigroup.Singletons.Internal.Wrappers -import Data.Singletons.Base.Enum -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH -import Data.Traversable.Singletons -import GHC.Base.Singletons hiding - (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) -import GHC.Num.Singletons -import Text.Show.Singletons - -$(genSingletons [''Arg]) -$(showSingInstances semigroupBasicTypes) -$(singShowInstances 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 - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Semigroup.Singletons+-- 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.Semigroup.Singletons (+ PSemigroup(..), SSemigroup(..),++ Sing, SMin(..), SMax(..), SFirst(..), SLast(..),+ SWrappedMonoid(..), SDual(..), SAll(..), SAny(..),+ SSum(..), SProduct(..), SArg(..),+ GetMin, GetMax, GetFirst, GetLast, UnwrapMonoid, GetDual,+ GetAll, GetAny, GetSum, GetProduct,+ sGetMin, sGetMax, sGetFirst, sGetLast, sUnwrapMonoid, sGetDual,+ sGetAll, sGetAny, sGetSum, sGetProduct,++ -- ** 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,+ ArgSym0, ArgSym1, ArgSym2+ ) where++import Control.Monad.Singletons.Internal+import Data.Eq.Singletons+import Data.Foldable.Singletons hiding+ ( All, AllSym0, AllSym1+ , Any, AnySym0, AnySym1+ , Product, ProductSym0, ProductSym1+ , Sum, SumSym0, SumSym1 )+import Data.Monoid.Singletons hiding+ (SFirst(..), SLast(..),+ FirstSym0, FirstSym1, LastSym0, LastSym1,+ GetFirst, sGetFirst, GetFirstSym0, GetFirstSym1,+ GetLast, sGetLast, GetLastSym0, GetLastSym1)+import Data.Ord.Singletons hiding+ (MinSym0, MinSym1, MaxSym0, MaxSym1)+import Data.Ord.Singletons.Disambiguation+import qualified Data.Semigroup as Semi (Min(..), Max(..))+import Data.Semigroup (First(..), Last(..), WrappedMonoid(..), Arg(..))+import Data.Semigroup.Singletons.Internal.Classes+import Data.Semigroup.Singletons.Internal.Wrappers+import Data.Singletons.Base.Enum+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH+import Data.Traversable.Singletons+import GHC.Base.Singletons hiding+ (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)+import GHC.Num.Singletons+import Text.Show.Singletons++$(genSingletons [''Arg])+$(showSingInstances semigroupBasicTypes)+$(singShowInstances semigroupBasicTypes)++instance Eq (SArg z) where+ _ == _ = True++instance Ord (SArg z) where+ compare _ _ = EQ++$(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+ |])
src/Data/Semigroup/Singletons/Internal/Classes.hs view
@@ -1,117 +1,117 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Semigroup.Singletons.Internal.Classes --- 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 instances thereof for various data --- types in @base@. These are reexported from the "Data.Semigroup" module or --- imported directly by some other modules. --- --- This module exists to avoid import cycles with --- "Data.Ord.Singletons". --- ----------------------------------------------------------------------------- - -module Data.Semigroup.Singletons.Internal.Classes where - -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import GHC.Base.Singletons - -$(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 :: a -> [a] -> a - 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 - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Semigroup.Singletons.Internal.Classes+-- 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 instances thereof for various data+-- types in @base@. These are reexported from the "Data.Semigroup" module or+-- imported directly by some other modules.+--+-- This module exists to avoid import cycles with+-- "Data.Ord.Singletons".+--+----------------------------------------------------------------------------++module Data.Semigroup.Singletons.Internal.Classes where++import Data.List.NonEmpty (NonEmpty(..))+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import GHC.Base.Singletons++$(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 :: a -> [a] -> a+ 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+ |])
src/Data/Semigroup/Singletons/Internal/Disambiguation.hs view
@@ -1,44 +1,44 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Semigroup.Singletons.Internal.Disambiguation --- Copyright : (C) 2019 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Provides aliases for 'All', 'Any', 'Sum', and 'Product' that do not clash --- with the promoted functions of the same names in --- Data.Foldable.Singletons. --- ----------------------------------------------------------------------------- - -module Data.Semigroup.Singletons.Internal.Disambiguation where - -import Data.Semigroup -import Data.Semigroup.Singletons.Internal.Wrappers -import Data.Singletons.TH - --- We need these in Data.Foldable.Singletons, as we need to promote --- code that simultaneously uses the All/Any/Sum/Product constructors and the --- all/any/sum/product functions, which have clashing defunctionalization --- symbol names. Our workaround is to simply define synonyms for --- all/any/sum/product and use those instead. -$(singletons [d| - all_ :: Bool -> All - all_ = All - - any_ :: Bool -> Any - any_ = Any - - sum_ :: a -> Sum a - sum_ = Sum - - product_ :: a -> Product a - product_ = Product - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Semigroup.Singletons.Internal.Disambiguation+-- Copyright : (C) 2019 Ryan Scott+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Provides aliases for 'All', 'Any', 'Sum', and 'Product' that do not clash+-- with the promoted functions of the same names in+-- Data.Foldable.Singletons.+--+----------------------------------------------------------------------------++module Data.Semigroup.Singletons.Internal.Disambiguation where++import Data.Semigroup+import Data.Semigroup.Singletons.Internal.Wrappers+import Data.Singletons.TH++-- We need these in Data.Foldable.Singletons, as we need to promote+-- code that simultaneously uses the All/Any/Sum/Product constructors and the+-- all/any/sum/product functions, which have clashing defunctionalization+-- symbol names. Our workaround is to simply define synonyms for+-- all/any/sum/product and use those instead.+$(singletons [d|+ all_ :: Bool -> All+ all_ = All++ any_ :: Bool -> Any+ any_ = Any++ sum_ :: a -> Sum a+ sum_ = Sum++ product_ :: a -> Product a+ product_ = Product+ |])
src/Data/Semigroup/Singletons/Internal/Wrappers.hs view
@@ -1,108 +1,108 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Semigroup.Singletons.Internal.Wrappers --- 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 @newtype@ wrappers from --- "Data.Semigroup", 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.Monoid.Singletons". --- ----------------------------------------------------------------------------- - -module Data.Semigroup.Singletons.Internal.Wrappers where - -import Control.Monad.Singletons.Internal -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Ord.Singletons hiding (MinSym0, MinSym1, MaxSym0, MaxSym1) -import Data.Semigroup (Dual(..), All(..), Any(..), Sum(..), Product(..)) -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons.Base.Enum -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH -import GHC.Num.Singletons - -$(genSingletons semigroupBasicTypes) -$(singBoundedInstances semigroupBasicTypes) -$(singEqInstances semigroupBasicTypes) -$(singDecideInstances semigroupBasicTypes) -$(singOrdInstances 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) - |]) +{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Semigroup.Singletons.Internal.Wrappers+-- 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 @newtype@ wrappers from+-- "Data.Semigroup", 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.Monoid.Singletons".+--+----------------------------------------------------------------------------++module Data.Semigroup.Singletons.Internal.Wrappers where++import Control.Monad.Singletons.Internal+import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Ord.Singletons hiding (MinSym0, MinSym1, MaxSym0, MaxSym1)+import Data.Semigroup (Dual(..), All(..), Any(..), Sum(..), Product(..))+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons.Base.Enum+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH+import GHC.Num.Singletons++$(genSingletons semigroupBasicTypes)+$(singBoundedInstances semigroupBasicTypes)+$(singEqInstances semigroupBasicTypes)+$(singDecideInstances semigroupBasicTypes)+$(singOrdInstances 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)+ |])
src/Data/Singletons/Base/CustomStar.hs view
@@ -1,32 +1,32 @@------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.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! --- --- See also "Data.Singletons.TH.CustomStar" from @singletons-th@, a --- more minimal version of this module that does not re-export anything from --- "Prelude.Singletons". --- ----------------------------------------------------------------------------- - -module Data.Singletons.Base.CustomStar ( - singletonStar, - - module Data.Bool.Singletons, - module Data.Eq.Singletons, - module Data.Singletons.Base.TH - ) where - -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Singletons.Base.TH -import Data.Singletons.TH.CustomStar +-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.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!+--+-- See also "Data.Singletons.TH.CustomStar" from @singletons-th@, a+-- more minimal version of this module that does not re-export anything from+-- "Prelude.Singletons".+--+----------------------------------------------------------------------------++module Data.Singletons.Base.CustomStar (+ singletonStar,++ module Data.Bool.Singletons,+ module Data.Eq.Singletons,+ module Data.Singletons.Base.TH+ ) where++import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Singletons.Base.TH+import Data.Singletons.TH.CustomStar
src/Data/Singletons/Base/Enum.hs view
@@ -1,152 +1,152 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.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 the 'Bounded' and 'Enum' type --- classes. --- --- While "Prelude.Singletons" re-exports the promoted and singled versions of --- 'Enum', it deliberately avoids re-exporting 'Succ' and 'Pred', as these are --- names are likely to clash with code that deals with unary natural numbers. --- As a result, this module exists to provide 'Succ' and 'Pred' for those who --- want them. --- ------------------------------------------------------------------------------ - -module Data.Singletons.Base.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.Eq.Singletons -import Data.Ord.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.Base.Util -import Data.Singletons.TH -import GHC.Base.Singletons -import GHC.Num.Singletons -import GHC.TypeLits.Singletons - -$(singletonsOnly [d| - class Bounded a where - minBound, maxBound :: a - - instance Bounded Char where - minBound = '\0' - maxBound = '\x10FFFF' - |]) - -$(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 'Natural'. - toEnum :: Natural -> a - -- | Convert to a 'Natural'. - fromEnum :: a -> Natural - - -- 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] - - -- Natural instance for Enum - eftNat :: Natural -> Natural -> [Natural] - -- [x1..x2] - eftNat x0 y | (x0 > y) = [] - | otherwise = go x0 - where - go x = x : if (x == y) then [] else go (x + 1) - - efdtNat :: Natural -> Natural -> Natural -> [Natural] - -- [x1,x2..y] - efdtNat x1 x2 y - | x2 >= x1 = efdtNatUp x1 x2 y - | otherwise = efdtNatDn x1 x2 y - - -- Requires x2 >= x1 - efdtNatUp :: Natural -> Natural -> Natural -> [Natural] - 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 :: Natural -> Natural -> Natural -> [Natural] - 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 Natural where - succ x = x + 1 - pred x = x - 1 - - toEnum x = x - fromEnum x = x - - enumFromTo = eftNat - enumFromThenTo = efdtNat - - instance Enum Char where - toEnum = natToChar - fromEnum = charToNat - |]) - -$(singEnumInstances enumBasicTypes) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.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 the 'Bounded' and 'Enum' type+-- classes.+--+-- While "Prelude.Singletons" re-exports the promoted and singled versions of+-- 'Enum', it deliberately avoids re-exporting 'Succ' and 'Pred', as these are+-- names are likely to clash with code that deals with unary natural numbers.+-- As a result, this module exists to provide 'Succ' and 'Pred' for those who+-- want them.+--+-----------------------------------------------------------------------------++module Data.Singletons.Base.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.Eq.Singletons+import Data.Ord.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.Base.Util+import Data.Singletons.TH+import GHC.Base.Singletons+import GHC.Num.Singletons+import GHC.TypeLits.Singletons++$(singletonsOnly [d|+ class Bounded a where+ minBound, maxBound :: a++ instance Bounded Char where+ minBound = '\0'+ maxBound = '\x10FFFF'+ |])++$(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 'Natural'.+ toEnum :: Natural -> a+ -- | Convert to a 'Natural'.+ fromEnum :: a -> Natural++ -- 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]++ -- Natural instance for Enum+ eftNat :: Natural -> Natural -> [Natural]+ -- [x1..x2]+ eftNat x0 y | (x0 > y) = []+ | otherwise = go x0+ where+ go x = x : if (x == y) then [] else go (x + 1)++ efdtNat :: Natural -> Natural -> Natural -> [Natural]+ -- [x1,x2..y]+ efdtNat x1 x2 y+ | x2 >= x1 = efdtNatUp x1 x2 y+ | otherwise = efdtNatDn x1 x2 y++ -- Requires x2 >= x1+ efdtNatUp :: Natural -> Natural -> Natural -> [Natural]+ 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 :: Natural -> Natural -> Natural -> [Natural]+ 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 Natural where+ succ x = x + 1+ pred x = x - 1++ toEnum x = x+ fromEnum x = x++ enumFromTo = eftNat+ enumFromThenTo = efdtNat++ instance Enum Char where+ toEnum = natToChar+ fromEnum = charToNat+ |])++$(singEnumInstances enumBasicTypes)
src/Data/Singletons/Base/Instances.hs view
@@ -1,40 +1,40 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -{- Data/Singletons/Base/Instances.hs - -(c) Richard Eisenberg 2013 -rae@cs.brynmawr.edu - -This (internal) module contains the main class definitions for singletons-base, -re-exported from various places. - --} - -module Data.Singletons.Base.Instances ( - module Data.Singletons.Base.Instances - , Sing - ) where - -import Data.Singletons -import Data.Singletons.Base.Util -import Data.Singletons.TH - --- some useful singletons -$(genSingletons basicTypes) -$(singDecideInstances basicTypes) -$(showSingInstances 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 - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++{- Data/Singletons/Base/Instances.hs++(c) Richard Eisenberg 2013+rae@cs.brynmawr.edu++This (internal) module contains the main class definitions for singletons-base,+re-exported from various places.++-}++module Data.Singletons.Base.Instances (+ module Data.Singletons.Base.Instances+ , Sing+ ) where++import Data.Singletons+import Data.Singletons.Base.Util+import Data.Singletons.TH++-- some useful singletons+$(genSingletons basicTypes)+$(singDecideInstances basicTypes)+$(showSingInstances 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/Base/PolyError.hs view
@@ -1,28 +1,28 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.TypeError --- Copyright : (C) 2023 Ryan Scott --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Defines a replacement for the promoted @Error@ function whose argument is --- kind-polymorphic. --- ----------------------------------------------------------------------------- -module Data.Singletons.Base.PolyError (PolyError) where - -import Data.Singletons.TH - --- | Like @Error@ from "GHC.TypeLits.Singletons", but with an argument that is --- generalized to be kind-polymorphic. This allows passing additional --- information to the error besides raw @Symbol@s. -type PolyError :: a -> b -type family PolyError (arg :: a) :: b where {} -$(genDefunSymbols [''PolyError]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.TypeError+-- Copyright : (C) 2023 Ryan Scott+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Defines a replacement for the promoted @Error@ function whose argument is+-- kind-polymorphic.+--+----------------------------------------------------------------------------+module Data.Singletons.Base.PolyError (PolyError) where++import Data.Singletons.TH++-- | Like @Error@ from "GHC.TypeLits.Singletons", but with an argument that is+-- generalized to be kind-polymorphic. This allows passing additional+-- information to the error besides raw @Symbol@s.+type PolyError :: a -> b+type family PolyError (arg :: a) :: b where {}+$(genDefunSymbols [''PolyError])
src/Data/Singletons/Base/SomeSing.hs view
@@ -1,83 +1,81 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.SomeSing --- Copyright : (C) 2013 Richard Eisenberg --- License : BSD-style (see LICENSE) --- Maintainer : Ryan Scott --- Stability : experimental --- Portability : non-portable --- --- Provides the 'SomeSing' data type along with instances of 'Eq', 'Ord', etc., --- which are defined as orphans due to 'SomeSing' originally being defined in --- a separate library (@singletons@). --- ----------------------------------------------------------------------------- -module Data.Singletons.Base.SomeSing (SomeSing(..)) where - -import Data.Eq.Singletons -import Data.Monoid.Singletons -import Data.Ord.Singletons -import Data.Semigroup.Singletons -import Data.Singletons -import Data.Singletons.Base.Enum -import Data.Singletons.Base.Instances -import Data.Singletons.ShowSing -import Data.String -import Data.String.Singletons -import qualified Data.Text as T (pack) -import GHC.Num.Singletons - -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 => 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) = - listFromSingShallow (sEnumFromTo from to) - enumFromThenTo (SomeSing from) (SomeSing then_) (SomeSing to) = - listFromSingShallow (sEnumFromThenTo from then_ to) - --- Like the 'fromSing' implementation for lists, but bottoms out at --- 'SomeSing' instead of recursively invoking 'fromSing'. -listFromSingShallow :: SList (x :: [a]) -> [SomeSing a] -listFromSingShallow SNil = [] -listFromSingShallow (SCons x xs) = SomeSing x : listFromSingShallow xs - -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) +{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.SomeSing+-- Copyright : (C) 2013 Richard Eisenberg+-- License : BSD-style (see LICENSE)+-- Maintainer : Ryan Scott+-- Stability : experimental+-- Portability : non-portable+--+-- Provides the 'SomeSing' data type along with instances of 'Eq', 'Ord', etc.,+-- which are defined as orphans due to 'SomeSing' originally being defined in+-- a separate library (@singletons@).+--+----------------------------------------------------------------------------+module Data.Singletons.Base.SomeSing (SomeSing(..)) where++import Data.Eq.Singletons+import Data.Monoid.Singletons+import Data.Ord.Singletons+import Data.Semigroup.Singletons+import Data.Singletons+import Data.Singletons.Base.Enum+import Data.Singletons.Base.Instances+import Data.Singletons.ShowSing+import Data.String+import Data.String.Singletons+import qualified Data.Text as T (pack)+import GHC.Num.Singletons++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 => 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) =+ listFromSingShallow (sEnumFromTo from to)+ enumFromThenTo (SomeSing from) (SomeSing then_) (SomeSing to) =+ listFromSingShallow (sEnumFromThenTo from then_ to)++-- Like the 'fromSing' implementation for lists, but bottoms out at+-- 'SomeSing' instead of recursively invoking 'fromSing'.+listFromSingShallow :: SList (x :: [a]) -> [SomeSing a]+listFromSingShallow SNil = []+listFromSingShallow (SCons x xs) = SomeSing x : listFromSingShallow xs++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)
src/Data/Singletons/Base/TH.hs view
@@ -1,144 +1,142 @@-{-# LANGUAGE ExplicitNamespaces #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.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, exporting both Template Haskell functionality and --- definitions that are likely to be mentioned in promoted or singled code. --- For a version of this module that only contains the Template Haskell --- functionality and nothing else, see "Data.Singletons.TH" from the --- @singletons-th@ library. --- ----------------------------------------------------------------------------- - -module Data.Singletons.Base.TH ( - -- * Primary Template Haskell generation functions - singletons, singletonsOnly, genSingletons, - promote, promoteOnly, genDefunSymbols, genPromotions, - - -- ** Functions to generate equality instances - promoteEqInstances, promoteEqInstance, - singEqInstances, singEqInstance, - 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, - showSingInstances, showSingInstance, - - -- ** Utility functions - singITyConInstances, singITyConInstance, - cases, sCases, - - -- * Basic singleton definitions - SList(..), SBool(..), STuple0(..), STuple2(..), STuple3(..), STuple4(..), - STuple5(..), STuple6(..), STuple7(..), SOrdering(..), - 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(..), - SDecide(..), (:~:)(..), Void, Refuted, Decision(..), - PBounded(..), SBounded(..), - PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum), - PShow(..), SShow(..), PIsString(..), SIsString(..), - ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace, - ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace, - FromInteger, sFromInteger, Negate, sNegate, - PFunctor(..), SFunctor(..), - PFoldable(..), SFoldable(..), - PSemigroup(..), SSemigroup(..), - PMonoid(..), SMonoid(..), - PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..), - type (.), (%.), - - Error, sError, ErrorSym0, ErrorSym1, - Undefined, sUndefined, UndefinedSym0, - TrueSym0, FalseSym0, - type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (>@#@$), type (>@#@$$), type (>@#@$$$), - IfSym0, IfSym1, IfSym2, IfSym3, - 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, - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - MinBoundSym0, MaxBoundSym0, - ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, - ShowStringSym0, ShowStringSym1, ShowStringSym2, - ShowParenSym0, ShowParenSym1, ShowParenSym2, - ShowSpaceSym0, ShowSpaceSym1, - ShowCharSym0, ShowCharSym1, ShowCharSym2, - ShowCommaSpaceSym0, ShowCommaSpaceSym1, - FromIntegerSym0, FromIntegerSym1, - NegateSym0, NegateSym1, - FromStringSym0, FromStringSym1, - FmapSym0, FmapSym1, FmapSym2, - type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), - FoldMapSym0, FoldMapSym1, FoldMapSym2, - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), - MemptySym0, - MappendSym0, MappendSym1, MappendSym2, - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - TraverseSym0, TraverseSym1, TraverseSym2, - PureSym0, PureSym1, - type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), - LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, - type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), - NilSym0, (:@#@$), (:@#@$$), (:@#@$$$), - - SuppressUnusedWarnings(..) - - ) where - -import Control.Applicative.Singletons -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Foldable.Singletons -import Data.Functor.Singletons hiding (Void) -import Data.Monoid.Singletons -import Data.Ord.Singletons -import Data.Semigroup.Singletons - ( PSemigroup(..), SSemigroup(..) - , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) ) -import Data.Singletons -import Data.Singletons.Base.Enum -import Data.Singletons.Base.Instances - hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl) -import Data.Singletons.Decide -import Data.Singletons.TH -import Data.String.Singletons -import Data.Traversable.Singletons -import GHC.Base.Singletons - hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) -import GHC.Num.Singletons -import GHC.TypeLits.Singletons -import Text.Show.Singletons +-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.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, exporting both Template Haskell functionality and+-- definitions that are likely to be mentioned in promoted or singled code.+-- For a version of this module that only contains the Template Haskell+-- functionality and nothing else, see "Data.Singletons.TH" from the+-- @singletons-th@ library.+--+----------------------------------------------------------------------------++module Data.Singletons.Base.TH (+ -- * Primary Template Haskell generation functions+ singletons, singletonsOnly, genSingletons,+ promote, promoteOnly, genDefunSymbols, genPromotions,++ -- ** Functions to generate equality instances+ promoteEqInstances, promoteEqInstance,+ singEqInstances, singEqInstance,+ 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,+ showSingInstances, showSingInstance,++ -- ** Utility functions+ singITyConInstances, singITyConInstance,+ cases, sCases,++ -- * Basic singleton definitions+ SList(..), SBool(..), STuple0(..), STuple2(..), STuple3(..), STuple4(..),+ STuple5(..), STuple6(..), STuple7(..), SOrdering(..),+ 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(..),+ SDecide(..), (:~:)(..), Void, Refuted, Decision(..),+ PBounded(..), SBounded(..),+ PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum),+ PShow(..), SShow(..), PIsString(..), SIsString(..),+ ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace,+ ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace,+ FromInteger, sFromInteger, Negate, sNegate,+ PFunctor(..), SFunctor(..),+ PFoldable(..), SFoldable(..),+ PSemigroup(..), SSemigroup(..),+ PMonoid(..), SMonoid(..),+ PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..),+ type (.), (%.),++ Error, sError, ErrorSym0, ErrorSym1,+ Undefined, sUndefined, UndefinedSym0,+ TrueSym0, FalseSym0,+ type (==@#@$), type (==@#@$$), type (==@#@$$$),+ type (>@#@$), type (>@#@$$), type (>@#@$$$),+ IfSym0, IfSym1, IfSym2, IfSym3,+ 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,+ FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,+ MinBoundSym0, MaxBoundSym0,+ ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,+ ShowStringSym0, ShowStringSym1, ShowStringSym2,+ ShowParenSym0, ShowParenSym1, ShowParenSym2,+ ShowSpaceSym0, ShowSpaceSym1,+ ShowCharSym0, ShowCharSym1, ShowCharSym2,+ ShowCommaSpaceSym0, ShowCommaSpaceSym1,+ FromIntegerSym0, FromIntegerSym1,+ NegateSym0, NegateSym1,+ FromStringSym0, FromStringSym1,+ FmapSym0, FmapSym1, FmapSym2,+ type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),+ FoldMapSym0, FoldMapSym1, FoldMapSym2,+ type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),+ MemptySym0,+ MappendSym0, MappendSym1, MappendSym2,+ FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,+ TraverseSym0, TraverseSym1, TraverseSym2,+ PureSym0, PureSym1,+ type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),+ LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3,+ type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),+ NilSym0, (:@#@$), (:@#@$$), (:@#@$$$),++ SuppressUnusedWarnings(..)++ ) where++import Control.Applicative.Singletons+import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Foldable.Singletons+import Data.Functor.Singletons hiding (Void)+import Data.Monoid.Singletons+import Data.Ord.Singletons+import Data.Semigroup.Singletons+ ( PSemigroup(..), SSemigroup(..)+ , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) )+import Data.Singletons+import Data.Singletons.Base.Enum+import Data.Singletons.Base.Instances+ hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl)+import Data.Singletons.Decide+import Data.Singletons.TH+import Data.String.Singletons+import Data.Traversable.Singletons+import GHC.Base.Singletons+ hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)+import GHC.Num.Singletons+import GHC.TypeLits.Singletons+import Text.Show.Singletons
src/Data/Singletons/Base/TypeError.hs view
@@ -1,188 +1,188 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.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.Base.TypeError" at the same time, as many of the --- definitions in the latter deliberately clash with the former. --- ----------------------------------------------------------------------------- -module Data.Singletons.Base.TypeError ( - TypeError, sTypeError, typeError, - ErrorMessage'(..), ErrorMessage, PErrorMessage, - Sing, 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.Singletons.Internal -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'. -type ErrorMessage' :: Type -> Type -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 :: Type -type ErrorMessage = ErrorMessage' Text.Text - --- | A type-level `ErrorMessage'` which uses 'Symbol' as its text kind. -type PErrorMessage :: Type -type PErrorMessage = ErrorMessage' Symbol - -type SErrorMessage :: PErrorMessage -> Type -data SErrorMessage :: PErrorMessage -> Type where - SText :: Sing t -> SErrorMessage ('Text t) - SShowType :: Sing ty -> SErrorMessage ('ShowType ty) - (:%<>:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 ':<>: e2) - (:%$$:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 ':$$: e2) -infixl 6 :%<>: -infixl 5 :%$$: - -type instance Sing = SErrorMessage - -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 SingI1 ('Text :: Symbol -> PErrorMessage) where - liftSing = SText - -instance SingI ty => SingI ('ShowType ty :: PErrorMessage) where - sing = SShowType sing -instance SingI1 ('ShowType :: t -> PErrorMessage) where - liftSing = SShowType - -instance (SingI e1, SingI e2) => SingI (e1 ':<>: e2 :: PErrorMessage) where - sing = sing :%<>: sing -instance SingI e1 => SingI1 ('(:<>:) e1 :: PErrorMessage -> PErrorMessage) where - liftSing s = sing :%<>: s -instance SingI2 ('(:<>:) :: PErrorMessage -> PErrorMessage -> PErrorMessage) where - liftSing2 s1 s2 = s1 :%<>: s2 - -instance (SingI e1, SingI e2) => SingI (e1 ':$$: e2 :: PErrorMessage) where - sing = sing :%$$: sing -instance SingI e1 => SingI1 ('(:$$:) e1 :: PErrorMessage -> PErrorMessage) where - liftSing s = sing :%$$: s -instance SingI2 ('(:$$:) :: PErrorMessage -> PErrorMessage -> PErrorMessage) where - liftSing2 s1 s2 = s1 :%$$: s2 - --- | 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 ConvertPErrorMessage :: PErrorMessage -> TL.ErrorMessage -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 TypeError :: PErrorMessage -> a -type family TypeError (x :: PErrorMessage) :: a where - -- We cannot define this as a type synonym due to Trac #12048. - TypeError x = TL.TypeError (ConvertPErrorMessage x) - --- | 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 (ShowTypeSym0 :: t ~> PErrorMessage) where - sing = singFun1 SShowType - -instance SingI ((:<>:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where - sing = singFun2 (:%<>:) -instance SingI x => SingI ((:<>:@#@$$) x :: PErrorMessage ~> PErrorMessage) where - sing = singFun1 (sing @x :%<>:) -instance SingI1 ((:<>:@#@$$) :: PErrorMessage -> PErrorMessage ~> PErrorMessage) where - liftSing s = singFun1 (s :%<>:) - -instance SingI ((:$$:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where - sing = singFun2 (:%$$:) -instance SingI x => SingI ((:$$:@#@$$) x :: PErrorMessage ~> PErrorMessage) where - sing = singFun1 (sing @x :%$$:) -instance SingI1 ((:$$:@#@$$) :: PErrorMessage -> PErrorMessage ~> PErrorMessage) where - liftSing s = singFun1 (s :%$$:) - -instance SingI TypeErrorSym0 where - sing = singFun1 sTypeError +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.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.Base.TypeError" at the same time, as many of the+-- definitions in the latter deliberately clash with the former.+--+----------------------------------------------------------------------------+module Data.Singletons.Base.TypeError (+ TypeError, sTypeError, typeError,+ ErrorMessage'(..), ErrorMessage, PErrorMessage,+ Sing, 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.Singletons.Internal+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'.+type ErrorMessage' :: Type -> Type+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 :: Type+type ErrorMessage = ErrorMessage' Text.Text++-- | A type-level `ErrorMessage'` which uses 'Symbol' as its text kind.+type PErrorMessage :: Type+type PErrorMessage = ErrorMessage' Symbol++type SErrorMessage :: PErrorMessage -> Type+data SErrorMessage :: PErrorMessage -> Type where+ SText :: Sing t -> SErrorMessage ('Text t)+ SShowType :: Sing ty -> SErrorMessage ('ShowType ty)+ (:%<>:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 ':<>: e2)+ (:%$$:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 ':$$: e2)+infixl 6 :%<>:+infixl 5 :%$$:++type instance Sing @PErrorMessage = SErrorMessage++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 SingI1 ('Text :: Symbol -> PErrorMessage) where+ liftSing = SText++instance SingI ty => SingI ('ShowType ty :: PErrorMessage) where+ sing = SShowType sing+instance SingI1 ('ShowType :: t -> PErrorMessage) where+ liftSing = SShowType++instance (SingI e1, SingI e2) => SingI (e1 ':<>: e2 :: PErrorMessage) where+ sing = sing :%<>: sing+instance SingI e1 => SingI1 ('(:<>:) e1 :: PErrorMessage -> PErrorMessage) where+ liftSing s = sing :%<>: s+instance SingI2 ('(:<>:) :: PErrorMessage -> PErrorMessage -> PErrorMessage) where+ liftSing2 s1 s2 = s1 :%<>: s2++instance (SingI e1, SingI e2) => SingI (e1 ':$$: e2 :: PErrorMessage) where+ sing = sing :%$$: sing+instance SingI e1 => SingI1 ('(:$$:) e1 :: PErrorMessage -> PErrorMessage) where+ liftSing s = sing :%$$: s+instance SingI2 ('(:$$:) :: PErrorMessage -> PErrorMessage -> PErrorMessage) where+ liftSing2 s1 s2 = s1 :%$$: s2++-- | 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 ConvertPErrorMessage :: PErrorMessage -> TL.ErrorMessage+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 TypeError :: PErrorMessage -> a+type family TypeError (x :: PErrorMessage) :: a where+ -- We cannot define this as a type synonym due to Trac #12048.+ TypeError x = TL.TypeError (ConvertPErrorMessage x)++-- | 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 (ShowTypeSym0 :: t ~> PErrorMessage) where+ sing = singFun1 SShowType++instance SingI ((:<>:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where+ sing = singFun2 (:%<>:)+instance SingI x => SingI ((:<>:@#@$$) x :: PErrorMessage ~> PErrorMessage) where+ sing = singFun1 (sing @x :%<>:)+instance SingI1 ((:<>:@#@$$) :: PErrorMessage -> PErrorMessage ~> PErrorMessage) where+ liftSing s = singFun1 (s :%<>:)++instance SingI ((:$$:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where+ sing = singFun2 (:%$$:)+instance SingI x => SingI ((:$$:@#@$$) x :: PErrorMessage ~> PErrorMessage) where+ sing = singFun1 (sing @x :%$$:)+instance SingI1 ((:$$:@#@$$) :: PErrorMessage -> PErrorMessage ~> PErrorMessage) where+ liftSing s = singFun1 (s :%$$:)++instance SingI TypeErrorSym0 where+ sing = singFun1 sTypeError
src/Data/Singletons/Base/TypeRepTYPE.hs view
@@ -1,97 +1,97 @@-{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Singletons.Base.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.Base.TypeRepTYPE ( - Sing, - -- | Here is the definition of the singleton for @'TYPE' rep@: - -- - -- > type instance Sing \@(TYPE rep) = TypeRep - -- - -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and - -- 'TestCoercion' are also supplied. - - SomeTypeRepTYPE(..) - ) where - -import Data.Eq.Singletons -import Data.Kind (Type) -import Data.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.Decide -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` 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. -type instance Sing @(TYPE rep) = TypeRep - --- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to --- kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@). -type SomeTypeRepTYPE :: RuntimeRep -> Type -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 = typeRep -instance SingKind (TYPE rep) where - type Demote (TYPE rep) = SomeTypeRepTYPE rep - fromSing = SomeTypeRepTYPE - toSing (SomeTypeRepTYPE tr) = SomeSing tr - -instance PEq (TYPE rep) where - type x == y = DefaultEq x y -instance SEq (TYPE rep) where - tra %== 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 - tra %~ trb = - case eqTypeRep tra trb of - Just HRefl -> Proved Refl - Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed") +{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Singletons.Base.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.Base.TypeRepTYPE (+ Sing,+ -- | Here is the definition of the singleton for @'TYPE' rep@:+ --+ -- > type instance Sing \@(TYPE rep) = TypeRep+ --+ -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and+ -- 'TestCoercion' are also supplied.++ SomeTypeRepTYPE(..)+ ) where++import Data.Eq.Singletons+import Data.Kind (Type)+import Data.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.Decide+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` 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.+type instance Sing @(TYPE rep) = TypeRep++-- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to+-- kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@).+type SomeTypeRepTYPE :: RuntimeRep -> Type+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 = typeRep+instance SingKind (TYPE rep) where+ type Demote (TYPE rep) = SomeTypeRepTYPE rep+ fromSing = SomeTypeRepTYPE+ toSing (SomeTypeRepTYPE tr) = SomeSing tr++instance PEq (TYPE rep) where+ type x == y = DefaultEq x y+instance SEq (TYPE rep) where+ tra %== 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+ tra %~ trb =+ case eqTypeRep tra trb of+ Just HRefl -> Proved Refl+ Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed")
src/Data/Singletons/Base/Util.hs view
@@ -1,67 +1,67 @@-{-# LANGUAGE TemplateHaskellQuotes #-} - -{- Data/Singletons/Prelude/Util.hs - -(c) Richard Eisenberg 2013 -rae@cs.brynmawr.edu - -This file contains helper functions internal to the singletons-base package. -Users of the package should not need to consult this file. --} - -module Data.Singletons.Base.Util where - -import Data.Functor.Identity -import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.Monoid as Monoid -import Data.Semigroup as Semigroup -import Data.Void -import Language.Haskell.TH - --- The list of types that singletons-base 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-th 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 - ] +{-# LANGUAGE TemplateHaskellQuotes #-}++{- Data/Singletons/Prelude/Util.hs++(c) Richard Eisenberg 2013+rae@cs.brynmawr.edu++This file contains helper functions internal to the singletons-base package.+Users of the package should not need to consult this file.+-}++module Data.Singletons.Base.Util where++import Data.Functor.Identity+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.Monoid as Monoid+import Data.Semigroup as Semigroup+import Data.Void+import Language.Haskell.TH++-- The list of types that singletons-base 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-th 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+ ]
src/Data/String/Singletons.hs view
@@ -1,55 +1,55 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.String.Singletons --- 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.String.Singletons ( - PIsString(..), SIsString(..), - - -- ** Defunctionalization symbols - FromStringSym0, FromStringSym1 - ) where - -import Data.Functor.Const -import Data.Functor.Const.Singletons -import Data.Functor.Identity -import Data.Functor.Identity.Singletons -import Data.Singletons.TH -import GHC.TypeLits (Symbol) -import GHC.TypeLits.Singletons () -- for the IsString instance! - -$(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 +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.String.Singletons+-- 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.String.Singletons (+ PIsString(..), SIsString(..),++ -- ** Defunctionalization symbols+ FromStringSym0, FromStringSym1+ ) where++import Data.Functor.Const+import Data.Functor.Const.Singletons+import Data.Functor.Identity+import Data.Functor.Identity.Singletons+import Data.Singletons.TH+import GHC.TypeLits (Symbol)+import GHC.TypeLits.Singletons () -- for the IsString instance!++$(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/Traversable/Singletons.hs view
@@ -1,303 +1,307 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE NoNamedWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Traversable.Singletons --- 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.Traversable.Singletons ( - 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 Control.Monad.Singletons.Internal -import Data.Foldable.Singletons (SFoldable) -import Data.Functor.Const.Singletons -import Data.Functor.Identity -import Data.Functor.Identity.Singletons -import Data.Functor.Singletons () -import Data.Kind -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Monoid -import Data.Monoid.Singletons -import Data.Proxy.Singletons -import Data.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import GHC.Base.Singletons hiding (Const, ConstSym0) - -type StateL :: Type -> Type -> Type -newtype StateL s a = StateL (s ~> (s, a)) -type SStateL :: forall s a. StateL s a -> Type -data SStateL state where - SStateL :: Sing x -> SStateL ('StateL x) -type instance Sing = SStateL -type StateLSym0 :: forall s a. (s ~> (s, a)) ~> StateL s a -data StateLSym0 z -type instance Apply StateLSym0 x = 'StateL x - -type StateR :: Type -> Type -> Type -newtype StateR s a = StateR (s ~> (s, a)) -type SStateR :: forall s a. StateR s a -> Type -data SStateR state where - SStateR :: Sing x -> SStateR ('StateR x) -type instance Sing = SStateR -type StateRSym0 :: forall s a. (s ~> (s, a)) ~> StateR s a -data StateRSym0 z -type instance Apply StateRSym0 x = 'StateR x - -$(singletonsOnly [d| - runStateL :: StateL s a -> (s -> (s, a)) - runStateL (StateL x) = x - - runStateR :: StateR s a -> (s -> (s, a)) - runStateR (StateR x) = 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 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) - - instance Traversable Proxy where - traverse _ _ = pure Proxy - sequenceA _ = pure Proxy - mapM _ _ = pure Proxy - sequence _ = pure Proxy - - 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 = runStateL (traverse (StateL . flip f) t) 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 = runStateR (traverse (StateR . flip f) t) 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 - |]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoNamedWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Traversable.Singletons+-- 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.Traversable.Singletons (+ 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 Control.Monad.Singletons.Internal+import Data.Foldable.Singletons (SFoldable)+import Data.Functor.Const.Singletons+import Data.Functor.Identity+import Data.Functor.Identity.Singletons+import Data.Functor.Singletons ()+import Data.Kind+import Data.List.NonEmpty (NonEmpty(..))+import Data.Monoid+import Data.Monoid.Singletons+import Data.Proxy.Singletons+import Data.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import GHC.Base.Singletons hiding (Const, ConstSym0)++type StateL :: Type -> Type -> Type+newtype StateL s a = StateL (s ~> (s, a))+type SStateL :: forall s a. StateL s a -> Type+data SStateL state where+ SStateL :: Sing x -> SStateL ('StateL x)+type instance Sing @(StateL s a) = SStateL+type StateLSym0 :: forall s a. (s ~> (s, a)) ~> StateL s a+data StateLSym0 z+type instance Apply StateLSym0 x = 'StateL x++type StateR :: Type -> Type -> Type+newtype StateR s a = StateR (s ~> (s, a))+type SStateR :: forall s a. StateR s a -> Type+data SStateR state where+ SStateR :: Sing x -> SStateR ('StateR x)+type instance Sing @(StateR s a) = SStateR+type StateRSym0 :: forall s a. (s ~> (s, a)) ~> StateR s a+data StateRSym0 z+type instance Apply StateRSym0 x = 'StateR x++$(singletonsOnly [d|+ runStateL :: StateL s a -> (s -> (s, a))+ runStateL (StateL x) = x++ runStateR :: StateR s a -> (s -> (s, a))+ runStateR (StateR x) = 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').+ --++ -- See Note [Using standalone kind signatures not present in the base library]+ -- in Control.Monad.Singletons.Internal.+ type Traversable :: (Type -> Type) -> Constraint+ class (Functor t, Foldable t) => Traversable t 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)++ instance Traversable Proxy where+ traverse _ _ = pure Proxy+ sequenceA _ = pure Proxy+ mapM _ _ = pure Proxy+ sequence _ = pure Proxy++ 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 = runStateL (traverse (StateL . flip f) t) 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 = runStateR (traverse (StateR . flip f) t) 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/Tuple/Singletons.hs view
@@ -1,74 +1,74 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Tuple.Singletons --- 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 singled versions 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.Tuple.Singletons ( - -- * Singleton definitions - -- | See 'Sing' for more info. - - Sing, 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.Base.Instances -import Data.Singletons.TH - -$(singletonsOnly [d| - -- -| Extract the first component of a pair. - fst :: (a,b) -> a - fst (x,_) = x - - -- -| Extract the second component of a pair. - snd :: (a,b) -> b - snd (_,y) = y - - -- -| 'curry' converts an uncurried function to a curried function. - curry :: ((a, b) -> c) -> a -> b -> c - curry f x y = f (x, y) - - -- -| 'uncurry' converts a curried function to a function on pairs. - uncurry :: (a -> b -> c) -> ((a, b) -> c) - uncurry f p = f (fst p) (snd p) - - -- -| Swap the components of a pair. - swap :: (a,b) -> (b,a) - swap (a,b) = (b,a) - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Tuple.Singletons+-- 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 singled versions 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.Tuple.Singletons (+ -- * Singleton definitions+ -- | See 'Sing' for more info.++ Sing, 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.Base.Instances+import Data.Singletons.TH++$(singletonsOnly [d|+ -- -| Extract the first component of a pair.+ fst :: (a,b) -> a+ fst (x,_) = x++ -- -| Extract the second component of a pair.+ snd :: (a,b) -> b+ snd (_,y) = y++ -- -| 'curry' converts an uncurried function to a curried function.+ curry :: ((a, b) -> c) -> a -> b -> c+ curry f x y = f (x, y)++ -- -| 'uncurry' converts a curried function to a function on pairs.+ uncurry :: (a -> b -> c) -> ((a, b) -> c)+ uncurry f p = f (fst p) (snd p)++ -- -| Swap the components of a pair.+ swap :: (a,b) -> (b,a)+ swap (a,b) = (b,a)+ |])
src/Data/Void/Singletons.hs view
@@ -1,46 +1,46 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Void.Singletons --- 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 singled versions 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.Void.Singletons ( - -- * The 'Void' singleton - Sing, SVoid, - -- | Just as 'Void' has no constructors, 'SVoid' also has no constructors. - - -- * Singletons from @Data.Void@ - Absurd, sAbsurd, - - -- * Defunctionalization symbols - AbsurdSym0, AbsurdSym1 - ) where - -import Data.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH - -$(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 {} - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Void.Singletons+-- 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 singled versions 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.Void.Singletons (+ -- * The 'Void' singleton+ Sing, SVoid,+ -- | Just as 'Void' has no constructors, 'SVoid' also has no constructors.++ -- * Singletons from @Data.Void@+ Absurd, sAbsurd,++ -- * Defunctionalization symbols+ AbsurdSym0, AbsurdSym1+ ) where++import Data.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH++$(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/GHC/Base/Singletons.hs view
@@ -1,111 +1,111 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.Base.Singletons --- 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 GHC.Base.Singletons ( - -- * Basic functions - Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise, - Id, sId, Const, sConst, type (.), (%.), 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.Bool.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH - --- Promoted and singletonized versions of "otherwise" are imported and --- re-exported from Data.Bool.Singletons. 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` - |]) +{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.Base.Singletons+-- 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 GHC.Base.Singletons (+ -- * Basic functions+ Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise,+ Id, sId, Const, sConst, type (.), (%.), 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.Bool.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH++-- Promoted and singletonized versions of "otherwise" are imported and+-- re-exported from Data.Bool.Singletons. 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`+ |])
src/GHC/Num/Singletons.hs view
@@ -1,131 +1,131 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE NoStarIsType #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.Num.Singletons --- 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 'Natural' in the --- "GHC.TypeLits" module. ----------------------------------------------------------------------------- - -module GHC.Num.Singletons ( - 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.Ord.Singletons -import Data.Singletons -import Data.Singletons.Decide -import Data.Singletons.TH -import GHC.TypeLits.Singletons.Internal -import qualified GHC.TypeNats as TN -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 'Natural'. - fromInteger :: Natural -> a - - x - y = x + negate y - - negate x = 0 - x - - subtract :: Num a => a -> a -> a - subtract x y = y - 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) - |]) - --- PNum instance -type SignumNat :: Natural -> Natural -type family SignumNat a where - SignumNat 0 = 0 - SignumNat x = 1 - -instance PNum Natural where - type a + b = a TN.+ b - type a - b = a TN.- b - type a * b = a TN.* b - type Negate (a :: Natural) = Error "Cannot negate a natural number" - type Abs (a :: Natural) = a - type Signum a = SignumNat a - type FromInteger a = a - --- SNum instance -instance SNum Natural where - sa %+ sb = - let a = fromSing sa - b = fromSing sb - in TN.withSomeSNat (a + b) unsafeCoerce - - sa %- sb = - let a = fromSing sa - b = fromSing sb - in TN.withSomeSNat (a - b) unsafeCoerce - - sa %* sb = - let a = fromSing sa - b = fromSing sb - in TN.withSomeSNat (a * b) unsafeCoerce - - 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 +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoStarIsType #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.Num.Singletons+-- 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 'Natural' in the+-- "GHC.TypeLits" module.+----------------------------------------------------------------------------++module GHC.Num.Singletons (+ 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.Ord.Singletons+import Data.Singletons+import Data.Singletons.Decide+import Data.Singletons.TH+import GHC.TypeLits.Singletons.Internal+import qualified GHC.TypeNats as TN+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 'Natural'.+ fromInteger :: Natural -> a++ x - y = x + negate y++ negate x = 0 - x++ subtract :: Num a => a -> a -> a+ subtract x y = y - 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)+ |])++-- PNum instance+type SignumNat :: Natural -> Natural+type family SignumNat a where+ SignumNat 0 = 0+ SignumNat x = 1++instance PNum Natural where+ type a + b = a TN.+ b+ type a - b = a TN.- b+ type a * b = a TN.* b+ type Negate (a :: Natural) = Error "Cannot negate a natural number"+ type Abs (a :: Natural) = a+ type Signum a = SignumNat a+ type FromInteger a = a++-- SNum instance+instance SNum Natural where+ sa %+ sb =+ let a = fromSing sa+ b = fromSing sb+ in TN.withSomeSNat (a + b) unsafeCoerce++ sa %- sb =+ let a = fromSing sa+ b = fromSing sb+ in TN.withSomeSNat (a - b) unsafeCoerce++ sa %* sb =+ let a = fromSing sa+ b = fromSing sb+ in TN.withSomeSNat (a * b) unsafeCoerce++ 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
src/GHC/TypeLits/Singletons.hs view
@@ -1,260 +1,259 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.TypeLits.Singletons --- 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 Natural, Symbol, and Char --- kinds. --- ----------------------------------------------------------------------------- - -module GHC.TypeLits.Singletons ( - Natural, Symbol, Char, - Sing, - SNat, pattern SNat, - SSymbol, pattern SSymbol, pattern SSym, - SChar, pattern SChar, - withKnownNat, withKnownSymbol, withKnownChar, - Error, sError, - ErrorWithoutStackTrace, sErrorWithoutStackTrace, - Undefined, sUndefined, - KnownNat, natVal, - KnownSymbol, symbolVal, - KnownChar, charVal, - - type (^), (%^), - type (<=?), (%<=?), - - TN.Log2, sLog2, - Div, sDiv, Mod, sMod, DivMod, sDivMod, - Quot, sQuot, Rem, sRem, QuotRem, sQuotRem, - - consSymbol, ConsSymbol, sConsSymbol, - unconsSymbol, UnconsSymbol, sUnconsSymbol, - charToNat, CharToNat, sCharToNat, - natToChar, NatToChar, sNatToChar, - - -- * Defunctionalization symbols - ErrorSym0, ErrorSym1, - ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, - UndefinedSym0, - KnownNatSym0, KnownNatSym1, - KnownSymbolSym0, KnownSymbolSym1, - KnownCharSym0, KnownCharSym1, - 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, - ConsSymbolSym0, ConsSymbolSym1, ConsSymbolSym2, - UnconsSymbolSym0, UnconsSymbolSym1, - CharToNatSym0, CharToNatSym1, - NatToCharSym0, NatToCharSym1 - ) where - -import Data.Char (chr, ord) -import qualified Data.List as L (uncons) -import Data.Singletons -import Data.Singletons.TH -import Data.String (IsString(..)) -import qualified Data.Text as T -import Data.Tuple.Singletons -import GHC.TypeLits ( CharToNat, ConsSymbol, NatToChar, UnconsSymbol - , withSomeSChar, withSomeSSymbol ) -import GHC.TypeLits.Singletons.Internal -import qualified GHC.TypeNats as TN -import GHC.TypeNats (Div, Mod) -import Unsafe.Coerce - --- | 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_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, ''KnownChar]) - ------------------------------------------------------------- --- 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" - _ -> TN.withSomeSNat (genLog2 x) unsafeCoerce -$(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 - in TN.withSomeSNat (x `div` y) unsafeCoerce -infixl 7 `sDiv` -$(genDefunSymbols [''Div]) -instance SingI DivSym0 where - sing = singFun2 sDiv -instance SingI x => SingI (DivSym1 x) where - sing = singFun1 $ sDiv (sing @x) -instance SingI1 DivSym1 where - liftSing s = singFun1 $ sDiv s - -sMod :: Sing x -> Sing y -> Sing (Mod x y) -sMod sx sy = - let x = fromSing sx - y = fromSing sy - in TN.withSomeSNat (x `mod` y) unsafeCoerce -infixl 7 `sMod` -$(genDefunSymbols [''Mod]) -instance SingI ModSym0 where - sing = singFun2 sMod -instance SingI x => SingI (ModSym1 x) where - sing = singFun1 $ sMod $ sing @x -instance SingI1 ModSym1 where - liftSing s = singFun1 $ sMod s - -$(promoteOnly [d| - divMod :: Natural -> Natural -> (Natural, Natural) - divMod x y = (div x y, mod x y) - - quotRem :: Natural -> Natural -> (Natural, Natural) - quotRem = divMod - - quot :: Natural -> Natural -> Natural - quot = div - infixl 7 `quot` - - rem :: Natural -> Natural -> Natural - 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 - in TN.withSomeSNat q $ \sq -> - TN.withSomeSNat r $ \sr -> - unsafeCoerce (STuple2 sq sr) - -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` - -consSymbol :: Char -> String -> String -consSymbol = (:) - -sConsSymbol :: Sing x -> Sing y -> Sing (ConsSymbol x y) -sConsSymbol sx sy = - let x = fromSing sx - y = T.unpack (fromSing sy) - in withSomeSSymbol (consSymbol x y) unsafeCoerce -$(genDefunSymbols [''ConsSymbol]) -instance SingI ConsSymbolSym0 where - sing = singFun2 sConsSymbol -instance SingI x => SingI (ConsSymbolSym1 x) where - sing = singFun1 $ sConsSymbol $ sing @x -instance SingI1 ConsSymbolSym1 where - liftSing s = singFun1 $ sConsSymbol s - -unconsSymbol :: String -> Maybe (Char, String) -unconsSymbol = L.uncons - -sUnconsSymbol :: Sing x -> Sing (UnconsSymbol x) -sUnconsSymbol sx = - let x = T.unpack (fromSing sx) - res = toSing (unconsSymbol x) - in case res of - SomeSing s -> unsafeCoerce s -$(genDefunSymbols [''UnconsSymbol]) -instance SingI UnconsSymbolSym0 where - sing = singFun1 sUnconsSymbol - -charToNat :: Char -> Natural -charToNat = fromIntegral . ord - -sCharToNat :: Sing x -> Sing (CharToNat x) -sCharToNat sx = - let x = fromSing sx - in TN.withSomeSNat (charToNat x) unsafeCoerce -$(genDefunSymbols [''CharToNat]) -instance SingI CharToNatSym0 where - sing = singFun1 sCharToNat - -natToChar :: Natural -> Char -natToChar = chr . fromIntegral - -sNatToChar :: Sing x -> Sing (NatToChar x) -sNatToChar sx = - let x = fromSing sx - in withSomeSChar (natToChar x) unsafeCoerce -$(genDefunSymbols [''NatToChar]) -instance SingI NatToCharSym0 where - sing = singFun1 sNatToChar +{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.TypeLits.Singletons+-- 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 Natural, Symbol, and Char+-- kinds.+--+----------------------------------------------------------------------------++module GHC.TypeLits.Singletons (+ Natural, Symbol, Char,+ Sing,+ SNat, data SNat,+ SSymbol, data SSymbol, data SSym,+ SChar, data SChar,+ withKnownNat, withKnownSymbol, withKnownChar,+ Error, sError,+ ErrorWithoutStackTrace, sErrorWithoutStackTrace,+ Undefined, sUndefined,+ KnownNat, natVal,+ KnownSymbol, symbolVal,+ KnownChar, charVal,++ type (^), (%^),+ type (<=?), (%<=?),++ TN.Log2, sLog2,+ Div, sDiv, Mod, sMod, DivMod, sDivMod,+ Quot, sQuot, Rem, sRem, QuotRem, sQuotRem,++ consSymbol, ConsSymbol, sConsSymbol,+ unconsSymbol, UnconsSymbol, sUnconsSymbol,+ charToNat, CharToNat, sCharToNat,+ natToChar, NatToChar, sNatToChar,++ -- * Defunctionalization symbols+ ErrorSym0, ErrorSym1,+ ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,+ UndefinedSym0,+ KnownNatSym0, KnownNatSym1,+ KnownSymbolSym0, KnownSymbolSym1,+ KnownCharSym0, KnownCharSym1,+ 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,+ ConsSymbolSym0, ConsSymbolSym1, ConsSymbolSym2,+ UnconsSymbolSym0, UnconsSymbolSym1,+ CharToNatSym0, CharToNatSym1,+ NatToCharSym0, NatToCharSym1+ ) where++import Data.Char (chr, ord)+import qualified Data.List as L (uncons)+import Data.Singletons+import Data.Singletons.TH+import Data.String (IsString(..))+import qualified Data.Text as T+import Data.Tuple.Singletons+import GHC.TypeLits ( CharToNat, ConsSymbol, NatToChar, UnconsSymbol+ , withSomeSChar, withSomeSSymbol )+import GHC.TypeLits.Singletons.Internal+import qualified GHC.TypeNats as TN+import GHC.TypeNats (Div, Mod)+import Unsafe.Coerce++-- | 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_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, ''KnownChar])++------------------------------------------------------------+-- 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"+ _ -> TN.withSomeSNat (genLog2 x) unsafeCoerce+$(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+ in TN.withSomeSNat (x `div` y) unsafeCoerce+infixl 7 `sDiv`+$(genDefunSymbols [''Div])+instance SingI DivSym0 where+ sing = singFun2 sDiv+instance SingI x => SingI (DivSym1 x) where+ sing = singFun1 $ sDiv (sing @x)+instance SingI1 DivSym1 where+ liftSing s = singFun1 $ sDiv s++sMod :: Sing x -> Sing y -> Sing (Mod x y)+sMod sx sy =+ let x = fromSing sx+ y = fromSing sy+ in TN.withSomeSNat (x `mod` y) unsafeCoerce+infixl 7 `sMod`+$(genDefunSymbols [''Mod])+instance SingI ModSym0 where+ sing = singFun2 sMod+instance SingI x => SingI (ModSym1 x) where+ sing = singFun1 $ sMod $ sing @x+instance SingI1 ModSym1 where+ liftSing s = singFun1 $ sMod s++$(promoteOnly [d|+ divMod :: Natural -> Natural -> (Natural, Natural)+ divMod x y = (div x y, mod x y)++ quotRem :: Natural -> Natural -> (Natural, Natural)+ quotRem = divMod++ quot :: Natural -> Natural -> Natural+ quot = div+ infixl 7 `quot`++ rem :: Natural -> Natural -> Natural+ 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+ in TN.withSomeSNat q $ \sq ->+ TN.withSomeSNat r $ \sr ->+ unsafeCoerce (STuple2 sq sr)++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`++consSymbol :: Char -> String -> String+consSymbol = (:)++sConsSymbol :: Sing x -> Sing y -> Sing (ConsSymbol x y)+sConsSymbol sx sy =+ let x = fromSing sx+ y = T.unpack (fromSing sy)+ in withSomeSSymbol (consSymbol x y) unsafeCoerce+$(genDefunSymbols [''ConsSymbol])+instance SingI ConsSymbolSym0 where+ sing = singFun2 sConsSymbol+instance SingI x => SingI (ConsSymbolSym1 x) where+ sing = singFun1 $ sConsSymbol $ sing @x+instance SingI1 ConsSymbolSym1 where+ liftSing s = singFun1 $ sConsSymbol s++unconsSymbol :: String -> Maybe (Char, String)+unconsSymbol = L.uncons++sUnconsSymbol :: Sing x -> Sing (UnconsSymbol x)+sUnconsSymbol sx =+ let x = T.unpack (fromSing sx)+ res = toSing (unconsSymbol x)+ in case res of+ SomeSing s -> unsafeCoerce s+$(genDefunSymbols [''UnconsSymbol])+instance SingI UnconsSymbolSym0 where+ sing = singFun1 sUnconsSymbol++charToNat :: Char -> Natural+charToNat = fromIntegral . ord++sCharToNat :: Sing x -> Sing (CharToNat x)+sCharToNat sx =+ let x = fromSing sx+ in TN.withSomeSNat (charToNat x) unsafeCoerce+$(genDefunSymbols [''CharToNat])+instance SingI CharToNatSym0 where+ sing = singFun1 sCharToNat++natToChar :: Natural -> Char+natToChar = chr . fromIntegral++sNatToChar :: Sing x -> Sing (NatToChar x)+sNatToChar sx =+ let x = fromSing sx+ in withSomeSChar (natToChar x) unsafeCoerce+$(genDefunSymbols [''NatToChar])+instance SingI NatToCharSym0 where+ sing = singFun1 sNatToChar
src/GHC/TypeLits/Singletons/Internal.hs view
@@ -1,288 +1,288 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.TypeLits.Singletons.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 'Natural', 'TL.Symbol', and --- 'Char' kinds. This exports the internal, unsafe constructors. Use import --- "GHC.TypeLits.Singletons" for a safe interface. --- ----------------------------------------------------------------------------- - -module GHC.TypeLits.Singletons.Internal ( - Sing, - - Natural, TL.Symbol, Char, - TN.SNat, pattern TN.SNat, - TL.SSymbol, pattern TL.SSymbol, pattern SSym, - TL.SChar, pattern TL.SChar, - TN.withKnownNat, TL.withKnownSymbol, TL.withKnownChar, - Error, sError, - ErrorWithoutStackTrace, sErrorWithoutStackTrace, - Undefined, sUndefined, - TL.KnownNat, TN.natVal, TL.KnownSymbol, TL.symbolVal, TL.KnownChar, TL.charVal, - type (TN.^), (%^), - type (TN.<=?), (%<=?), - - -- * Defunctionalization symbols - ErrorSym0, ErrorSym1, - ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, - UndefinedSym0, - type (^@#@$), type (^@#@$$), type (^@#@$$$), - type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$) - ) where - -import Data.Bool.Singletons -import Data.Eq.Singletons -import Data.Ord.Singletons as O -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons -import Data.Singletons.Decide -import Data.Singletons.TH -import Data.Type.Equality (TestEquality(..)) -import GHC.Stack (HasCallStack) -import qualified GHC.TypeLits as TL -import qualified GHC.TypeNats as TN -import Numeric.Natural (Natural) -import Unsafe.Coerce - -import qualified Data.Text as T -import Data.Text ( Text ) - ----------------------------------------------------------------------- ----- TypeLits singletons --------------------------------------------- ----------------------------------------------------------------------- - --- SNat -type instance Sing = TN.SNat - -instance TN.KnownNat n => SingI n where - sing = TN.natSing - -instance SingKind Natural where - type Demote Natural = Natural - fromSing = TN.fromSNat - toSing n = TN.withSomeSNat n SomeSing - --- STL.Symbol -type instance Sing = TL.SSymbol - --- | An alias for the 'TL.SSymbol' pattern synonym. -pattern SSym :: forall s. () => TL.KnownSymbol s => TL.SSymbol s -pattern SSym = TL.SSymbol -{-# COMPLETE SSym #-} - -instance TL.KnownSymbol n => SingI n where - sing = TL.symbolSing - -instance SingKind TL.Symbol where - type Demote TL.Symbol = Text - fromSing = T.pack . TL.fromSSymbol - toSing s = TL.withSomeSSymbol (T.unpack s) SomeSing - --- SChar -type instance Sing = TL.SChar - -instance TL.KnownChar c => SingI c where - sing = TL.charSing - -instance SingKind Char where - type Demote Char = Char - fromSing = TL.fromSChar - toSing c = TL.withSomeSChar c SomeSing - --- SDecide instances: -instance SDecide Natural where - sn %~ sm - | Just r <- testEquality sn sm - = Proved r - | otherwise - = Disproved (\Refl -> error errStr) - where errStr = "Broken Natural singletons" - -instance SDecide TL.Symbol where - sn %~ sm - | Just r <- testEquality sn sm - = Proved r - | otherwise - = Disproved (\Refl -> error errStr) - where errStr = "Broken TL.Symbol singletons" - -instance SDecide Char where - sn %~ sm - | Just r <- testEquality sn sm - = Proved r - | otherwise - = Disproved (\Refl -> error errStr) - where errStr = "Broken Char singletons" - --- PEq instances -instance PEq Natural where - type x == y = DefaultEq x y -instance PEq TL.Symbol where - type x == y = DefaultEq x y -instance PEq Char where - type x == y = DefaultEq x y - --- need SEq instances for TypeLits kinds -instance SEq Natural where - sn %== sm - = case testEquality sn sm of - Just Refl -> STrue - Nothing -> unsafeCoerce SFalse - -instance SEq TL.Symbol where - sn %== sm - = case testEquality sn sm of - Just Refl -> STrue - Nothing -> unsafeCoerce SFalse - -instance SEq Char where - sn %== sm - = case testEquality sn sm of - Just Refl -> STrue - Nothing -> unsafeCoerce SFalse - --- POrd instances -instance POrd Natural where - type (a :: Natural) `Compare` (b :: Natural) = a `TN.CmpNat` b - -instance POrd TL.Symbol where - type (a :: TL.Symbol) `Compare` (b :: TL.Symbol) = a `TL.CmpSymbol` b - -instance POrd Char where - type (a :: Char) `Compare` (b :: Char) = a `TL.CmpChar` b - --- SOrd instances -instance SOrd Natural where - a `sCompare` b = case fromSing a `compare` fromSing b of - LT -> unsafeCoerce SLT - EQ -> unsafeCoerce SEQ - GT -> unsafeCoerce SGT - -instance SOrd TL.Symbol where - a `sCompare` b = case fromSing a `compare` fromSing b of - LT -> unsafeCoerce SLT - EQ -> unsafeCoerce SEQ - GT -> unsafeCoerce SGT - -instance SOrd Char where - a `sCompare` b = case fromSing a `compare` fromSing b of - LT -> unsafeCoerce SLT - EQ -> unsafeCoerce SEQ - GT -> unsafeCoerce SGT - --- PSemigroup instance - -instance PSemigroup TL.Symbol where - type a <> b = TL.AppendSymbol a b - --- SSemigroup instance - -instance SSemigroup TL.Symbol where - sa %<> sb = - let a = fromSing sa - b = fromSing sb - in TL.withSomeSSymbol (T.unpack (a <> b)) unsafeCoerce - --- Convenience functions - --- | A promoted version of 'error'. This implements 'Error' as a stuck type --- family with a 'Symbol' argument. Depending on your needs, you might also --- consider the following alternatives: --- --- * "Data.Singletons.Base.PolyError" provides @PolyError@, which generalizes --- the argument to be kind-polymorphic. This allows passing additional --- information to the error besides raw 'Symbol's. --- --- * "Data.Singletons.Base.TypeError" provides @TypeError@, a slightly modified --- version of the custom type error machinery found in "GHC.TypeLits". This --- allows emitting error messages as compiler errors rather than as stuck type --- families. -type Error :: TL.Symbol -> a -type family Error (str :: TL.Symbol) :: a where {} -$(genDefunSymbols [''Error]) -instance SingI (ErrorSym0 :: TL.Symbol ~> a) where - sing = singFun1 sError - --- | The singleton for 'error'. -sError :: HasCallStack => Sing (str :: TL.Symbol) -> a -sError sstr = error (T.unpack (fromSing sstr)) - --- | The promotion of 'errorWithoutStackTrace'. -type ErrorWithoutStackTrace :: TL.Symbol -> a -type family ErrorWithoutStackTrace (str :: TL.Symbol) :: a where {} -$(genDefunSymbols [''ErrorWithoutStackTrace]) -instance SingI (ErrorWithoutStackTraceSym0 :: TL.Symbol ~> a) where - sing = singFun1 sErrorWithoutStackTrace - --- | The singleton for 'errorWithoutStackTrace'. -sErrorWithoutStackTrace :: Sing (str :: TL.Symbol) -> a -sErrorWithoutStackTrace sstr = errorWithoutStackTrace (T.unpack (fromSing sstr)) - --- | The promotion of 'undefined'. -type Undefined :: a -type family Undefined :: a where {} -$(genDefunSymbols [''Undefined]) - --- | The singleton for 'undefined'. -sUndefined :: HasCallStack => a -sUndefined = undefined - --- | The singleton analogue of '(TN.^)' for 'Natural's. -(%^) :: Sing a -> Sing b -> Sing (a TN.^ b) -sa %^ sb = - let a = fromSing sa - b = fromSing sb - in TN.withSomeSNat (a ^ b) unsafeCoerce -infixr 8 %^ - --- Defunctionalization symbols for type-level (^) -$(genDefunSymbols [''(TN.^)]) -instance SingI (^@#@$) where - sing = singFun2 (%^) -instance SingI x => SingI ((^@#@$$) x) where - sing = singFun1 (sing @x %^) -instance SingI1 (^@#@$$) where - liftSing s = singFun1 (s %^) - --- | The singleton analogue of 'TN.<=?' --- --- Note that, because of historical reasons in GHC's 'Natural' API, 'TN.<=?' --- is incompatible (unification-wise) with 'O.<=' and the 'PEq', 'SEq', --- 'POrd', and 'SOrd' instances for 'Natural'. @(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.Ord.Singletons", 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 'Natural'. -(%<=?) :: forall (a :: Natural) (b :: Natural). Sing a -> Sing b -> Sing (a TN.<=? b) -sa %<=? sb = unsafeCoerce (sa %<= sb) -infix 4 %<=? - --- Defunctionalization symbols for (<=?) -$(genDefunSymbols [''(TN.<=?)]) -instance SingI ((<=?@#@$) @Natural) where - sing = singFun2 (%<=?) -instance SingI x => SingI ((<=?@#@$$) @Natural x) where - sing = singFun1 (sing @x %<=?) -instance SingI1 ((<=?@#@$$) @Natural) where - liftSing s = singFun1 (s %<=?) +{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.TypeLits.Singletons.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 'Natural', 'TL.Symbol', and+-- 'Char' kinds. This exports the internal, unsafe constructors. Use import+-- "GHC.TypeLits.Singletons" for a safe interface.+--+----------------------------------------------------------------------------++module GHC.TypeLits.Singletons.Internal (+ Sing,++ Natural, TL.Symbol, Char,+ TN.SNat, data TN.SNat,+ TL.SSymbol, data TL.SSymbol, data SSym,+ TL.SChar, data TL.SChar,+ TN.withKnownNat, TL.withKnownSymbol, TL.withKnownChar,+ Error, sError,+ ErrorWithoutStackTrace, sErrorWithoutStackTrace,+ Undefined, sUndefined,+ TL.KnownNat, TN.natVal, TL.KnownSymbol, TL.symbolVal, TL.KnownChar, TL.charVal,+ type (TN.^), (%^),+ type (TN.<=?), (%<=?),++ -- * Defunctionalization symbols+ ErrorSym0, ErrorSym1,+ ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,+ UndefinedSym0,+ type (^@#@$), type (^@#@$$), type (^@#@$$$),+ type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$)+ ) where++import Data.Bool.Singletons+import Data.Eq.Singletons+import Data.Ord.Singletons as O+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons+import Data.Singletons.Decide+import Data.Singletons.TH+import Data.Type.Equality (TestEquality(..))+import GHC.Stack (HasCallStack)+import qualified GHC.TypeLits as TL+import qualified GHC.TypeNats as TN+import Numeric.Natural (Natural)+import Unsafe.Coerce++import qualified Data.Text as T+import Data.Text ( Text )++----------------------------------------------------------------------+---- TypeLits singletons ---------------------------------------------+----------------------------------------------------------------------++-- SNat+type instance Sing @Natural = TN.SNat++instance TN.KnownNat n => SingI n where+ sing = TN.natSing++instance SingKind Natural where+ type Demote Natural = Natural+ fromSing = TN.fromSNat+ toSing n = TN.withSomeSNat n SomeSing++-- STL.Symbol+type instance Sing @TL.Symbol = TL.SSymbol++-- | An alias for the 'TL.SSymbol' pattern synonym.+pattern SSym :: forall s. () => TL.KnownSymbol s => TL.SSymbol s+pattern SSym = TL.SSymbol+{-# COMPLETE SSym #-}++instance TL.KnownSymbol n => SingI n where+ sing = TL.symbolSing++instance SingKind TL.Symbol where+ type Demote TL.Symbol = Text+ fromSing = T.pack . TL.fromSSymbol+ toSing s = TL.withSomeSSymbol (T.unpack s) SomeSing++-- SChar+type instance Sing @Char = TL.SChar++instance TL.KnownChar c => SingI c where+ sing = TL.charSing++instance SingKind Char where+ type Demote Char = Char+ fromSing = TL.fromSChar+ toSing c = TL.withSomeSChar c SomeSing++-- SDecide instances:+instance SDecide Natural where+ sn %~ sm+ | Just r <- testEquality sn sm+ = Proved r+ | otherwise+ = Disproved (\Refl -> error errStr)+ where errStr = "Broken Natural singletons"++instance SDecide TL.Symbol where+ sn %~ sm+ | Just r <- testEquality sn sm+ = Proved r+ | otherwise+ = Disproved (\Refl -> error errStr)+ where errStr = "Broken TL.Symbol singletons"++instance SDecide Char where+ sn %~ sm+ | Just r <- testEquality sn sm+ = Proved r+ | otherwise+ = Disproved (\Refl -> error errStr)+ where errStr = "Broken Char singletons"++-- PEq instances+instance PEq Natural where+ type x == y = DefaultEq x y+instance PEq TL.Symbol where+ type x == y = DefaultEq x y+instance PEq Char where+ type x == y = DefaultEq x y++-- need SEq instances for TypeLits kinds+instance SEq Natural where+ sn %== sm+ = case testEquality sn sm of+ Just Refl -> STrue+ Nothing -> unsafeCoerce SFalse++instance SEq TL.Symbol where+ sn %== sm+ = case testEquality sn sm of+ Just Refl -> STrue+ Nothing -> unsafeCoerce SFalse++instance SEq Char where+ sn %== sm+ = case testEquality sn sm of+ Just Refl -> STrue+ Nothing -> unsafeCoerce SFalse++-- POrd instances+instance POrd Natural where+ type (a :: Natural) `Compare` (b :: Natural) = a `TN.CmpNat` b++instance POrd TL.Symbol where+ type (a :: TL.Symbol) `Compare` (b :: TL.Symbol) = a `TL.CmpSymbol` b++instance POrd Char where+ type (a :: Char) `Compare` (b :: Char) = a `TL.CmpChar` b++-- SOrd instances+instance SOrd Natural where+ a `sCompare` b = case fromSing a `compare` fromSing b of+ LT -> unsafeCoerce SLT+ EQ -> unsafeCoerce SEQ+ GT -> unsafeCoerce SGT++instance SOrd TL.Symbol where+ a `sCompare` b = case fromSing a `compare` fromSing b of+ LT -> unsafeCoerce SLT+ EQ -> unsafeCoerce SEQ+ GT -> unsafeCoerce SGT++instance SOrd Char where+ a `sCompare` b = case fromSing a `compare` fromSing b of+ LT -> unsafeCoerce SLT+ EQ -> unsafeCoerce SEQ+ GT -> unsafeCoerce SGT++-- PSemigroup instance++instance PSemigroup TL.Symbol where+ type a <> b = TL.AppendSymbol a b++-- SSemigroup instance++instance SSemigroup TL.Symbol where+ sa %<> sb =+ let a = fromSing sa+ b = fromSing sb+ in TL.withSomeSSymbol (T.unpack (a <> b)) unsafeCoerce++-- Convenience functions++-- | A promoted version of 'error'. This implements 'Error' as a stuck type+-- family with a 'Symbol' argument. Depending on your needs, you might also+-- consider the following alternatives:+--+-- * "Data.Singletons.Base.PolyError" provides @PolyError@, which generalizes+-- the argument to be kind-polymorphic. This allows passing additional+-- information to the error besides raw 'Symbol's.+--+-- * "Data.Singletons.Base.TypeError" provides @TypeError@, a slightly modified+-- version of the custom type error machinery found in "GHC.TypeLits". This+-- allows emitting error messages as compiler errors rather than as stuck type+-- families.+type Error :: TL.Symbol -> a+type family Error (str :: TL.Symbol) :: a where {}+$(genDefunSymbols [''Error])+instance SingI (ErrorSym0 :: TL.Symbol ~> a) where+ sing = singFun1 sError++-- | The singleton for 'error'.+sError :: forall a (str :: TL.Symbol). HasCallStack => Sing str -> Sing (Error @a str)+sError sstr = error (T.unpack (fromSing sstr))++-- | The promotion of 'errorWithoutStackTrace'.+type ErrorWithoutStackTrace :: TL.Symbol -> a+type family ErrorWithoutStackTrace (str :: TL.Symbol) :: a where {}+$(genDefunSymbols [''ErrorWithoutStackTrace])+instance SingI (ErrorWithoutStackTraceSym0 :: TL.Symbol ~> a) where+ sing = singFun1 sErrorWithoutStackTrace++-- | The singleton for 'errorWithoutStackTrace'.+sErrorWithoutStackTrace :: forall a (str :: TL.Symbol). Sing str -> Sing (ErrorWithoutStackTrace @a str)+sErrorWithoutStackTrace sstr = errorWithoutStackTrace (T.unpack (fromSing sstr))++-- | The promotion of 'undefined'.+type Undefined :: a+type family Undefined :: a where {}+$(genDefunSymbols [''Undefined])++-- | The singleton for 'undefined'.+sUndefined :: forall a. HasCallStack => Sing (Undefined @a)+sUndefined = undefined++-- | The singleton analogue of '(TN.^)' for 'Natural's.+(%^) :: Sing a -> Sing b -> Sing (a TN.^ b)+sa %^ sb =+ let a = fromSing sa+ b = fromSing sb+ in TN.withSomeSNat (a ^ b) unsafeCoerce+infixr 8 %^++-- Defunctionalization symbols for type-level (^)+$(genDefunSymbols [''(TN.^)])+instance SingI (^@#@$) where+ sing = singFun2 (%^)+instance SingI x => SingI ((^@#@$$) x) where+ sing = singFun1 (sing @x %^)+instance SingI1 (^@#@$$) where+ liftSing s = singFun1 (s %^)++-- | The singleton analogue of 'TN.<=?'+--+-- Note that, because of historical reasons in GHC's 'Natural' API, 'TN.<=?'+-- is incompatible (unification-wise) with 'O.<=' and the 'PEq', 'SEq',+-- 'POrd', and 'SOrd' instances for 'Natural'. @(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.Ord.Singletons", 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 'Natural'.+(%<=?) :: forall (a :: Natural) (b :: Natural). Sing a -> Sing b -> Sing (a TN.<=? b)+sa %<=? sb = unsafeCoerce (sa %<= sb)+infix 4 %<=?++-- Defunctionalization symbols for (<=?)+$(genDefunSymbols [''(TN.<=?)])+instance SingI ((<=?@#@$) @Natural) where+ sing = singFun2 (%<=?)+instance SingI x => SingI ((<=?@#@$$) @Natural x) where+ sing = singFun1 (sing @x %<=?)+instance SingI1 ((<=?@#@$$) @Natural) where+ liftSing s = singFun1 (s %<=?)
src/Prelude/Singletons.hs view
@@ -1,421 +1,420 @@-{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE NoStarIsType #-} - ------------------------------------------------------------------------------ --- | --- Module : Prelude.Singletons --- 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. --- ----------------------------------------------------------------------------- - -module Prelude.Singletons ( - -- * Basic singleton definitions - module Data.Singletons, - - -- * Promoted and singled types, classes, and related functions - - -- ** Basic data types - SBool(SFalse, STrue), - If, sIf, - type (&&), (%&&), type (||), (%||), Not, sNot, Otherwise, sOtherwise, - - SMaybe(SNothing, SJust), - -- | 'maybe_' is a reimplementation of the 'maybe' function with a different - -- name to avoid clashing with the 'Maybe' data type when promoted. - maybe_, Maybe_, sMaybe_, - - SEither(SLeft, SRight), - -- | 'either_' is a reimplementation of the 'either' function with a different - -- name to avoid clashing with the 'Either' data type when promoted. - either_, Either_, sEither_, - - SOrdering(SLT, SEQ, SGT), - SChar, Symbol, -- The closest things we have to Char and String - SList(..), - - -- *** Tuples - STuple0(..), STuple2(..), STuple3(..), STuple4(..), - STuple5(..), STuple6(..), STuple7(..), - Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry, - - -- ** Basic type classes - PEq(type (==), type (/=)), SEq((%==), (%/=)), - POrd(Compare, type (<), type (<=), type (>=), type (>), Max, Min), - SOrd(sCompare, (%<), (%<=), (%>=), (%>), sMax, sMin), - -- | As a matter of convenience, the "Prelude.Singletons" does /not/ export - -- promoted/singletonized @succ@ and @pred@, due to likely conflicts with - -- unary numbers. Please import "Data.Singletons.Base.Enum" directly if - -- you want these. - PEnum( -- Succ, Pred, - ToEnum, FromEnum, - {- - See the comments in Data.Singletons.Base.Enum for why these are not defined. - -} - -- EnumFrom, EnumFromThen, - EnumFromTo, EnumFromThenTo), - SEnum( -- sSucc, sPred, - sToEnum, sFromEnum, - {- - See the comments in Data.Singletons.Base.Enum for why these are not defined. - -} - -- sEnumFrom, sEnumFromThen, - sEnumFromTo, sEnumFromThenTo), - PBounded(MinBound, MaxBound), SBounded(sMinBound, sMaxBound), - - -- ** Numbers - - {- - There are no singled counterparts to any of the following numeric types. The - closest thing is Nat, which we deliberately do not export to avoid clashing - with unary natural number data types. - - -- *** Numeric types - Int, Integer, Float, Double, - Rational, Word, - -} - - -- *** Numeric type classes - PNum(type (+), type (-), type (*), Negate, Abs, Signum, FromInteger), - SNum((%+), (%-), (%*), sNegate, sAbs, sSignum, sFromInteger), - {- - We currently do not promote or single any of the following classes. Some - of these functions have Nat-specialized versions in GHC.TypeLits.Singletons, - however (e.g., Div and Mod). - -} - -- Real(toRational), - -- Integral(quot, rem, div, mod, quotRem, divMod, toInteger), - -- Fractional((/), recip, fromRational), - -- Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan, - -- asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh), - -- RealFrac(properFraction, truncate, round, ceiling, floor), - -- RealFloat(floatRadix, floatDigits, floatRange, decodeFloat, - -- encodeFloat, exponent, significand, scaleFloat, isNaN, - -- isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2), - - -- *** Numeric functions - Subtract, sSubtract, - {- - The following functions require classes such as Integral, Real, and - Fractional, which we do not promote or single. Some of these functions have - Nat-specialized versions in GHC.TypeLits.Singletons, however (e.g., (^)). - -} - -- even, odd, gcd, lcm, (^), (^^), - -- fromIntegral, realToFrac, - - -- ** Semigroups and Monoids - PSemigroup(type (<>)), SSemigroup((%<>)), - PMonoid(Mempty, Mappend, Mconcat), SMonoid(sMempty, sMappend, sMconcat), - - -- ** Monads and functors - PFunctor(Fmap, type (<$)), SFunctor(sFmap, (%<$)), type (<$>), (%<$>), - PApplicative(Pure, type (<*>), type (*>), type (<*), LiftA2), - SApplicative(sPure, (%<*>), (%*>), (%<*), sLiftA2), - PMonad(type (>>=), type (>>), Return), - SMonad((%>>=), (%>>), sReturn), - PMonadFail(Fail), SMonadFail(sFail), - MapM_, sMapM_, Sequence_, sSequence_, type (=<<), (%=<<), - - -- ** Folds and traversals - 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 (.), (%.), Flip, sFlip, type ($), (%$), Until, sUntil, - AsTypeOf, sAsTypeOf, - Error, sError, ErrorWithoutStackTrace, sErrorWithoutStackTrace, - Undefined, sUndefined, - Seq, sSeq, type ($!), (%$!), - - -- * List operations - Map, sMap, type (++), (%++), Filter, sFilter, - Head, sHead, Last, sLast, Tail, sTail, Init, sInit, type (!!), (%!!), - Null, sNull, Length, sLength, - Reverse, sReverse, - -- *** Special folds - And, sAnd, Or, sOr, Any, sAny, All, sAll, - Concat, sConcat, ConcatMap, sConcatMap, - -- ** Building lists - -- *** Scans - Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1, - -- *** Infinite lists - {- - Unsurprisingly, most operations on infinite lists won't promote. - The `replicate` function is the lone exception. - -} - -- iterate, repeat, - Replicate, sReplicate, - -- cycle, - -- ** Sublists - Take, sTake, Drop, sDrop, - TakeWhile, sTakeWhile, DropWhile, sDropWhile, - Span, sSpan, Break, sBreak, - SplitAt, sSplitAt, - -- ** 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 - {- - The `lines` and `words` functions cannot yet be promoted. - See the comments in `Data.List.Singletons.Internal`. - -} - -- lines, words, - Unlines, sUnlines, Unwords, sUnwords, - - -- * Converting to and from @Symbol@ - -- ** Converting to @Symbol@ - SymbolS, - show_, - PShow(ShowsPrec, ShowList, Show_), SShow(sShowsPrec, sShowList, sShow_), - Shows, sShows, - ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen, - {- - We do not currently promote or single the Read class. - - -- ** Converting from @Symbol@ - ReadS, - Read(readsPrec, readList), - reads, readParen, read, lex, - -} - - {- - We do not promote or single anything involving IO. - - -- * Basic Input and output - IO, - -- ** Simple I\/O operations - -- All I/O functions defined here are character oriented. The - -- treatment of the newline character will vary on different systems. - -- For example, two characters of input, return and linefeed, may - -- read as a single newline character. These functions cannot be - -- used portably for binary I/O. - -- *** Output functions - putChar, - putStr, putStrLn, print, - -- *** Input functions - getChar, - getLine, getContents, interact, - -- *** Files - FilePath, - readFile, writeFile, appendFile, readIO, readLn, - -- ** Exception handling in the I\/O monad - IOError, ioError, userError, - -} - - -- * Defunctionalization symbols - - -- ** Basic data types - FalseSym0, TrueSym0, - IfSym0, IfSym1, IfSym2, IfSym3, - type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), - type (||@#@$), type (||@#@$$), type (||@#@$$$), - NotSym0, NotSym1, - OtherwiseSym0, - - NothingSym0, JustSym0, JustSym1, - Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3, - - LeftSym0, LeftSym1, RightSym0, RightSym1, - Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3, - - LTSym0, EQSym0, GTSym0, - (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, - - -- *** Tuples - 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, - - -- ** Basic type classes - type (==@#@$), type (==@#@$$), type (==@#@$$$), - type (/=@#@$), type (/=@#@$$), type (/=@#@$$$), - - CompareSym0, CompareSym1, CompareSym2, - type (<@#@$), type (<@#@$$), type (<@#@$$$), - type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), - type (>@#@$), type (>@#@$$), type (>@#@$$$), - type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), - MaxSym0, MaxSym1, MaxSym2, - MinSym0, MinSym1, MinSym2, - - ToEnumSym0, ToEnumSym1, - FromEnumSym0, FromEnumSym1, - EnumFromToSym0, EnumFromToSym1, EnumFromToSym2, - EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2, EnumFromThenToSym3, - - MinBoundSym0, MaxBoundSym0, - - -- ** Numbers - - -- *** Numeric type classes - type (+@#@$), type (+@#@$$), type (+@#@$$$), - type (-@#@$), type (-@#@$$), type (-@#@$$$), - type (*@#@$), type (*@#@$$), type (*@#@$$$), - NegateSym0, NegateSym1, - AbsSym0, AbsSym1, - SignumSym0, SignumSym1, - FromIntegerSym0, FromIntegerSym1, - - -- *** Numeric functions - SubtractSym0, SubtractSym1, SubtractSym2, - - -- ** Semigroups and Monoids - type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), - MemptySym0, - MappendSym0, MappendSym1, MappendSym2, - MconcatSym0, MconcatSym1, - - -- ** Monads and functors - FmapSym0, FmapSym1, FmapSym2, - type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), - type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), - PureSym0, PureSym1, - type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), - type (*>@#@$), type (*>@#@$$), type (*>@#@$$$), - type (<*@#@$), type (<*@#@$$), type (<*@#@$$$), - LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, - type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$), - type (>>@#@$), type (>>@#@$$), type (>>@#@$$$), - ReturnSym0, ReturnSym1, FailSym0, FailSym1, - MapM_Sym0, MapM_Sym1, MapM_Sym2, - Sequence_Sym0, Sequence_Sym1, - type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$), - - -- ** Folds and traversals - ElemSym0, ElemSym1, ElemSym2, - FoldMapSym0, FoldMapSym1, FoldMapSym2, - FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, - FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, - Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, - Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, - MaximumSym0, MaximumSym1, - MinimumSym0, MinimumSym1, - ProductSym0, ProductSym1, - SumSym0, SumSym1, - - TraverseSym0, TraverseSym1, TraverseSym2, - SequenceASym0, SequenceASym1, - MapMSym0, MapMSym1, MapMSym2, - SequenceSym0, SequenceSym1, - - -- ** Miscellaneous functions - IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, - type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), - FlipSym0, FlipSym1, FlipSym2, FlipSym3, - type ($@#@$), type ($@#@$$), type ($@#@$$$), - UntilSym0, UntilSym1, UntilSym2, UntilSym3, - AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, - ErrorSym0, ErrorSym1, - ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, - UndefinedSym0, - SeqSym0, SeqSym1, SeqSym2, - type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), - - -- * List operations - MapSym0, MapSym1, MapSym2, - type (++@#@$), type (++@#@$$), type (++@#@$$$), - FilterSym0, FilterSym1, FilterSym2, - HeadSym0, HeadSym1, LastSym0, LastSym1, - TailSym0, TailSym1, InitSym0, InitSym1, - type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), - NullSym0, NullSym1, - LengthSym0, LengthSym1, - ReverseSym0, ReverseSym1, - -- *** Special folds - AndSym0, AndSym1, OrSym0, OrSym1, - AnySym0, AnySym1, AnySym2, - AllSym0, AllSym1, AllSym2, - ConcatSym0, ConcatSym1, - ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, - -- ** Building lists - -- *** Scans - ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, - Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, - ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, - Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, - -- *** Infinite lists - ReplicateSym0, ReplicateSym1, ReplicateSym2, - -- ** Sublists - TakeSym0, TakeSym1, TakeSym2, - DropSym0, DropSym1, DropSym2, - TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, - DropWhileSym0, DropWhileSym1, DropWhileSym2, - DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, - SpanSym0, SpanSym1, SpanSym2, - BreakSym0, BreakSym1, BreakSym2, - SplitAtSym0, SplitAtSym1, SplitAtSym2, - -- ** Searching lists - NotElemSym0, NotElemSym1, NotElemSym2, - LookupSym0, LookupSym1, LookupSym2, - -- ** Zipping and unzipping lists - ZipSym0, ZipSym1, ZipSym2, - Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, - ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, - ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, - UnzipSym0, UnzipSym1, Unzip3Sym0, Unzip3Sym1, - -- ** Functions on @Symbol@s - UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1, - - -- * Converting to and from @Symbol@ - -- ** Converting to @Symbol@ - ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, - ShowListSym0, ShowListSym1, ShowListSym2, - Show_Sym0, Show_Sym1, - ShowsSym0, ShowsSym1, ShowsSym2, - ShowCharSym0, ShowCharSym1, ShowCharSym2, - ShowStringSym0, ShowStringSym1, ShowStringSym2, - ShowParenSym0, ShowParenSym1, ShowParenSym2 - ) where - -import Control.Applicative.Singletons - hiding (Const, ConstSym0, ConstSym1) -import Control.Monad.Singletons -import Data.Bool.Singletons -import Data.Either.Singletons -import Data.Eq.Singletons -import Data.Foldable.Singletons -import Data.List.Singletons -import Data.Maybe.Singletons -import Data.Monoid.Singletons - ( PMonoid(..), SMonoid(..), MemptySym0, MappendSym0 - , MappendSym1, MappendSym2, MconcatSym0, MconcatSym1 ) -import Data.Ord.Singletons -import Data.Semigroup.Singletons - ( PSemigroup(..), SSemigroup(..) - , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) ) -import Data.Singletons -import Data.Singletons.Base.Enum - hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred) -import Data.Traversable.Singletons -import Data.Tuple.Singletons -import GHC.Base.Singletons - hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) -import GHC.Num.Singletons -import GHC.TypeLits.Singletons -import Text.Show.Singletons +{-# LANGUAGE NoStarIsType #-}++-----------------------------------------------------------------------------+-- |+-- Module : Prelude.Singletons+-- 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.+--+----------------------------------------------------------------------------++module Prelude.Singletons (+ -- * Basic singleton definitions+ module Data.Singletons,++ -- * Promoted and singled types, classes, and related functions++ -- ** Basic data types+ SBool(SFalse, STrue),+ If, sIf,+ type (&&), (%&&), type (||), (%||), Not, sNot, Otherwise, sOtherwise,++ SMaybe(SNothing, SJust),+ -- | 'maybe_' is a reimplementation of the 'maybe' function with a different+ -- name to avoid clashing with the 'Maybe' data type when promoted.+ maybe_, Maybe_, sMaybe_,++ SEither(SLeft, SRight),+ -- | 'either_' is a reimplementation of the 'either' function with a different+ -- name to avoid clashing with the 'Either' data type when promoted.+ either_, Either_, sEither_,++ SOrdering(SLT, SEQ, SGT),+ SChar, Symbol, -- The closest things we have to Char and String+ SList(..),++ -- *** Tuples+ STuple0(..), STuple2(..), STuple3(..), STuple4(..),+ STuple5(..), STuple6(..), STuple7(..),+ Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry,++ -- ** Basic type classes+ PEq(type (==), type (/=)), SEq((%==), (%/=)),+ POrd(Compare, type (<), type (<=), type (>=), type (>), Max, Min),+ SOrd(sCompare, (%<), (%<=), (%>=), (%>), sMax, sMin),+ -- | As a matter of convenience, the "Prelude.Singletons" does /not/ export+ -- promoted/singletonized @succ@ and @pred@, due to likely conflicts with+ -- unary numbers. Please import "Data.Singletons.Base.Enum" directly if+ -- you want these.+ PEnum( -- Succ, Pred,+ ToEnum, FromEnum,+ {-+ See the comments in Data.Singletons.Base.Enum for why these are not defined.+ -}+ -- EnumFrom, EnumFromThen,+ EnumFromTo, EnumFromThenTo),+ SEnum( -- sSucc, sPred,+ sToEnum, sFromEnum,+ {-+ See the comments in Data.Singletons.Base.Enum for why these are not defined.+ -}+ -- sEnumFrom, sEnumFromThen,+ sEnumFromTo, sEnumFromThenTo),+ PBounded(MinBound, MaxBound), SBounded(sMinBound, sMaxBound),++ -- ** Numbers++ {-+ There are no singled counterparts to any of the following numeric types. The+ closest thing is Nat, which we deliberately do not export to avoid clashing+ with unary natural number data types.++ -- *** Numeric types+ Int, Integer, Float, Double,+ Rational, Word,+ -}++ -- *** Numeric type classes+ PNum(type (+), type (-), type (*), Negate, Abs, Signum, FromInteger),+ SNum((%+), (%-), (%*), sNegate, sAbs, sSignum, sFromInteger),+ {-+ We currently do not promote or single any of the following classes. Some+ of these functions have Nat-specialized versions in GHC.TypeLits.Singletons,+ however (e.g., Div and Mod).+ -}+ -- Real(toRational),+ -- Integral(quot, rem, div, mod, quotRem, divMod, toInteger),+ -- Fractional((/), recip, fromRational),+ -- Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,+ -- asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),+ -- RealFrac(properFraction, truncate, round, ceiling, floor),+ -- RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,+ -- encodeFloat, exponent, significand, scaleFloat, isNaN,+ -- isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),++ -- *** Numeric functions+ Subtract, sSubtract,+ {-+ The following functions require classes such as Integral, Real, and+ Fractional, which we do not promote or single. Some of these functions have+ Nat-specialized versions in GHC.TypeLits.Singletons, however (e.g., (^)).+ -}+ -- even, odd, gcd, lcm, (^), (^^),+ -- fromIntegral, realToFrac,++ -- ** Semigroups and Monoids+ PSemigroup(type (<>)), SSemigroup((%<>)),+ PMonoid(Mempty, Mappend, Mconcat), SMonoid(sMempty, sMappend, sMconcat),++ -- ** Monads and functors+ PFunctor(Fmap, type (<$)), SFunctor(sFmap, (%<$)), type (<$>), (%<$>),+ PApplicative(Pure, type (<*>), type (*>), type (<*), LiftA2),+ SApplicative(sPure, (%<*>), (%*>), (%<*), sLiftA2),+ PMonad(type (>>=), type (>>), Return),+ SMonad((%>>=), (%>>), sReturn),+ PMonadFail(Fail), SMonadFail(sFail),+ MapM_, sMapM_, Sequence_, sSequence_, type (=<<), (%=<<),++ -- ** Folds and traversals+ 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 (.), (%.), Flip, sFlip, type ($), (%$), Until, sUntil,+ AsTypeOf, sAsTypeOf,+ Error, sError, ErrorWithoutStackTrace, sErrorWithoutStackTrace,+ Undefined, sUndefined,+ Seq, sSeq, type ($!), (%$!),++ -- * List operations+ Map, sMap, type (++), (%++), Filter, sFilter,+ Head, sHead, Last, sLast, Tail, sTail, Init, sInit, type (!!), (%!!),+ Null, sNull, Length, sLength,+ Reverse, sReverse,+ -- *** Special folds+ And, sAnd, Or, sOr, Any, sAny, All, sAll,+ Concat, sConcat, ConcatMap, sConcatMap,+ -- ** Building lists+ -- *** Scans+ Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1,+ -- *** Infinite lists+ {-+ Unsurprisingly, most operations on infinite lists won't promote.+ The `replicate` function is the lone exception.+ -}+ -- iterate, repeat,+ Replicate, sReplicate,+ -- cycle,+ -- ** Sublists+ Take, sTake, Drop, sDrop,+ TakeWhile, sTakeWhile, DropWhile, sDropWhile,+ Span, sSpan, Break, sBreak,+ SplitAt, sSplitAt,+ -- ** 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+ {-+ The `lines` and `words` functions cannot yet be promoted.+ See the comments in `Data.List.Singletons.Internal`.+ -}+ -- lines, words,+ Unlines, sUnlines, Unwords, sUnwords,++ -- * Converting to and from @Symbol@+ -- ** Converting to @Symbol@+ SymbolS,+ show_,+ PShow(ShowsPrec, ShowList, Show_), SShow(sShowsPrec, sShowList, sShow_),+ Shows, sShows,+ ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen,+ {-+ We do not currently promote or single the Read class.++ -- ** Converting from @Symbol@+ ReadS,+ Read(readsPrec, readList),+ reads, readParen, read, lex,+ -}++ {-+ We do not promote or single anything involving IO.++ -- * Basic Input and output+ IO,+ -- ** Simple I\/O operations+ -- All I/O functions defined here are character oriented. The+ -- treatment of the newline character will vary on different systems.+ -- For example, two characters of input, return and linefeed, may+ -- read as a single newline character. These functions cannot be+ -- used portably for binary I/O.+ -- *** Output functions+ putChar,+ putStr, putStrLn, print,+ -- *** Input functions+ getChar,+ getLine, getContents, interact,+ -- *** Files+ FilePath,+ readFile, writeFile, appendFile, readIO, readLn,+ -- ** Exception handling in the I\/O monad+ IOError, ioError, userError,+ -}++ -- * Defunctionalization symbols++ -- ** Basic data types+ FalseSym0, TrueSym0,+ IfSym0, IfSym1, IfSym2, IfSym3,+ type (&&@#@$), type (&&@#@$$), type (&&@#@$$$),+ type (||@#@$), type (||@#@$$), type (||@#@$$$),+ NotSym0, NotSym1,+ OtherwiseSym0,++ NothingSym0, JustSym0, JustSym1,+ Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3,++ LeftSym0, LeftSym1, RightSym0, RightSym1,+ Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3,++ LTSym0, EQSym0, GTSym0,+ (:@#@$), (:@#@$$), (:@#@$$$), NilSym0,++ -- *** Tuples+ 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,++ -- ** Basic type classes+ type (==@#@$), type (==@#@$$), type (==@#@$$$),+ type (/=@#@$), type (/=@#@$$), type (/=@#@$$$),++ CompareSym0, CompareSym1, CompareSym2,+ type (<@#@$), type (<@#@$$), type (<@#@$$$),+ type (<=@#@$), type (<=@#@$$), type (<=@#@$$$),+ type (>@#@$), type (>@#@$$), type (>@#@$$$),+ type (>=@#@$), type (>=@#@$$), type (>=@#@$$$),+ MaxSym0, MaxSym1, MaxSym2,+ MinSym0, MinSym1, MinSym2,++ ToEnumSym0, ToEnumSym1,+ FromEnumSym0, FromEnumSym1,+ EnumFromToSym0, EnumFromToSym1, EnumFromToSym2,+ EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2, EnumFromThenToSym3,++ MinBoundSym0, MaxBoundSym0,++ -- ** Numbers++ -- *** Numeric type classes+ type (+@#@$), type (+@#@$$), type (+@#@$$$),+ type (-@#@$), type (-@#@$$), type (-@#@$$$),+ type (*@#@$), type (*@#@$$), type (*@#@$$$),+ NegateSym0, NegateSym1,+ AbsSym0, AbsSym1,+ SignumSym0, SignumSym1,+ FromIntegerSym0, FromIntegerSym1,++ -- *** Numeric functions+ SubtractSym0, SubtractSym1, SubtractSym2,++ -- ** Semigroups and Monoids+ type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),+ MemptySym0,+ MappendSym0, MappendSym1, MappendSym2,+ MconcatSym0, MconcatSym1,++ -- ** Monads and functors+ FmapSym0, FmapSym1, FmapSym2,+ type (<$@#@$), type (<$@#@$$), type (<$@#@$$$),+ type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$),+ PureSym0, PureSym1,+ type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),+ type (*>@#@$), type (*>@#@$$), type (*>@#@$$$),+ type (<*@#@$), type (<*@#@$$), type (<*@#@$$$),+ LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3,+ type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$),+ type (>>@#@$), type (>>@#@$$), type (>>@#@$$$),+ ReturnSym0, ReturnSym1, FailSym0, FailSym1,+ MapM_Sym0, MapM_Sym1, MapM_Sym2,+ Sequence_Sym0, Sequence_Sym1,+ type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$),++ -- ** Folds and traversals+ ElemSym0, ElemSym1, ElemSym2,+ FoldMapSym0, FoldMapSym1, FoldMapSym2,+ FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,+ FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,+ Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,+ Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,+ MaximumSym0, MaximumSym1,+ MinimumSym0, MinimumSym1,+ ProductSym0, ProductSym1,+ SumSym0, SumSym1,++ TraverseSym0, TraverseSym1, TraverseSym2,+ SequenceASym0, SequenceASym1,+ MapMSym0, MapMSym1, MapMSym2,+ SequenceSym0, SequenceSym1,++ -- ** Miscellaneous functions+ IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2,+ type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),+ FlipSym0, FlipSym1, FlipSym2, FlipSym3,+ type ($@#@$), type ($@#@$$), type ($@#@$$$),+ UntilSym0, UntilSym1, UntilSym2, UntilSym3,+ AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2,+ ErrorSym0, ErrorSym1,+ ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1,+ UndefinedSym0,+ SeqSym0, SeqSym1, SeqSym2,+ type ($!@#@$), type ($!@#@$$), type ($!@#@$$$),++ -- * List operations+ MapSym0, MapSym1, MapSym2,+ type (++@#@$), type (++@#@$$), type (++@#@$$$),+ FilterSym0, FilterSym1, FilterSym2,+ HeadSym0, HeadSym1, LastSym0, LastSym1,+ TailSym0, TailSym1, InitSym0, InitSym1,+ type (!!@#@$), type (!!@#@$$), type (!!@#@$$$),+ NullSym0, NullSym1,+ LengthSym0, LengthSym1,+ ReverseSym0, ReverseSym1,+ -- *** Special folds+ AndSym0, AndSym1, OrSym0, OrSym1,+ AnySym0, AnySym1, AnySym2,+ AllSym0, AllSym1, AllSym2,+ ConcatSym0, ConcatSym1,+ ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,+ -- ** Building lists+ -- *** Scans+ ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,+ Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,+ ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,+ Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,+ -- *** Infinite lists+ ReplicateSym0, ReplicateSym1, ReplicateSym2,+ -- ** Sublists+ TakeSym0, TakeSym1, TakeSym2,+ DropSym0, DropSym1, DropSym2,+ TakeWhileSym0, TakeWhileSym1, TakeWhileSym2,+ DropWhileSym0, DropWhileSym1, DropWhileSym2,+ DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2,+ SpanSym0, SpanSym1, SpanSym2,+ BreakSym0, BreakSym1, BreakSym2,+ SplitAtSym0, SplitAtSym1, SplitAtSym2,+ -- ** Searching lists+ NotElemSym0, NotElemSym1, NotElemSym2,+ LookupSym0, LookupSym1, LookupSym2,+ -- ** Zipping and unzipping lists+ ZipSym0, ZipSym1, ZipSym2,+ Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3,+ ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,+ ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3,+ UnzipSym0, UnzipSym1, Unzip3Sym0, Unzip3Sym1,+ -- ** Functions on @Symbol@s+ UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1,++ -- * Converting to and from @Symbol@+ -- ** Converting to @Symbol@+ ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,+ ShowListSym0, ShowListSym1, ShowListSym2,+ Show_Sym0, Show_Sym1,+ ShowsSym0, ShowsSym1, ShowsSym2,+ ShowCharSym0, ShowCharSym1, ShowCharSym2,+ ShowStringSym0, ShowStringSym1, ShowStringSym2,+ ShowParenSym0, ShowParenSym1, ShowParenSym2+ ) where++import Control.Applicative.Singletons+ hiding (Const, ConstSym0, ConstSym1)+import Control.Monad.Singletons+import Data.Bool.Singletons+import Data.Either.Singletons+import Data.Eq.Singletons+import Data.Foldable.Singletons+import Data.List.Singletons+import Data.Maybe.Singletons+import Data.Monoid.Singletons+ ( PMonoid(..), SMonoid(..), MemptySym0, MappendSym0+ , MappendSym1, MappendSym2, MconcatSym0, MconcatSym1 )+import Data.Ord.Singletons+import Data.Semigroup.Singletons+ ( PSemigroup(..), SSemigroup(..)+ , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) )+import Data.Singletons+import Data.Singletons.Base.Enum+ hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred)+import Data.Traversable.Singletons+import Data.Tuple.Singletons+import GHC.Base.Singletons+ hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)+import GHC.Num.Singletons+import GHC.TypeLits.Singletons+import Text.Show.Singletons
src/Text/Show/Singletons.hs view
@@ -1,273 +1,273 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : Text.Show.Singletons --- 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 Text.Show.Singletons ( - PShow(..), SShow(..), SymbolS, 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.Bool.Singletons -import Data.Eq.Singletons -import Data.Kind -import Data.List.NonEmpty (NonEmpty) -import Data.List.Singletons.Internal -import Data.Ord (Down) -import Data.Ord.Singletons -import Data.Semigroup.Singletons.Internal.Classes -import Data.Singletons -import Data.Singletons.Base.Instances -import Data.Singletons.TH -import qualified Data.Text as T -import GHC.Base.Singletons -import GHC.Num.Singletons -import GHC.TypeLits -import GHC.TypeLits.Singletons -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 :: Type -type SymbolS = Symbol -> Symbol - -$(singletonsOnly [d| - class Show a where - showsPrec :: Natural -> 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 :: Char -> SymbolS - showChar = consSymbol - - 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 - - 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 :: Natural -> 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 Natural where - type ShowsPrec _ n x = ShowsNat n x - -instance SShow Natural where - sShowsPrec _ sn sx = - let n = fromSing sn - x = fromSing sx - in withSomeSSymbol (P.show n ++ T.unpack x) unsafeCoerce - -$(promoteOnly [d| - showsCharPrec :: Natural -> Char -> SymbolS - showsCharPrec _ '\'' = showString "'\\''" - showsCharPrec _ c = showChar '\'' . showLitChar c . showChar '\'' - - showCharList :: [Char] -> SymbolS - showCharList cs = showChar '"' . showLitString cs . showChar '"' - - -- -| Like 'showCharList', but for 'Symbol's. - showSymbol :: Symbol -> SymbolS - showSymbol sym = showChar '"' . showLitSymbol sym . showChar '"' - - -- -| Convert a character to a string using only printable characters, - -- using Haskell source-language escape conventions. For example: - -- - -- > showLitChar '\n' s = "\\n" ++ s - -- - showLitChar :: Char -> SymbolS - showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (charToNat c)) s) - showLitChar '\DEL' s = showString "\\DEL" s - showLitChar '\\' s = showString "\\\\" s - showLitChar c s | c >= ' ' = showChar c s - showLitChar '\a' s = showString "\\a" s - showLitChar '\b' s = showString "\\b" s - showLitChar '\f' s = showString "\\f" s - showLitChar '\n' s = showString "\\n" s - showLitChar '\r' s = showString "\\r" s - showLitChar '\t' s = showString "\\t" s - showLitChar '\v' s = showString "\\v" s - showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s - showLitChar c s = showString ('\\' `consSymbol` (asciiTab!!charToNat c)) s - -- I've done manual eta-expansion here, because otherwise it's - -- impossible to stop (asciiTab!!charToNat) getting floated out as an MFE - - showLitString :: String -> SymbolS - -- -| Same as 'showLitChar', but for strings - -- It converts the string to a string using Haskell escape conventions - -- for non-printable characters. Does not add double-quotes around the - -- whole thing; the caller should do that. - -- The main difference from showLitChar (apart from the fact that the - -- argument is a string not a list) is that we must escape double-quotes - showLitString [] s = s - showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s) - showLitString (c : cs) s = showLitChar c (showLitString cs s) - -- Making 's' an explicit parameter makes it clear to GHC that - -- showLitString has arity 2, which avoids it allocating an extra lambda - -- The sticking point is the recursive call to (showLitString cs), which - -- it can't figure out would be ok with arity 2. - - -- -| Like 'showLitString', but for 'Symbol's. - showLitSymbol :: Symbol -> SymbolS - showLitSymbol sym s = case unconsSymbol sym of - Nothing -> s - Just ('"', cs) -> showString "\\\"" (showLitSymbol cs s) - Just (c, cs) -> showLitChar c (showLitSymbol cs s) - - isDec :: Char -> Bool - isDec c = c >= '0' && c <= '9' - - protectEsc :: (Char -> Bool) -> SymbolS -> SymbolS - protectEsc p f = f . cont - -- where cont s@(c:_) | p c = "\\&" ++ s - -- cont s = s - where cont s = case unconsSymbol s of - Just (c, _) | p c -> "\\&" <> s - Nothing -> s - - asciiTab :: [Symbol] - asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ') - ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", - "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", - "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", - "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", - "SP"] - |]) - -instance PShow Char where - type ShowsPrec p c x = ShowsCharPrec p c x - type ShowList cs x = ShowCharList cs x - -instance SShow Char where - sShowsPrec sp sc sx = - let p = fromSing sp - c = fromSing sc - x = fromSing sx - in withSomeSSymbol (P.showsPrec (fromIntegral p) c (T.unpack x)) unsafeCoerce - - sShowList scs sx = - let cs = fromSing scs - x = fromSing sx - in withSomeSSymbol (P.showList cs (T.unpack x)) unsafeCoerce - -instance PShow Symbol where - type ShowsPrec _ s x = ShowSymbol s x - -instance SShow Symbol where - sShowsPrec _ ss sx = - let s = fromSing ss - x = fromSing sx - in withSomeSSymbol (P.show s ++ T.unpack x) unsafeCoerce - --- | '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 ]) +{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Singletons+-- 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 Text.Show.Singletons (+ PShow(..), SShow(..), SymbolS, 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.Bool.Singletons+import Data.Eq.Singletons+import Data.Kind+import Data.List.NonEmpty (NonEmpty)+import Data.List.Singletons.Internal+import Data.Ord (Down)+import Data.Ord.Singletons+import Data.Semigroup.Singletons.Internal.Classes+import Data.Singletons+import Data.Singletons.Base.Instances+import Data.Singletons.TH+import qualified Data.Text as T+import GHC.Base.Singletons+import GHC.Num.Singletons+import GHC.TypeLits+import GHC.TypeLits.Singletons+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 :: Type+type SymbolS = Symbol -> Symbol++$(singletonsOnly [d|+ class Show a where+ showsPrec :: Natural -> 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 :: Char -> SymbolS+ showChar = consSymbol++ 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++ 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 :: Natural -> 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 Natural where+ type ShowsPrec _ n x = ShowsNat n x++instance SShow Natural where+ sShowsPrec _ sn sx =+ let n = fromSing sn+ x = fromSing sx+ in withSomeSSymbol (P.show n ++ T.unpack x) unsafeCoerce++$(promoteOnly [d|+ showsCharPrec :: Natural -> Char -> SymbolS+ showsCharPrec _ '\'' = showString "'\\''"+ showsCharPrec _ c = showChar '\'' . showLitChar c . showChar '\''++ showCharList :: [Char] -> SymbolS+ showCharList cs = showChar '"' . showLitString cs . showChar '"'++ -- -| Like 'showCharList', but for 'Symbol's.+ showSymbol :: Symbol -> SymbolS+ showSymbol sym = showChar '"' . showLitSymbol sym . showChar '"'++ -- -| Convert a character to a string using only printable characters,+ -- using Haskell source-language escape conventions. For example:+ --+ -- > showLitChar '\n' s = "\\n" ++ s+ --+ showLitChar :: Char -> SymbolS+ showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (charToNat c)) s)+ showLitChar '\DEL' s = showString "\\DEL" s+ showLitChar '\\' s = showString "\\\\" s+ showLitChar c s | c >= ' ' = showChar c s+ showLitChar '\a' s = showString "\\a" s+ showLitChar '\b' s = showString "\\b" s+ showLitChar '\f' s = showString "\\f" s+ showLitChar '\n' s = showString "\\n" s+ showLitChar '\r' s = showString "\\r" s+ showLitChar '\t' s = showString "\\t" s+ showLitChar '\v' s = showString "\\v" s+ showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s+ showLitChar c s = showString ('\\' `consSymbol` (asciiTab!!charToNat c)) s+ -- I've done manual eta-expansion here, because otherwise it's+ -- impossible to stop (asciiTab!!charToNat) getting floated out as an MFE++ showLitString :: String -> SymbolS+ -- -| Same as 'showLitChar', but for strings+ -- It converts the string to a string using Haskell escape conventions+ -- for non-printable characters. Does not add double-quotes around the+ -- whole thing; the caller should do that.+ -- The main difference from showLitChar (apart from the fact that the+ -- argument is a string not a list) is that we must escape double-quotes+ showLitString [] s = s+ showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)+ showLitString (c : cs) s = showLitChar c (showLitString cs s)+ -- Making 's' an explicit parameter makes it clear to GHC that+ -- showLitString has arity 2, which avoids it allocating an extra lambda+ -- The sticking point is the recursive call to (showLitString cs), which+ -- it can't figure out would be ok with arity 2.++ -- -| Like 'showLitString', but for 'Symbol's.+ showLitSymbol :: Symbol -> SymbolS+ showLitSymbol sym s = case unconsSymbol sym of+ Nothing -> s+ Just ('"', cs) -> showString "\\\"" (showLitSymbol cs s)+ Just (c, cs) -> showLitChar c (showLitSymbol cs s)++ isDec :: Char -> Bool+ isDec c = c >= '0' && c <= '9'++ protectEsc :: (Char -> Bool) -> SymbolS -> SymbolS+ protectEsc p f = f . cont+ -- where cont s@(c:_) | p c = "\\&" ++ s+ -- cont s = s+ where cont s = case unconsSymbol s of+ Just (c, _) | p c -> "\\&" <> s+ Nothing -> s++ asciiTab :: [Symbol]+ asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')+ ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",+ "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",+ "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",+ "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",+ "SP"]+ |])++instance PShow Char where+ type ShowsPrec p c x = ShowsCharPrec p c x+ type ShowList cs x = ShowCharList cs x++instance SShow Char where+ sShowsPrec sp sc sx =+ let p = fromSing sp+ c = fromSing sc+ x = fromSing sx+ in withSomeSSymbol (P.showsPrec (fromIntegral p) c (T.unpack x)) unsafeCoerce++ sShowList scs sx =+ let cs = fromSing scs+ x = fromSing sx+ in withSomeSSymbol (P.showList cs (T.unpack x)) unsafeCoerce++instance PShow Symbol where+ type ShowsPrec _ s x = ShowSymbol s x++instance SShow Symbol where+ sShowsPrec _ ss sx =+ let s = fromSing ss+ x = fromSing sx+ in withSomeSSymbol (P.show s ++ T.unpack x) unsafeCoerce++-- | '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 ])
tests/README.md view
@@ -1,65 +1,65 @@-`singletons-base` testsuite notes -================================= - -The `singletons-base` testsuite is built using the -[`tasty`](http://hackage.haskell.org/package/tasty) testing framework. Aside -from the standard `HUnit` and `QuickCheck` tests, it contains a number of -compile-and-dump tests. These tests run GHC to compile a test file that uses -the `singletons-base` library and compare the generated Template Haskell splices -against expected output saved in a "golden" file. Below are some details about -these tests: - - * GHC uses the in-tree `singletons-base` library. This means there is no need to - install the library in your system before running the tests. You can simply - run the tests with: - - ```bash - cabal test - ``` - - * Compile-and-dump tests are stored in the subdirectories of the - `tests/compile-and-dump/` directory. Files with a `.golden` extension store - the expected output. Running the testsuite produces files with an `.actual` - extension which contain the actual output produced by GHC. These files are - not deleted by the testsuite, which allows one to inspect them in case a - test fails. To remove the `.actual` files, run: - - ```bash - make clean-tests - ``` - - * Running the testsuite requires `diff`, as `diff` is used to compare golden - and actual files. - - * Each compile-and-dump test requires a set of GHC options to be used for - compilation. The testsuite defines a default set of options that enable all - of the language extensions required by `singletons-base`. This makes writing - tests easier since there is no need to put all the extensions into a source - file. The default options also enable `-ddump-splices` (which dumps splices - generated by Template Haskell), `-dsuppress-uniques` (which avoids test - failures due to unique identifiers), `-v0` (which silences GHC's build - output) and `-fforce-recomp` (which forces recompilation each time a - testsuite is run). There is a convenience function (`compileAndDumpTest`) - that creates a test with the standard GHC options defined by the testsuite. - - * Because `singletons-base` only supports one version of GHC, the `.golden` files - should not be assumed to be portable across multiple versions of GHC. Beware - of this should you try testing `singletons-base` against GHC HEAD. - - * You can run single tests or groups of tests whose name match a regexp using - tasty's pattern feature. For example: - - ```bash - cabal test --test-options="--pattern=Testsuite/Singletons/*" - ``` - - runs all tests in the `Testsuite/Singletons` branch of the test tree. - The `SingletonsTestSuite` module defines the structure of the test tree. - - * If you modify `singletons`, `singletons-th`, or `singletons-base`, you may - cause the actual output of some tests to change. If these changes are what - you intended, you can accept the new output by running the following command: - - ```bash - cabal test --test-options="--accept" - ``` +`singletons-base` testsuite notes+=================================++The `singletons-base` testsuite is built using the+[`tasty`](http://hackage.haskell.org/package/tasty) testing framework. Aside+from the standard `HUnit` and `QuickCheck` tests, it contains a number of+compile-and-dump tests. These tests run GHC to compile a test file that uses+the `singletons-base` library and compare the generated Template Haskell splices+against expected output saved in a "golden" file. Below are some details about+these tests:++ * GHC uses the in-tree `singletons-base` library. This means there is no need to+ install the library in your system before running the tests. You can simply+ run the tests with:++ ```bash+ cabal test+ ```++ * Compile-and-dump tests are stored in the subdirectories of the+ `tests/compile-and-dump/` directory. Files with a `.golden` extension store+ the expected output. Running the testsuite produces files with an `.actual`+ extension which contain the actual output produced by GHC. These files are+ not deleted by the testsuite, which allows one to inspect them in case a+ test fails. To remove the `.actual` files, run:++ ```bash+ make clean-tests+ ```++ * Running the testsuite requires `diff`, as `diff` is used to compare golden+ and actual files.++ * Each compile-and-dump test requires a set of GHC options to be used for+ compilation. The testsuite defines a default set of options that enable all+ of the language extensions required by `singletons-base`. This makes writing+ tests easier since there is no need to put all the extensions into a source+ file. The default options also enable `-ddump-splices` (which dumps splices+ generated by Template Haskell), `-dsuppress-uniques` (which avoids test+ failures due to unique identifiers), `-v0` (which silences GHC's build+ output) and `-fforce-recomp` (which forces recompilation each time a+ testsuite is run). There is a convenience function (`compileAndDumpTest`)+ that creates a test with the standard GHC options defined by the testsuite.++ * Because `singletons-base` only supports one version of GHC, the `.golden` files+ should not be assumed to be portable across multiple versions of GHC. Beware+ of this should you try testing `singletons-base` against GHC HEAD.++ * You can run single tests or groups of tests whose name match a regexp using+ tasty's pattern feature. For example:++ ```bash+ cabal test --test-options="--pattern=Testsuite/Singletons/*"+ ```++ runs all tests in the `Testsuite/Singletons` branch of the test tree.+ The `SingletonsTestSuite` module defines the structure of the test tree.++ * If you modify `singletons`, `singletons-th`, or `singletons-base`, you may+ cause the actual output of some tests to change. If these changes are what+ you intended, you can accept the new output by running the following command:++ ```bash+ cabal test --test-options="--accept"+ ```
tests/SingletonsBaseTestSuite.hs view
@@ -1,173 +1,185 @@-module Main ( - main - ) where - -import Test.Tasty ( DependencyType(..), TestTree - , after, defaultMain, testGroup ) -import SingletonsBaseTestSuiteUtils ( compileAndDumpStdTest, compileAndDumpTest - , testCompileAndDumpGroup, ghcOpts ) - -main :: IO () -main = defaultMain tests - -tests :: TestTree -tests = - testGroup "Testsuite" $ [ - testCompileAndDumpGroup "Singletons" - [ compileAndDumpStdTest "Nat" - , compileAndDumpStdTest "Empty" - , compileAndDumpStdTest "Maybe" - , compileAndDumpStdTest "BoxUnBox" - , afterSingletonsNat . - compileAndDumpStdTest "Operators" - , afterSingletonsNat . - compileAndDumpStdTest "HigherOrder" - , compileAndDumpStdTest "Contains" - , afterSingletonsNat . - compileAndDumpStdTest "AsPattern" - , afterSingletonsNat . - compileAndDumpStdTest "DataValues" - , after AllSucceed "$3 == \"Empty\"" . - after AllSucceed "$3 == \"Operators\"" . - compileAndDumpStdTest "EqInstances" - , compileAndDumpStdTest "CaseExpressions" - , afterSingletonsNat . - compileAndDumpStdTest "Star" - , afterSingletonsNat . - compileAndDumpStdTest "ReturnFunc" - , compileAndDumpStdTest "Lambdas" - , afterSingletonsNat . - compileAndDumpStdTest "LambdasComprehensive" - , compileAndDumpStdTest "Error" - , compileAndDumpStdTest "TopLevelPatterns" - , afterSingletonsNat . - compileAndDumpStdTest "LetStatements" - , compileAndDumpStdTest "LambdaCase" - , afterSingletonsNat . - compileAndDumpStdTest "Sections" - , afterSingletonsNat . - compileAndDumpStdTest "PatternMatching" - , compileAndDumpStdTest "Records" - , compileAndDumpStdTest "T29" - , compileAndDumpStdTest "T33" - , compileAndDumpStdTest "T54" - , afterSingletonsNat . - compileAndDumpStdTest "Classes" - , afterSingletonsNat . - after AllSucceed "$3 == \"Classes\"" . - compileAndDumpStdTest "Classes2" - , compileAndDumpStdTest "FunDeps" - , compileAndDumpStdTest "T78" - , compileAndDumpStdTest "T89" - , 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" - , afterSingletonsNat . - compileAndDumpStdTest "T150" - , 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 "T204" - , compileAndDumpStdTest "T206" - , compileAndDumpStdTest "T209" - , compileAndDumpStdTest "T216" - , compileAndDumpStdTest "T226" - , compileAndDumpStdTest "T229" - , compileAndDumpStdTest "T249" - , compileAndDumpStdTest "OverloadedStrings" - , compileAndDumpStdTest "T271" - , compileAndDumpStdTest "T287" - , compileAndDumpStdTest "TypeRepTYPE" - , compileAndDumpStdTest "T296" - , compileAndDumpStdTest "T297" - , compileAndDumpStdTest "T312" - , compileAndDumpStdTest "T313" - , compileAndDumpStdTest "T316" - , compileAndDumpStdTest "T322" - , compileAndDumpStdTest "T326" - , compileAndDumpStdTest "NatSymbolReflexive" - , compileAndDumpStdTest "T323" - , compileAndDumpStdTest "T332" - , compileAndDumpStdTest "T342" - , compileAndDumpStdTest "FunctorLikeDeriving" - , compileAndDumpStdTest "T353" - , compileAndDumpStdTest "T358" - , compileAndDumpStdTest "T367" - , compileAndDumpStdTest "T371" - , compileAndDumpStdTest "T376" - , compileAndDumpStdTest "T378a" - , afterSingletonsNat . - compileAndDumpStdTest "T378b" - , compileAndDumpStdTest "T401" - , compileAndDumpStdTest "T401b" - , compileAndDumpStdTest "T402" - , compileAndDumpStdTest "T410" - , compileAndDumpStdTest "T412" - , compileAndDumpStdTest "T414" - , compileAndDumpStdTest "T443" - , afterSingletonsNat . - compileAndDumpStdTest "T445" - , compileAndDumpStdTest "T450" - , compileAndDumpStdTest "T453" - , compileAndDumpStdTest "NegativeLiterals" - , compileAndDumpStdTest "T470" - , compileAndDumpStdTest "T480" - , compileAndDumpStdTest "T487" - , compileAndDumpStdTest "T489" - , compileAndDumpStdTest "T492" - , compileAndDumpStdTest "Natural" - , compileAndDumpStdTest "T511" - , compileAndDumpStdTest "T536" - , compileAndDumpStdTest "T555" - , compileAndDumpStdTest "T559" - ], - testCompileAndDumpGroup "Promote" - [ compileAndDumpStdTest "Constructors" - , compileAndDumpStdTest "GenDefunSymbols" - , afterSingletonsNat . - compileAndDumpStdTest "Newtypes" - , compileAndDumpStdTest "Pragmas" - , compileAndDumpStdTest "Prelude" - , compileAndDumpStdTest "T180" - , compileAndDumpStdTest "T361" - ], - testGroup "Database client" - [ compileAndDumpTest "GradingClient/Database" ghcOpts - , after AllSucceed "$3 == \"Database\"" $ - compileAndDumpTest "GradingClient/Main" ghcOpts - ], - testCompileAndDumpGroup "InsertionSort" - [ compileAndDumpStdTest "InsertionSortImp" - ] - ] - -afterSingletonsNat :: TestTree -> TestTree -afterSingletonsNat = after AllSucceed "$3 == \"Nat\"" +module Main (+ main+ ) where++import Test.Tasty ( DependencyType(..), TestTree+ , after, defaultMain, testGroup )+import SingletonsBaseTestSuiteUtils ( compileAndDumpStdTest, compileAndDumpTest+ , testCompileAndDumpGroup, ghcOpts )++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup "Testsuite" $ [+ testCompileAndDumpGroup "Singletons"+ [ compileAndDumpStdTest "Nat"+ , compileAndDumpStdTest "Empty"+ , compileAndDumpStdTest "Maybe"+ , compileAndDumpStdTest "BoxUnBox"+ , afterSingletonsNat .+ compileAndDumpStdTest "Operators"+ , afterSingletonsNat .+ compileAndDumpStdTest "HigherOrder"+ , compileAndDumpStdTest "Contains"+ , afterSingletonsNat .+ compileAndDumpStdTest "AsPattern"+ , afterSingletonsNat .+ compileAndDumpStdTest "DataValues"+ , after AllSucceed "$3 == \"Empty\"" .+ after AllSucceed "$3 == \"Operators\"" .+ compileAndDumpStdTest "EqInstances"+ , compileAndDumpStdTest "CaseExpressions"+ , afterSingletonsNat .+ compileAndDumpStdTest "Star"+ , afterSingletonsNat .+ compileAndDumpStdTest "ReturnFunc"+ , compileAndDumpStdTest "Lambdas"+ , afterSingletonsNat .+ compileAndDumpStdTest "LambdasComprehensive"+ , compileAndDumpStdTest "Error"+ , compileAndDumpStdTest "TopLevelPatterns"+ , afterSingletonsNat .+ compileAndDumpStdTest "LetStatements"+ , compileAndDumpStdTest "LambdaCase"+ , afterSingletonsNat .+ compileAndDumpStdTest "Sections"+ , afterSingletonsNat .+ compileAndDumpStdTest "PatternMatching"+ , compileAndDumpStdTest "Records"+ , compileAndDumpStdTest "T29"+ , compileAndDumpStdTest "T33"+ , compileAndDumpStdTest "T54"+ , afterSingletonsNat .+ compileAndDumpStdTest "Classes"+ , afterSingletonsNat .+ after AllSucceed "$3 == \"Classes\"" .+ compileAndDumpStdTest "Classes2"+ , compileAndDumpStdTest "FunDeps"+ , compileAndDumpStdTest "T78"+ , compileAndDumpStdTest "T89"+ , 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"+ , afterSingletonsNat .+ compileAndDumpStdTest "T150"+ , 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 "T204"+ , compileAndDumpStdTest "T206"+ , compileAndDumpStdTest "T209"+ , compileAndDumpStdTest "T216"+ , compileAndDumpStdTest "T226"+ , compileAndDumpStdTest "T229"+ , compileAndDumpStdTest "T249"+ , compileAndDumpStdTest "OverloadedStrings"+ , compileAndDumpStdTest "T271"+ , compileAndDumpStdTest "T287"+ , compileAndDumpStdTest "TypeRepTYPE"+ , compileAndDumpStdTest "T296"+ , compileAndDumpStdTest "T297"+ , compileAndDumpStdTest "T312"+ , compileAndDumpStdTest "T313"+ , compileAndDumpStdTest "T316"+ , compileAndDumpStdTest "T322"+ , compileAndDumpStdTest "T326"+ , compileAndDumpStdTest "NatSymbolReflexive"+ , compileAndDumpStdTest "T323"+ , compileAndDumpStdTest "T332"+ , compileAndDumpStdTest "T342"+ , compileAndDumpStdTest "FunctorLikeDeriving"+ , compileAndDumpStdTest "T353"+ , compileAndDumpStdTest "T358"+ , compileAndDumpStdTest "T367"+ , compileAndDumpStdTest "T371"+ , compileAndDumpStdTest "T376"+ , compileAndDumpStdTest "T378a"+ , afterSingletonsNat .+ compileAndDumpStdTest "T378b"+ , compileAndDumpStdTest "T401"+ , compileAndDumpStdTest "T401b"+ , compileAndDumpStdTest "T402"+ , compileAndDumpStdTest "T410"+ , compileAndDumpStdTest "T412"+ , compileAndDumpStdTest "T414"+ , compileAndDumpStdTest "T433"+ , compileAndDumpStdTest "T443"+ , afterSingletonsNat .+ compileAndDumpStdTest "T445"+ , compileAndDumpStdTest "T450"+ , compileAndDumpStdTest "T453"+ , compileAndDumpStdTest "NegativeLiterals"+ , compileAndDumpStdTest "T470"+ , compileAndDumpStdTest "T480"+ , compileAndDumpStdTest "T487"+ , compileAndDumpStdTest "T489"+ , compileAndDumpStdTest "T492"+ , compileAndDumpStdTest "Natural"+ , compileAndDumpStdTest "T511"+ , compileAndDumpStdTest "T536"+ , compileAndDumpStdTest "T555"+ , compileAndDumpStdTest "T559"+ , compileAndDumpStdTest "T563"+ , compileAndDumpStdTest "T565"+ , compileAndDumpStdTest "T567"+ , compileAndDumpStdTest "T571"+ , compileAndDumpStdTest "T581"+ , compileAndDumpStdTest "T582"+ , compileAndDumpStdTest "T585"+ , compileAndDumpStdTest "TypeAbstractions"+ ],+ testCompileAndDumpGroup "Promote"+ [ compileAndDumpStdTest "Constructors"+ , compileAndDumpStdTest "GenDefunSymbols"+ , afterSingletonsNat .+ compileAndDumpStdTest "Newtypes"+ , compileAndDumpStdTest "Pragmas"+ , compileAndDumpStdTest "Prelude"+ , compileAndDumpStdTest "T180"+ , compileAndDumpStdTest "T361"+ , compileAndDumpStdTest "T601a"+ , compileAndDumpStdTest "T605"+ , compileAndDumpStdTest "T613"+ ],+ testGroup "Database client"+ [ compileAndDumpTest "GradingClient/Database" ghcOpts+ , after AllSucceed "$3 == \"Database\"" $+ compileAndDumpTest "GradingClient/Main" ghcOpts+ ],+ testCompileAndDumpGroup "InsertionSort"+ [ compileAndDumpStdTest "InsertionSortImp"+ ]+ ]++afterSingletonsNat :: TestTree -> TestTree+afterSingletonsNat = after AllSucceed "$3 == \"Nat\""
tests/SingletonsBaseTestSuiteUtils.hs view
@@ -1,204 +1,202 @@-{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} - -module SingletonsBaseTestSuiteUtils ( - compileAndDumpTest - , compileAndDumpStdTest - , testCompileAndDumpGroup - , ghcOpts - , cleanFiles - ) where - -import Build_singletons_base ( ghcPath, ghcFlags, rootDir ) -import Control.Exception ( Exception ) -import Data.Foldable ( asum ) -import Data.Text ( Text ) -import Data.String ( IsString(fromString) ) -import System.FilePath ( takeBaseName, pathSeparator ) -import System.FilePath ( (</>) ) -import System.IO ( IOMode(..), openFile ) -import System.Process ( CreateProcess(..), StdStream(..) - , createProcess, proc, waitForProcess - , callCommand ) -import Test.Tasty ( TestTree, testGroup ) -import Test.Tasty.Golden ( goldenVsFileDiff ) -import qualified Data.Text as Text -import qualified Turtle - --- 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/" - --- 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 - , "-XGHC2021" - , "-XTemplateHaskell" - , "-XDataKinds" - , "-XTypeFamilies" - , "-XGADTs" - , "-XUndecidableInstances" - , "-XIncoherentInstances" - , "-XLambdaCase" - , "-XUnboxedTuples" - , "-XDefaultSignatures" - , "-XCPP" - , "-XNoStarIsType" - , "-XNoNamedWildCards" - ] - --- Compile a test using specified GHC options. Save output to file, normalize --- 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" - 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] - normalizeOutput actualFilePath -- see Note [Output normalization] - 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 the compilation of a source file fails. We could find out -whether that happened by inspecting the exit code of the `ghc` process. But it -would be tricky to get a helpful message from the failing test; we would need -to display the stderr that 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 [Output normalization] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Output file is normalized inplace. 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 inserting comments into test files without the need to modify the -golden file to adjust line numbers. - -Note [Normalizing Windows path separators] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -File paths are printed differently by GHC depending on which operating system -one uses: - -* On Unix-like operating systems: Foo/Bar.hs -* On Windows: Foo\Bar.hs - -This is annoying for golden testing, since it means that checking in output -that prints file paths will only work on some operating systems and not others. -To circumvent this problem, we normalize Windows-style path separators to -Unix-like ones. - -One way to do this is to replace all occurrences of the '\' character with '/'. -This is a step too far, however, since this will normalize things like -(\x -> x) to (/x -> x). A reasonable middle ground is to require that the -characters before and after the '\' character are alphanumeric before -normalizing it. This just so happens to be the case for every path that is -checked into the singletons-base test suite. This approach isn't perfect, since -one could check in a golden file that prints a path with a non-alphanumeric -character. This seems very unlikely to happen, however, so we will only worry -about that issue should it ever arise in practice. - -Moreover, this approach would normalize expressions like (id\x -> x) -to (id/x -> x), which could hypothetically happen with BlockArguments. However, -the vast majority of the expressions that we check into golden files arise from --ddump-splices output, which puts surrounding whitespace after the backslashes -in lambda expressions. As a result, the expression above would be -pretty-printed as (id \ x -> x), which avoids the issue entirely. Again, we -will choose not to worry about this corner case unless it becomes an issue in -practice. --} - -normalizeOutput :: FilePath -> IO () -normalizeOutput file = Turtle.inplace pat (fromString file) - where - pat :: Turtle.Pattern Text - pat = asum - [ "(0,0)-(0,0)" <$ numPair <* "-" <* numPair - , ":0:0:" <$ ":" <* d <* ":" <* d <* "-" <* d - , ":0:0" <$ ":" <* d <* ":" <* d - , fromString @Text . numPeriod <$> Turtle.lowerBounded 10 Turtle.digit - , fromString @Text . ('%' <$) <$> Turtle.lowerBounded 10 punctSym - -- Remove pretty-printed references to the singletons package - -- (e.g., turn `singletons-2.4.1:Sing` into `Sing`) to make the output - -- more stable. - , "" <$ "singletons-" <* verNum <* ":" - , do x <- Turtle.alphaNum - _ <- Turtle.char '\\' - y <- Turtle.alphaNum - pure $ Text.pack [x, '/', y] - ] - verNum = d `Turtle.sepBy` Turtle.char '.' - numPair = () <$ "(" <* d <* "," <* d <* ")" - punctSym = Turtle.oneOf "!#$%&*+./>" - numPeriod = zipWith const (cycle "0123456789876543210") - d = Turtle.some Turtle.digit - -cleanFiles :: IO () -cleanFiles = callCommand $ "rm -f " ++ rootDir </> "tests/compile-and-dump/*/*.{hi,o}" +{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}++module SingletonsBaseTestSuiteUtils (+ compileAndDumpTest+ , compileAndDumpStdTest+ , testCompileAndDumpGroup+ , ghcOpts+ , cleanFiles+ ) where++import Control.Exception ( Exception )+import Data.Foldable ( asum )+import Data.Text ( Text )+import Data.String ( IsString(fromString) )+import GHC.Paths ( ghc )+import System.FilePath ( (</>), takeBaseName, pathSeparator )+import System.IO ( IOMode(..), openFile )+import System.Process ( CreateProcess(..), StdStream(..)+ , createProcess, proc, waitForProcess+ , callCommand )+import Test.Tasty ( TestTree, testGroup )+import Test.Tasty.Golden ( goldenVsFileDiff )+import qualified Data.Text as Text+import qualified Turtle++import SingletonsBaseGHCFlags ( ghcFlags, rootDir )++-- 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/"++-- 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+ , "-XGHC2024"+ , "-XTemplateHaskell"+ , "-XTypeFamilies"+ , "-XUndecidableInstances"+ , "-XIncoherentInstances"+ , "-XUnboxedTuples"+ , "-XDefaultSignatures"+ , "-XCPP"+ , "-XNoStarIsType"+ , "-XNoNamedWildCards"+ , "-XTypeAbstractions"+ ]++-- Compile a test using specified GHC options. Save output to file, normalize+-- 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"+ goldenFilePath = goldenPath ++ testName ++ ".golden"+ actualFilePath = goldenPath ++ testName ++ ".actual"++ compileWithGHC :: IO ()+ compileWithGHC = do+ hActualFile <- openFile actualFilePath WriteMode+ (_, _, _, pid) <- createProcess (proc ghc (testPath : opts))+ { std_out = UseHandle hActualFile+ , std_err = UseHandle hActualFile+ , cwd = Just goldenPath }+ _ <- waitForProcess pid -- see Note [Ignore exit code]+ normalizeOutput actualFilePath -- see Note [Output normalization]+ 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 the compilation of a source file fails. We could find out+whether that happened by inspecting the exit code of the `ghc` process. But it+would be tricky to get a helpful message from the failing test; we would need+to display the stderr that 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 [Output normalization]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Output file is normalized inplace. 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 inserting comments into test files without the need to modify the+golden file to adjust line numbers.++Note [Normalizing Windows path separators]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+File paths are printed differently by GHC depending on which operating system+one uses:++* On Unix-like operating systems: Foo/Bar.hs+* On Windows: Foo\Bar.hs++This is annoying for golden testing, since it means that checking in output+that prints file paths will only work on some operating systems and not others.+To circumvent this problem, we normalize Windows-style path separators to+Unix-like ones.++One way to do this is to replace all occurrences of the '\' character with '/'.+This is a step too far, however, since this will normalize things like+(\x -> x) to (/x -> x). A reasonable middle ground is to require that the+characters before and after the '\' character are alphanumeric before+normalizing it. This just so happens to be the case for every path that is+checked into the singletons-base test suite. This approach isn't perfect, since+one could check in a golden file that prints a path with a non-alphanumeric+character. This seems very unlikely to happen, however, so we will only worry+about that issue should it ever arise in practice.++Moreover, this approach would normalize expressions like (id\x -> x)+to (id/x -> x), which could hypothetically happen with BlockArguments. However,+the vast majority of the expressions that we check into golden files arise from+-ddump-splices output, which puts surrounding whitespace after the backslashes+in lambda expressions. As a result, the expression above would be+pretty-printed as (id \ x -> x), which avoids the issue entirely. Again, we+will choose not to worry about this corner case unless it becomes an issue in+practice.+-}++normalizeOutput :: FilePath -> IO ()+normalizeOutput file = Turtle.inplace pat (fromString file)+ where+ pat :: Turtle.Pattern Text+ pat = asum+ [ "(0,0)-(0,0)" <$ numPair <* "-" <* numPair+ , ":0:0:" <$ ":" <* d <* ":" <* d <* "-" <* d+ , ":0:0" <$ ":" <* d <* ":" <* d+ , fromString @Text . numPeriod <$> Turtle.lowerBounded 10 Turtle.digit+ , fromString @Text . ('%' <$) <$> Turtle.lowerBounded 10 punctSym+ -- Remove pretty-printed references to the singletons package+ -- (e.g., turn `singletons-2.4.1:Sing` into `Sing`) to make the output+ -- more stable.+ , "" <$ "singletons-" <* verNum <* ":"+ , do x <- Turtle.alphaNum+ _ <- Turtle.char '\\'+ y <- Turtle.alphaNum+ pure $ Text.pack [x, '/', y]+ ]+ verNum = d `Turtle.sepBy` Turtle.char '.'+ numPair = () <$ "(" <* d <* "," <* d <* ")"+ punctSym = Turtle.oneOf "!#$%&*+./>"+ numPeriod = zipWith const (cycle "0123456789876543210")+ d = Turtle.some Turtle.digit++cleanFiles :: IO ()+cleanFiles = callCommand $ "rm -f " ++ rootDir </> "tests/compile-and-dump/*/*.{hi,o}"
tests/compile-and-dump/GradingClient/Database.golden view
@@ -1,3487 +1,3264 @@-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 :: Nat - type family ZeroSym0 :: Nat where - ZeroSym0 = Zero - type SuccSym0 :: (~>) Nat Nat - data SuccSym0 :: (~>) Nat Nat - where - SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0 a0123456789876543210 - type instance Apply SuccSym0 a0123456789876543210 = Succ a0123456789876543210 - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings = snd ((,) SuccSym0KindInference ()) - type SuccSym1 :: Nat -> Nat - type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where - SuccSym1 a0123456789876543210 = Succ a0123456789876543210 - type TFHelper_0123456789876543210 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where - TFHelper_0123456789876543210 Zero Zero = TrueSym0 - TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0 - TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0 - TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Nat -> (~>) Nat Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Nat where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Nat -> (~>) Nat Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - data SNat :: Nat -> Type - where - SZero :: SNat (Zero :: Nat) - SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat) - type instance Sing @Nat = SNat - 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 SEq Nat => SEq Nat where - (%==) :: - forall (t1 :: Nat) (t2 :: Nat). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Nat ((~>) Nat Bool) - -> Type) t1) t2) - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_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) - -> Type) t1) t2) - sCompare SZero SZero - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - (applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing - (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210) - sB_0123456789876543210)) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - 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 SDecide Nat => - Data.Type.Equality.TestEquality (SNat :: Nat -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide Nat => - Data.Type.Coercion.TestCoercion (SNat :: Nat -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing - instance SingI1 Succ where - liftSing = SSucc - instance SingI (SuccSym0 :: (~>) Nat Nat) where - sing = singFun1 @SuccSym0 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 :: U - type family BOOLSym0 :: U where - BOOLSym0 = BOOL - type STRINGSym0 :: U - type family STRINGSym0 :: U where - STRINGSym0 = STRING - type NATSym0 :: U - type family NATSym0 :: U where - NATSym0 = NAT - type VECSym0 :: (~>) U ((~>) Nat U) - data VECSym0 :: (~>) U ((~>) Nat U) - where - VECSym0KindInference :: SameKind (Apply VECSym0 arg) (VECSym1 arg) => - VECSym0 a0123456789876543210 - type instance Apply VECSym0 a0123456789876543210 = VECSym1 a0123456789876543210 - instance SuppressUnusedWarnings VECSym0 where - suppressUnusedWarnings = snd ((,) VECSym0KindInference ()) - type VECSym1 :: U -> (~>) Nat U - data VECSym1 (a0123456789876543210 :: U) :: (~>) Nat U - where - VECSym1KindInference :: SameKind (Apply (VECSym1 a0123456789876543210) arg) (VECSym2 a0123456789876543210 arg) => - VECSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (VECSym1 a0123456789876543210) a0123456789876543210 = VEC a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (VECSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) VECSym1KindInference ()) - type VECSym2 :: U -> Nat -> U - type family VECSym2 (a0123456789876543210 :: U) (a0123456789876543210 :: Nat) :: U where - VECSym2 a0123456789876543210 a0123456789876543210 = VEC a0123456789876543210 a0123456789876543210 - type CASym0 :: AChar - type family CASym0 :: AChar where - CASym0 = CA - type CBSym0 :: AChar - type family CBSym0 :: AChar where - CBSym0 = CB - type CCSym0 :: AChar - type family CCSym0 :: AChar where - CCSym0 = CC - type CDSym0 :: AChar - type family CDSym0 :: AChar where - CDSym0 = CD - type CESym0 :: AChar - type family CESym0 :: AChar where - CESym0 = CE - type CFSym0 :: AChar - type family CFSym0 :: AChar where - CFSym0 = CF - type CGSym0 :: AChar - type family CGSym0 :: AChar where - CGSym0 = CG - type CHSym0 :: AChar - type family CHSym0 :: AChar where - CHSym0 = CH - type CISym0 :: AChar - type family CISym0 :: AChar where - CISym0 = CI - type CJSym0 :: AChar - type family CJSym0 :: AChar where - CJSym0 = CJ - type CKSym0 :: AChar - type family CKSym0 :: AChar where - CKSym0 = CK - type CLSym0 :: AChar - type family CLSym0 :: AChar where - CLSym0 = CL - type CMSym0 :: AChar - type family CMSym0 :: AChar where - CMSym0 = CM - type CNSym0 :: AChar - type family CNSym0 :: AChar where - CNSym0 = CN - type COSym0 :: AChar - type family COSym0 :: AChar where - COSym0 = CO - type CPSym0 :: AChar - type family CPSym0 :: AChar where - CPSym0 = CP - type CQSym0 :: AChar - type family CQSym0 :: AChar where - CQSym0 = CQ - type CRSym0 :: AChar - type family CRSym0 :: AChar where - CRSym0 = CR - type CSSym0 :: AChar - type family CSSym0 :: AChar where - CSSym0 = CS - type CTSym0 :: AChar - type family CTSym0 :: AChar where - CTSym0 = CT - type CUSym0 :: AChar - type family CUSym0 :: AChar where - CUSym0 = CU - type CVSym0 :: AChar - type family CVSym0 :: AChar where - CVSym0 = CV - type CWSym0 :: AChar - type family CWSym0 :: AChar where - CWSym0 = CW - type CXSym0 :: AChar - type family CXSym0 :: AChar where - CXSym0 = CX - type CYSym0 :: AChar - type family CYSym0 :: AChar where - CYSym0 = CY - type CZSym0 :: AChar - type family CZSym0 :: AChar where - CZSym0 = CZ - type AttrSym0 :: (~>) [AChar] ((~>) U Attribute) - data AttrSym0 :: (~>) [AChar] ((~>) U Attribute) - where - AttrSym0KindInference :: SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => - AttrSym0 a0123456789876543210 - type instance Apply AttrSym0 a0123456789876543210 = AttrSym1 a0123456789876543210 - instance SuppressUnusedWarnings AttrSym0 where - suppressUnusedWarnings = snd ((,) AttrSym0KindInference ()) - type AttrSym1 :: [AChar] -> (~>) U Attribute - data AttrSym1 (a0123456789876543210 :: [AChar]) :: (~>) U Attribute - where - AttrSym1KindInference :: SameKind (Apply (AttrSym1 a0123456789876543210) arg) (AttrSym2 a0123456789876543210 arg) => - AttrSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AttrSym1 a0123456789876543210) a0123456789876543210 = Attr a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AttrSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) AttrSym1KindInference ()) - type AttrSym2 :: [AChar] -> U -> Attribute - type family AttrSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: U) :: Attribute where - AttrSym2 a0123456789876543210 a0123456789876543210 = Attr a0123456789876543210 a0123456789876543210 - type SchSym0 :: (~>) [Attribute] Schema - data SchSym0 :: (~>) [Attribute] Schema - where - SchSym0KindInference :: SameKind (Apply SchSym0 arg) (SchSym1 arg) => - SchSym0 a0123456789876543210 - type instance Apply SchSym0 a0123456789876543210 = Sch a0123456789876543210 - instance SuppressUnusedWarnings SchSym0 where - suppressUnusedWarnings = snd ((,) SchSym0KindInference ()) - type SchSym1 :: [Attribute] -> Schema - type family SchSym1 (a0123456789876543210 :: [Attribute]) :: Schema where - SchSym1 a0123456789876543210 = Sch a0123456789876543210 - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 name0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: 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 name0123456789876543210 name'0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: 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 name0123456789876543210 name'0123456789876543210 u0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 - 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 LookupSym0 :: (~>) [AChar] ((~>) Schema U) - data LookupSym0 :: (~>) [AChar] ((~>) Schema U) - where - LookupSym0KindInference :: SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => - LookupSym0 a0123456789876543210 - type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210 - instance SuppressUnusedWarnings LookupSym0 where - suppressUnusedWarnings = snd ((,) LookupSym0KindInference ()) - type LookupSym1 :: [AChar] -> (~>) Schema U - data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U - where - LookupSym1KindInference :: SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) => - LookupSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LookupSym1 a0123456789876543210) a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) LookupSym1KindInference ()) - type LookupSym2 :: [AChar] -> Schema -> U - type family LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) :: U where - LookupSym2 a0123456789876543210 a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210 - type OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) - data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) - where - OccursSym0KindInference :: SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => - OccursSym0 a0123456789876543210 - type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 - instance SuppressUnusedWarnings OccursSym0 where - suppressUnusedWarnings = snd ((,) OccursSym0KindInference ()) - type OccursSym1 :: [AChar] -> (~>) Schema Bool - data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool - where - OccursSym1KindInference :: SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) => - OccursSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (OccursSym1 a0123456789876543210) a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) OccursSym1KindInference ()) - type OccursSym2 :: [AChar] -> Schema -> Bool - type family OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) :: Bool where - OccursSym2 a0123456789876543210 a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210 - type DisjointSym0 :: (~>) Schema ((~>) Schema Bool) - data DisjointSym0 :: (~>) Schema ((~>) Schema Bool) - where - DisjointSym0KindInference :: SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => - DisjointSym0 a0123456789876543210 - type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210 - instance SuppressUnusedWarnings DisjointSym0 where - suppressUnusedWarnings = snd ((,) DisjointSym0KindInference ()) - type DisjointSym1 :: Schema -> (~>) Schema Bool - data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool - where - DisjointSym1KindInference :: SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) => - DisjointSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (DisjointSym1 a0123456789876543210) a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) DisjointSym1KindInference ()) - type DisjointSym2 :: Schema -> Schema -> Bool - type family DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) :: Bool where - DisjointSym2 a0123456789876543210 a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210 - type AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) - data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) - where - AttrNotInSym0KindInference :: SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => - AttrNotInSym0 a0123456789876543210 - type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 - instance SuppressUnusedWarnings AttrNotInSym0 where - suppressUnusedWarnings = snd ((,) AttrNotInSym0KindInference ()) - type AttrNotInSym1 :: Attribute -> (~>) Schema Bool - data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool - where - AttrNotInSym1KindInference :: SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => - AttrNotInSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) AttrNotInSym1KindInference ()) - type AttrNotInSym2 :: Attribute -> Schema -> Bool - type family AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) :: Bool where - AttrNotInSym2 a0123456789876543210 a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 - type AppendSym0 :: (~>) Schema ((~>) Schema Schema) - data AppendSym0 :: (~>) Schema ((~>) Schema Schema) - where - AppendSym0KindInference :: SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => - AppendSym0 a0123456789876543210 - type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210 - instance SuppressUnusedWarnings AppendSym0 where - suppressUnusedWarnings = snd ((,) AppendSym0KindInference ()) - type AppendSym1 :: Schema -> (~>) Schema Schema - data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema - where - AppendSym1KindInference :: SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) => - AppendSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AppendSym1 a0123456789876543210) a0123456789876543210 = Append a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) AppendSym1KindInference ()) - type AppendSym2 :: Schema -> Schema -> Schema - type family AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) :: Schema where - AppendSym2 a0123456789876543210 a0123456789876543210 = Append a0123456789876543210 a0123456789876543210 - type Lookup :: [AChar] -> Schema -> U - 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 Occurs :: [AChar] -> Schema -> Bool - 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 Disjoint :: Schema -> Schema -> Bool - 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 AttrNotIn :: Attribute -> Schema -> Bool - 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 Append :: Schema -> Schema -> Schema - type family Append (a :: Schema) (a :: Schema) :: Schema where - Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) - type TFHelper_0123456789876543210 :: U -> U -> Bool - type family TFHelper_0123456789876543210 (a :: U) (a :: U) :: Bool where - TFHelper_0123456789876543210 BOOL BOOL = TrueSym0 - TFHelper_0123456789876543210 BOOL STRING = FalseSym0 - TFHelper_0123456789876543210 BOOL NAT = FalseSym0 - TFHelper_0123456789876543210 BOOL (VEC _ _) = FalseSym0 - TFHelper_0123456789876543210 STRING BOOL = FalseSym0 - TFHelper_0123456789876543210 STRING STRING = TrueSym0 - TFHelper_0123456789876543210 STRING NAT = FalseSym0 - TFHelper_0123456789876543210 STRING (VEC _ _) = FalseSym0 - TFHelper_0123456789876543210 NAT BOOL = FalseSym0 - TFHelper_0123456789876543210 NAT STRING = FalseSym0 - TFHelper_0123456789876543210 NAT NAT = TrueSym0 - TFHelper_0123456789876543210 NAT (VEC _ _) = FalseSym0 - TFHelper_0123456789876543210 (VEC _ _) BOOL = FalseSym0 - TFHelper_0123456789876543210 (VEC _ _) STRING = FalseSym0 - TFHelper_0123456789876543210 (VEC _ _) NAT = FalseSym0 - TFHelper_0123456789876543210 (VEC a_0123456789876543210 a_0123456789876543210) (VEC b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210) - type TFHelper_0123456789876543210Sym0 :: (~>) U ((~>) U Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) U ((~>) U Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: U -> (~>) U Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: U) :: (~>) U Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: U -> U -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: U) (a0123456789876543210 :: U) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq U where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> U -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) U ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) U ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) U ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) U ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> U -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: U) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> U -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow U where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> AChar -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) AChar ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) AChar ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) AChar ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) AChar ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> AChar -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> AChar -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow AChar where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type TFHelper_0123456789876543210 :: AChar -> AChar -> Bool - type family TFHelper_0123456789876543210 (a :: AChar) (a :: AChar) :: Bool where - TFHelper_0123456789876543210 CA CA = TrueSym0 - TFHelper_0123456789876543210 CA CB = FalseSym0 - TFHelper_0123456789876543210 CA CC = FalseSym0 - TFHelper_0123456789876543210 CA CD = FalseSym0 - TFHelper_0123456789876543210 CA CE = FalseSym0 - TFHelper_0123456789876543210 CA CF = FalseSym0 - TFHelper_0123456789876543210 CA CG = FalseSym0 - TFHelper_0123456789876543210 CA CH = FalseSym0 - TFHelper_0123456789876543210 CA CI = FalseSym0 - TFHelper_0123456789876543210 CA CJ = FalseSym0 - TFHelper_0123456789876543210 CA CK = FalseSym0 - TFHelper_0123456789876543210 CA CL = FalseSym0 - TFHelper_0123456789876543210 CA CM = FalseSym0 - TFHelper_0123456789876543210 CA CN = FalseSym0 - TFHelper_0123456789876543210 CA CO = FalseSym0 - TFHelper_0123456789876543210 CA CP = FalseSym0 - TFHelper_0123456789876543210 CA CQ = FalseSym0 - TFHelper_0123456789876543210 CA CR = FalseSym0 - TFHelper_0123456789876543210 CA CS = FalseSym0 - TFHelper_0123456789876543210 CA CT = FalseSym0 - TFHelper_0123456789876543210 CA CU = FalseSym0 - TFHelper_0123456789876543210 CA CV = FalseSym0 - TFHelper_0123456789876543210 CA CW = FalseSym0 - TFHelper_0123456789876543210 CA CX = FalseSym0 - TFHelper_0123456789876543210 CA CY = FalseSym0 - TFHelper_0123456789876543210 CA CZ = FalseSym0 - TFHelper_0123456789876543210 CB CA = FalseSym0 - TFHelper_0123456789876543210 CB CB = TrueSym0 - TFHelper_0123456789876543210 CB CC = FalseSym0 - TFHelper_0123456789876543210 CB CD = FalseSym0 - TFHelper_0123456789876543210 CB CE = FalseSym0 - TFHelper_0123456789876543210 CB CF = FalseSym0 - TFHelper_0123456789876543210 CB CG = FalseSym0 - TFHelper_0123456789876543210 CB CH = FalseSym0 - TFHelper_0123456789876543210 CB CI = FalseSym0 - TFHelper_0123456789876543210 CB CJ = FalseSym0 - TFHelper_0123456789876543210 CB CK = FalseSym0 - TFHelper_0123456789876543210 CB CL = FalseSym0 - TFHelper_0123456789876543210 CB CM = FalseSym0 - TFHelper_0123456789876543210 CB CN = FalseSym0 - TFHelper_0123456789876543210 CB CO = FalseSym0 - TFHelper_0123456789876543210 CB CP = FalseSym0 - TFHelper_0123456789876543210 CB CQ = FalseSym0 - TFHelper_0123456789876543210 CB CR = FalseSym0 - TFHelper_0123456789876543210 CB CS = FalseSym0 - TFHelper_0123456789876543210 CB CT = FalseSym0 - TFHelper_0123456789876543210 CB CU = FalseSym0 - TFHelper_0123456789876543210 CB CV = FalseSym0 - TFHelper_0123456789876543210 CB CW = FalseSym0 - TFHelper_0123456789876543210 CB CX = FalseSym0 - TFHelper_0123456789876543210 CB CY = FalseSym0 - TFHelper_0123456789876543210 CB CZ = FalseSym0 - TFHelper_0123456789876543210 CC CA = FalseSym0 - TFHelper_0123456789876543210 CC CB = FalseSym0 - TFHelper_0123456789876543210 CC CC = TrueSym0 - TFHelper_0123456789876543210 CC CD = FalseSym0 - TFHelper_0123456789876543210 CC CE = FalseSym0 - TFHelper_0123456789876543210 CC CF = FalseSym0 - TFHelper_0123456789876543210 CC CG = FalseSym0 - TFHelper_0123456789876543210 CC CH = FalseSym0 - TFHelper_0123456789876543210 CC CI = FalseSym0 - TFHelper_0123456789876543210 CC CJ = FalseSym0 - TFHelper_0123456789876543210 CC CK = FalseSym0 - TFHelper_0123456789876543210 CC CL = FalseSym0 - TFHelper_0123456789876543210 CC CM = FalseSym0 - TFHelper_0123456789876543210 CC CN = FalseSym0 - TFHelper_0123456789876543210 CC CO = FalseSym0 - TFHelper_0123456789876543210 CC CP = FalseSym0 - TFHelper_0123456789876543210 CC CQ = FalseSym0 - TFHelper_0123456789876543210 CC CR = FalseSym0 - TFHelper_0123456789876543210 CC CS = FalseSym0 - TFHelper_0123456789876543210 CC CT = FalseSym0 - TFHelper_0123456789876543210 CC CU = FalseSym0 - TFHelper_0123456789876543210 CC CV = FalseSym0 - TFHelper_0123456789876543210 CC CW = FalseSym0 - TFHelper_0123456789876543210 CC CX = FalseSym0 - TFHelper_0123456789876543210 CC CY = FalseSym0 - TFHelper_0123456789876543210 CC CZ = FalseSym0 - TFHelper_0123456789876543210 CD CA = FalseSym0 - TFHelper_0123456789876543210 CD CB = FalseSym0 - TFHelper_0123456789876543210 CD CC = FalseSym0 - TFHelper_0123456789876543210 CD CD = TrueSym0 - TFHelper_0123456789876543210 CD CE = FalseSym0 - TFHelper_0123456789876543210 CD CF = FalseSym0 - TFHelper_0123456789876543210 CD CG = FalseSym0 - TFHelper_0123456789876543210 CD CH = FalseSym0 - TFHelper_0123456789876543210 CD CI = FalseSym0 - TFHelper_0123456789876543210 CD CJ = FalseSym0 - TFHelper_0123456789876543210 CD CK = FalseSym0 - TFHelper_0123456789876543210 CD CL = FalseSym0 - TFHelper_0123456789876543210 CD CM = FalseSym0 - TFHelper_0123456789876543210 CD CN = FalseSym0 - TFHelper_0123456789876543210 CD CO = FalseSym0 - TFHelper_0123456789876543210 CD CP = FalseSym0 - TFHelper_0123456789876543210 CD CQ = FalseSym0 - TFHelper_0123456789876543210 CD CR = FalseSym0 - TFHelper_0123456789876543210 CD CS = FalseSym0 - TFHelper_0123456789876543210 CD CT = FalseSym0 - TFHelper_0123456789876543210 CD CU = FalseSym0 - TFHelper_0123456789876543210 CD CV = FalseSym0 - TFHelper_0123456789876543210 CD CW = FalseSym0 - TFHelper_0123456789876543210 CD CX = FalseSym0 - TFHelper_0123456789876543210 CD CY = FalseSym0 - TFHelper_0123456789876543210 CD CZ = FalseSym0 - TFHelper_0123456789876543210 CE CA = FalseSym0 - TFHelper_0123456789876543210 CE CB = FalseSym0 - TFHelper_0123456789876543210 CE CC = FalseSym0 - TFHelper_0123456789876543210 CE CD = FalseSym0 - TFHelper_0123456789876543210 CE CE = TrueSym0 - TFHelper_0123456789876543210 CE CF = FalseSym0 - TFHelper_0123456789876543210 CE CG = FalseSym0 - TFHelper_0123456789876543210 CE CH = FalseSym0 - TFHelper_0123456789876543210 CE CI = FalseSym0 - TFHelper_0123456789876543210 CE CJ = FalseSym0 - TFHelper_0123456789876543210 CE CK = FalseSym0 - TFHelper_0123456789876543210 CE CL = FalseSym0 - TFHelper_0123456789876543210 CE CM = FalseSym0 - TFHelper_0123456789876543210 CE CN = FalseSym0 - TFHelper_0123456789876543210 CE CO = FalseSym0 - TFHelper_0123456789876543210 CE CP = FalseSym0 - TFHelper_0123456789876543210 CE CQ = FalseSym0 - TFHelper_0123456789876543210 CE CR = FalseSym0 - TFHelper_0123456789876543210 CE CS = FalseSym0 - TFHelper_0123456789876543210 CE CT = FalseSym0 - TFHelper_0123456789876543210 CE CU = FalseSym0 - TFHelper_0123456789876543210 CE CV = FalseSym0 - TFHelper_0123456789876543210 CE CW = FalseSym0 - TFHelper_0123456789876543210 CE CX = FalseSym0 - TFHelper_0123456789876543210 CE CY = FalseSym0 - TFHelper_0123456789876543210 CE CZ = FalseSym0 - TFHelper_0123456789876543210 CF CA = FalseSym0 - TFHelper_0123456789876543210 CF CB = FalseSym0 - TFHelper_0123456789876543210 CF CC = FalseSym0 - TFHelper_0123456789876543210 CF CD = FalseSym0 - TFHelper_0123456789876543210 CF CE = FalseSym0 - TFHelper_0123456789876543210 CF CF = TrueSym0 - TFHelper_0123456789876543210 CF CG = FalseSym0 - TFHelper_0123456789876543210 CF CH = FalseSym0 - TFHelper_0123456789876543210 CF CI = FalseSym0 - TFHelper_0123456789876543210 CF CJ = FalseSym0 - TFHelper_0123456789876543210 CF CK = FalseSym0 - TFHelper_0123456789876543210 CF CL = FalseSym0 - TFHelper_0123456789876543210 CF CM = FalseSym0 - TFHelper_0123456789876543210 CF CN = FalseSym0 - TFHelper_0123456789876543210 CF CO = FalseSym0 - TFHelper_0123456789876543210 CF CP = FalseSym0 - TFHelper_0123456789876543210 CF CQ = FalseSym0 - TFHelper_0123456789876543210 CF CR = FalseSym0 - TFHelper_0123456789876543210 CF CS = FalseSym0 - TFHelper_0123456789876543210 CF CT = FalseSym0 - TFHelper_0123456789876543210 CF CU = FalseSym0 - TFHelper_0123456789876543210 CF CV = FalseSym0 - TFHelper_0123456789876543210 CF CW = FalseSym0 - TFHelper_0123456789876543210 CF CX = FalseSym0 - TFHelper_0123456789876543210 CF CY = FalseSym0 - TFHelper_0123456789876543210 CF CZ = FalseSym0 - TFHelper_0123456789876543210 CG CA = FalseSym0 - TFHelper_0123456789876543210 CG CB = FalseSym0 - TFHelper_0123456789876543210 CG CC = FalseSym0 - TFHelper_0123456789876543210 CG CD = FalseSym0 - TFHelper_0123456789876543210 CG CE = FalseSym0 - TFHelper_0123456789876543210 CG CF = FalseSym0 - TFHelper_0123456789876543210 CG CG = TrueSym0 - TFHelper_0123456789876543210 CG CH = FalseSym0 - TFHelper_0123456789876543210 CG CI = FalseSym0 - TFHelper_0123456789876543210 CG CJ = FalseSym0 - TFHelper_0123456789876543210 CG CK = FalseSym0 - TFHelper_0123456789876543210 CG CL = FalseSym0 - TFHelper_0123456789876543210 CG CM = FalseSym0 - TFHelper_0123456789876543210 CG CN = FalseSym0 - TFHelper_0123456789876543210 CG CO = FalseSym0 - TFHelper_0123456789876543210 CG CP = FalseSym0 - TFHelper_0123456789876543210 CG CQ = FalseSym0 - TFHelper_0123456789876543210 CG CR = FalseSym0 - TFHelper_0123456789876543210 CG CS = FalseSym0 - TFHelper_0123456789876543210 CG CT = FalseSym0 - TFHelper_0123456789876543210 CG CU = FalseSym0 - TFHelper_0123456789876543210 CG CV = FalseSym0 - TFHelper_0123456789876543210 CG CW = FalseSym0 - TFHelper_0123456789876543210 CG CX = FalseSym0 - TFHelper_0123456789876543210 CG CY = FalseSym0 - TFHelper_0123456789876543210 CG CZ = FalseSym0 - TFHelper_0123456789876543210 CH CA = FalseSym0 - TFHelper_0123456789876543210 CH CB = FalseSym0 - TFHelper_0123456789876543210 CH CC = FalseSym0 - TFHelper_0123456789876543210 CH CD = FalseSym0 - TFHelper_0123456789876543210 CH CE = FalseSym0 - TFHelper_0123456789876543210 CH CF = FalseSym0 - TFHelper_0123456789876543210 CH CG = FalseSym0 - TFHelper_0123456789876543210 CH CH = TrueSym0 - TFHelper_0123456789876543210 CH CI = FalseSym0 - TFHelper_0123456789876543210 CH CJ = FalseSym0 - TFHelper_0123456789876543210 CH CK = FalseSym0 - TFHelper_0123456789876543210 CH CL = FalseSym0 - TFHelper_0123456789876543210 CH CM = FalseSym0 - TFHelper_0123456789876543210 CH CN = FalseSym0 - TFHelper_0123456789876543210 CH CO = FalseSym0 - TFHelper_0123456789876543210 CH CP = FalseSym0 - TFHelper_0123456789876543210 CH CQ = FalseSym0 - TFHelper_0123456789876543210 CH CR = FalseSym0 - TFHelper_0123456789876543210 CH CS = FalseSym0 - TFHelper_0123456789876543210 CH CT = FalseSym0 - TFHelper_0123456789876543210 CH CU = FalseSym0 - TFHelper_0123456789876543210 CH CV = FalseSym0 - TFHelper_0123456789876543210 CH CW = FalseSym0 - TFHelper_0123456789876543210 CH CX = FalseSym0 - TFHelper_0123456789876543210 CH CY = FalseSym0 - TFHelper_0123456789876543210 CH CZ = FalseSym0 - TFHelper_0123456789876543210 CI CA = FalseSym0 - TFHelper_0123456789876543210 CI CB = FalseSym0 - TFHelper_0123456789876543210 CI CC = FalseSym0 - TFHelper_0123456789876543210 CI CD = FalseSym0 - TFHelper_0123456789876543210 CI CE = FalseSym0 - TFHelper_0123456789876543210 CI CF = FalseSym0 - TFHelper_0123456789876543210 CI CG = FalseSym0 - TFHelper_0123456789876543210 CI CH = FalseSym0 - TFHelper_0123456789876543210 CI CI = TrueSym0 - TFHelper_0123456789876543210 CI CJ = FalseSym0 - TFHelper_0123456789876543210 CI CK = FalseSym0 - TFHelper_0123456789876543210 CI CL = FalseSym0 - TFHelper_0123456789876543210 CI CM = FalseSym0 - TFHelper_0123456789876543210 CI CN = FalseSym0 - TFHelper_0123456789876543210 CI CO = FalseSym0 - TFHelper_0123456789876543210 CI CP = FalseSym0 - TFHelper_0123456789876543210 CI CQ = FalseSym0 - TFHelper_0123456789876543210 CI CR = FalseSym0 - TFHelper_0123456789876543210 CI CS = FalseSym0 - TFHelper_0123456789876543210 CI CT = FalseSym0 - TFHelper_0123456789876543210 CI CU = FalseSym0 - TFHelper_0123456789876543210 CI CV = FalseSym0 - TFHelper_0123456789876543210 CI CW = FalseSym0 - TFHelper_0123456789876543210 CI CX = FalseSym0 - TFHelper_0123456789876543210 CI CY = FalseSym0 - TFHelper_0123456789876543210 CI CZ = FalseSym0 - TFHelper_0123456789876543210 CJ CA = FalseSym0 - TFHelper_0123456789876543210 CJ CB = FalseSym0 - TFHelper_0123456789876543210 CJ CC = FalseSym0 - TFHelper_0123456789876543210 CJ CD = FalseSym0 - TFHelper_0123456789876543210 CJ CE = FalseSym0 - TFHelper_0123456789876543210 CJ CF = FalseSym0 - TFHelper_0123456789876543210 CJ CG = FalseSym0 - TFHelper_0123456789876543210 CJ CH = FalseSym0 - TFHelper_0123456789876543210 CJ CI = FalseSym0 - TFHelper_0123456789876543210 CJ CJ = TrueSym0 - TFHelper_0123456789876543210 CJ CK = FalseSym0 - TFHelper_0123456789876543210 CJ CL = FalseSym0 - TFHelper_0123456789876543210 CJ CM = FalseSym0 - TFHelper_0123456789876543210 CJ CN = FalseSym0 - TFHelper_0123456789876543210 CJ CO = FalseSym0 - TFHelper_0123456789876543210 CJ CP = FalseSym0 - TFHelper_0123456789876543210 CJ CQ = FalseSym0 - TFHelper_0123456789876543210 CJ CR = FalseSym0 - TFHelper_0123456789876543210 CJ CS = FalseSym0 - TFHelper_0123456789876543210 CJ CT = FalseSym0 - TFHelper_0123456789876543210 CJ CU = FalseSym0 - TFHelper_0123456789876543210 CJ CV = FalseSym0 - TFHelper_0123456789876543210 CJ CW = FalseSym0 - TFHelper_0123456789876543210 CJ CX = FalseSym0 - TFHelper_0123456789876543210 CJ CY = FalseSym0 - TFHelper_0123456789876543210 CJ CZ = FalseSym0 - TFHelper_0123456789876543210 CK CA = FalseSym0 - TFHelper_0123456789876543210 CK CB = FalseSym0 - TFHelper_0123456789876543210 CK CC = FalseSym0 - TFHelper_0123456789876543210 CK CD = FalseSym0 - TFHelper_0123456789876543210 CK CE = FalseSym0 - TFHelper_0123456789876543210 CK CF = FalseSym0 - TFHelper_0123456789876543210 CK CG = FalseSym0 - TFHelper_0123456789876543210 CK CH = FalseSym0 - TFHelper_0123456789876543210 CK CI = FalseSym0 - TFHelper_0123456789876543210 CK CJ = FalseSym0 - TFHelper_0123456789876543210 CK CK = TrueSym0 - TFHelper_0123456789876543210 CK CL = FalseSym0 - TFHelper_0123456789876543210 CK CM = FalseSym0 - TFHelper_0123456789876543210 CK CN = FalseSym0 - TFHelper_0123456789876543210 CK CO = FalseSym0 - TFHelper_0123456789876543210 CK CP = FalseSym0 - TFHelper_0123456789876543210 CK CQ = FalseSym0 - TFHelper_0123456789876543210 CK CR = FalseSym0 - TFHelper_0123456789876543210 CK CS = FalseSym0 - TFHelper_0123456789876543210 CK CT = FalseSym0 - TFHelper_0123456789876543210 CK CU = FalseSym0 - TFHelper_0123456789876543210 CK CV = FalseSym0 - TFHelper_0123456789876543210 CK CW = FalseSym0 - TFHelper_0123456789876543210 CK CX = FalseSym0 - TFHelper_0123456789876543210 CK CY = FalseSym0 - TFHelper_0123456789876543210 CK CZ = FalseSym0 - TFHelper_0123456789876543210 CL CA = FalseSym0 - TFHelper_0123456789876543210 CL CB = FalseSym0 - TFHelper_0123456789876543210 CL CC = FalseSym0 - TFHelper_0123456789876543210 CL CD = FalseSym0 - TFHelper_0123456789876543210 CL CE = FalseSym0 - TFHelper_0123456789876543210 CL CF = FalseSym0 - TFHelper_0123456789876543210 CL CG = FalseSym0 - TFHelper_0123456789876543210 CL CH = FalseSym0 - TFHelper_0123456789876543210 CL CI = FalseSym0 - TFHelper_0123456789876543210 CL CJ = FalseSym0 - TFHelper_0123456789876543210 CL CK = FalseSym0 - TFHelper_0123456789876543210 CL CL = TrueSym0 - TFHelper_0123456789876543210 CL CM = FalseSym0 - TFHelper_0123456789876543210 CL CN = FalseSym0 - TFHelper_0123456789876543210 CL CO = FalseSym0 - TFHelper_0123456789876543210 CL CP = FalseSym0 - TFHelper_0123456789876543210 CL CQ = FalseSym0 - TFHelper_0123456789876543210 CL CR = FalseSym0 - TFHelper_0123456789876543210 CL CS = FalseSym0 - TFHelper_0123456789876543210 CL CT = FalseSym0 - TFHelper_0123456789876543210 CL CU = FalseSym0 - TFHelper_0123456789876543210 CL CV = FalseSym0 - TFHelper_0123456789876543210 CL CW = FalseSym0 - TFHelper_0123456789876543210 CL CX = FalseSym0 - TFHelper_0123456789876543210 CL CY = FalseSym0 - TFHelper_0123456789876543210 CL CZ = FalseSym0 - TFHelper_0123456789876543210 CM CA = FalseSym0 - TFHelper_0123456789876543210 CM CB = FalseSym0 - TFHelper_0123456789876543210 CM CC = FalseSym0 - TFHelper_0123456789876543210 CM CD = FalseSym0 - TFHelper_0123456789876543210 CM CE = FalseSym0 - TFHelper_0123456789876543210 CM CF = FalseSym0 - TFHelper_0123456789876543210 CM CG = FalseSym0 - TFHelper_0123456789876543210 CM CH = FalseSym0 - TFHelper_0123456789876543210 CM CI = FalseSym0 - TFHelper_0123456789876543210 CM CJ = FalseSym0 - TFHelper_0123456789876543210 CM CK = FalseSym0 - TFHelper_0123456789876543210 CM CL = FalseSym0 - TFHelper_0123456789876543210 CM CM = TrueSym0 - TFHelper_0123456789876543210 CM CN = FalseSym0 - TFHelper_0123456789876543210 CM CO = FalseSym0 - TFHelper_0123456789876543210 CM CP = FalseSym0 - TFHelper_0123456789876543210 CM CQ = FalseSym0 - TFHelper_0123456789876543210 CM CR = FalseSym0 - TFHelper_0123456789876543210 CM CS = FalseSym0 - TFHelper_0123456789876543210 CM CT = FalseSym0 - TFHelper_0123456789876543210 CM CU = FalseSym0 - TFHelper_0123456789876543210 CM CV = FalseSym0 - TFHelper_0123456789876543210 CM CW = FalseSym0 - TFHelper_0123456789876543210 CM CX = FalseSym0 - TFHelper_0123456789876543210 CM CY = FalseSym0 - TFHelper_0123456789876543210 CM CZ = FalseSym0 - TFHelper_0123456789876543210 CN CA = FalseSym0 - TFHelper_0123456789876543210 CN CB = FalseSym0 - TFHelper_0123456789876543210 CN CC = FalseSym0 - TFHelper_0123456789876543210 CN CD = FalseSym0 - TFHelper_0123456789876543210 CN CE = FalseSym0 - TFHelper_0123456789876543210 CN CF = FalseSym0 - TFHelper_0123456789876543210 CN CG = FalseSym0 - TFHelper_0123456789876543210 CN CH = FalseSym0 - TFHelper_0123456789876543210 CN CI = FalseSym0 - TFHelper_0123456789876543210 CN CJ = FalseSym0 - TFHelper_0123456789876543210 CN CK = FalseSym0 - TFHelper_0123456789876543210 CN CL = FalseSym0 - TFHelper_0123456789876543210 CN CM = FalseSym0 - TFHelper_0123456789876543210 CN CN = TrueSym0 - TFHelper_0123456789876543210 CN CO = FalseSym0 - TFHelper_0123456789876543210 CN CP = FalseSym0 - TFHelper_0123456789876543210 CN CQ = FalseSym0 - TFHelper_0123456789876543210 CN CR = FalseSym0 - TFHelper_0123456789876543210 CN CS = FalseSym0 - TFHelper_0123456789876543210 CN CT = FalseSym0 - TFHelper_0123456789876543210 CN CU = FalseSym0 - TFHelper_0123456789876543210 CN CV = FalseSym0 - TFHelper_0123456789876543210 CN CW = FalseSym0 - TFHelper_0123456789876543210 CN CX = FalseSym0 - TFHelper_0123456789876543210 CN CY = FalseSym0 - TFHelper_0123456789876543210 CN CZ = FalseSym0 - TFHelper_0123456789876543210 CO CA = FalseSym0 - TFHelper_0123456789876543210 CO CB = FalseSym0 - TFHelper_0123456789876543210 CO CC = FalseSym0 - TFHelper_0123456789876543210 CO CD = FalseSym0 - TFHelper_0123456789876543210 CO CE = FalseSym0 - TFHelper_0123456789876543210 CO CF = FalseSym0 - TFHelper_0123456789876543210 CO CG = FalseSym0 - TFHelper_0123456789876543210 CO CH = FalseSym0 - TFHelper_0123456789876543210 CO CI = FalseSym0 - TFHelper_0123456789876543210 CO CJ = FalseSym0 - TFHelper_0123456789876543210 CO CK = FalseSym0 - TFHelper_0123456789876543210 CO CL = FalseSym0 - TFHelper_0123456789876543210 CO CM = FalseSym0 - TFHelper_0123456789876543210 CO CN = FalseSym0 - TFHelper_0123456789876543210 CO CO = TrueSym0 - TFHelper_0123456789876543210 CO CP = FalseSym0 - TFHelper_0123456789876543210 CO CQ = FalseSym0 - TFHelper_0123456789876543210 CO CR = FalseSym0 - TFHelper_0123456789876543210 CO CS = FalseSym0 - TFHelper_0123456789876543210 CO CT = FalseSym0 - TFHelper_0123456789876543210 CO CU = FalseSym0 - TFHelper_0123456789876543210 CO CV = FalseSym0 - TFHelper_0123456789876543210 CO CW = FalseSym0 - TFHelper_0123456789876543210 CO CX = FalseSym0 - TFHelper_0123456789876543210 CO CY = FalseSym0 - TFHelper_0123456789876543210 CO CZ = FalseSym0 - TFHelper_0123456789876543210 CP CA = FalseSym0 - TFHelper_0123456789876543210 CP CB = FalseSym0 - TFHelper_0123456789876543210 CP CC = FalseSym0 - TFHelper_0123456789876543210 CP CD = FalseSym0 - TFHelper_0123456789876543210 CP CE = FalseSym0 - TFHelper_0123456789876543210 CP CF = FalseSym0 - TFHelper_0123456789876543210 CP CG = FalseSym0 - TFHelper_0123456789876543210 CP CH = FalseSym0 - TFHelper_0123456789876543210 CP CI = FalseSym0 - TFHelper_0123456789876543210 CP CJ = FalseSym0 - TFHelper_0123456789876543210 CP CK = FalseSym0 - TFHelper_0123456789876543210 CP CL = FalseSym0 - TFHelper_0123456789876543210 CP CM = FalseSym0 - TFHelper_0123456789876543210 CP CN = FalseSym0 - TFHelper_0123456789876543210 CP CO = FalseSym0 - TFHelper_0123456789876543210 CP CP = TrueSym0 - TFHelper_0123456789876543210 CP CQ = FalseSym0 - TFHelper_0123456789876543210 CP CR = FalseSym0 - TFHelper_0123456789876543210 CP CS = FalseSym0 - TFHelper_0123456789876543210 CP CT = FalseSym0 - TFHelper_0123456789876543210 CP CU = FalseSym0 - TFHelper_0123456789876543210 CP CV = FalseSym0 - TFHelper_0123456789876543210 CP CW = FalseSym0 - TFHelper_0123456789876543210 CP CX = FalseSym0 - TFHelper_0123456789876543210 CP CY = FalseSym0 - TFHelper_0123456789876543210 CP CZ = FalseSym0 - TFHelper_0123456789876543210 CQ CA = FalseSym0 - TFHelper_0123456789876543210 CQ CB = FalseSym0 - TFHelper_0123456789876543210 CQ CC = FalseSym0 - TFHelper_0123456789876543210 CQ CD = FalseSym0 - TFHelper_0123456789876543210 CQ CE = FalseSym0 - TFHelper_0123456789876543210 CQ CF = FalseSym0 - TFHelper_0123456789876543210 CQ CG = FalseSym0 - TFHelper_0123456789876543210 CQ CH = FalseSym0 - TFHelper_0123456789876543210 CQ CI = FalseSym0 - TFHelper_0123456789876543210 CQ CJ = FalseSym0 - TFHelper_0123456789876543210 CQ CK = FalseSym0 - TFHelper_0123456789876543210 CQ CL = FalseSym0 - TFHelper_0123456789876543210 CQ CM = FalseSym0 - TFHelper_0123456789876543210 CQ CN = FalseSym0 - TFHelper_0123456789876543210 CQ CO = FalseSym0 - TFHelper_0123456789876543210 CQ CP = FalseSym0 - TFHelper_0123456789876543210 CQ CQ = TrueSym0 - TFHelper_0123456789876543210 CQ CR = FalseSym0 - TFHelper_0123456789876543210 CQ CS = FalseSym0 - TFHelper_0123456789876543210 CQ CT = FalseSym0 - TFHelper_0123456789876543210 CQ CU = FalseSym0 - TFHelper_0123456789876543210 CQ CV = FalseSym0 - TFHelper_0123456789876543210 CQ CW = FalseSym0 - TFHelper_0123456789876543210 CQ CX = FalseSym0 - TFHelper_0123456789876543210 CQ CY = FalseSym0 - TFHelper_0123456789876543210 CQ CZ = FalseSym0 - TFHelper_0123456789876543210 CR CA = FalseSym0 - TFHelper_0123456789876543210 CR CB = FalseSym0 - TFHelper_0123456789876543210 CR CC = FalseSym0 - TFHelper_0123456789876543210 CR CD = FalseSym0 - TFHelper_0123456789876543210 CR CE = FalseSym0 - TFHelper_0123456789876543210 CR CF = FalseSym0 - TFHelper_0123456789876543210 CR CG = FalseSym0 - TFHelper_0123456789876543210 CR CH = FalseSym0 - TFHelper_0123456789876543210 CR CI = FalseSym0 - TFHelper_0123456789876543210 CR CJ = FalseSym0 - TFHelper_0123456789876543210 CR CK = FalseSym0 - TFHelper_0123456789876543210 CR CL = FalseSym0 - TFHelper_0123456789876543210 CR CM = FalseSym0 - TFHelper_0123456789876543210 CR CN = FalseSym0 - TFHelper_0123456789876543210 CR CO = FalseSym0 - TFHelper_0123456789876543210 CR CP = FalseSym0 - TFHelper_0123456789876543210 CR CQ = FalseSym0 - TFHelper_0123456789876543210 CR CR = TrueSym0 - TFHelper_0123456789876543210 CR CS = FalseSym0 - TFHelper_0123456789876543210 CR CT = FalseSym0 - TFHelper_0123456789876543210 CR CU = FalseSym0 - TFHelper_0123456789876543210 CR CV = FalseSym0 - TFHelper_0123456789876543210 CR CW = FalseSym0 - TFHelper_0123456789876543210 CR CX = FalseSym0 - TFHelper_0123456789876543210 CR CY = FalseSym0 - TFHelper_0123456789876543210 CR CZ = FalseSym0 - TFHelper_0123456789876543210 CS CA = FalseSym0 - TFHelper_0123456789876543210 CS CB = FalseSym0 - TFHelper_0123456789876543210 CS CC = FalseSym0 - TFHelper_0123456789876543210 CS CD = FalseSym0 - TFHelper_0123456789876543210 CS CE = FalseSym0 - TFHelper_0123456789876543210 CS CF = FalseSym0 - TFHelper_0123456789876543210 CS CG = FalseSym0 - TFHelper_0123456789876543210 CS CH = FalseSym0 - TFHelper_0123456789876543210 CS CI = FalseSym0 - TFHelper_0123456789876543210 CS CJ = FalseSym0 - TFHelper_0123456789876543210 CS CK = FalseSym0 - TFHelper_0123456789876543210 CS CL = FalseSym0 - TFHelper_0123456789876543210 CS CM = FalseSym0 - TFHelper_0123456789876543210 CS CN = FalseSym0 - TFHelper_0123456789876543210 CS CO = FalseSym0 - TFHelper_0123456789876543210 CS CP = FalseSym0 - TFHelper_0123456789876543210 CS CQ = FalseSym0 - TFHelper_0123456789876543210 CS CR = FalseSym0 - TFHelper_0123456789876543210 CS CS = TrueSym0 - TFHelper_0123456789876543210 CS CT = FalseSym0 - TFHelper_0123456789876543210 CS CU = FalseSym0 - TFHelper_0123456789876543210 CS CV = FalseSym0 - TFHelper_0123456789876543210 CS CW = FalseSym0 - TFHelper_0123456789876543210 CS CX = FalseSym0 - TFHelper_0123456789876543210 CS CY = FalseSym0 - TFHelper_0123456789876543210 CS CZ = FalseSym0 - TFHelper_0123456789876543210 CT CA = FalseSym0 - TFHelper_0123456789876543210 CT CB = FalseSym0 - TFHelper_0123456789876543210 CT CC = FalseSym0 - TFHelper_0123456789876543210 CT CD = FalseSym0 - TFHelper_0123456789876543210 CT CE = FalseSym0 - TFHelper_0123456789876543210 CT CF = FalseSym0 - TFHelper_0123456789876543210 CT CG = FalseSym0 - TFHelper_0123456789876543210 CT CH = FalseSym0 - TFHelper_0123456789876543210 CT CI = FalseSym0 - TFHelper_0123456789876543210 CT CJ = FalseSym0 - TFHelper_0123456789876543210 CT CK = FalseSym0 - TFHelper_0123456789876543210 CT CL = FalseSym0 - TFHelper_0123456789876543210 CT CM = FalseSym0 - TFHelper_0123456789876543210 CT CN = FalseSym0 - TFHelper_0123456789876543210 CT CO = FalseSym0 - TFHelper_0123456789876543210 CT CP = FalseSym0 - TFHelper_0123456789876543210 CT CQ = FalseSym0 - TFHelper_0123456789876543210 CT CR = FalseSym0 - TFHelper_0123456789876543210 CT CS = FalseSym0 - TFHelper_0123456789876543210 CT CT = TrueSym0 - TFHelper_0123456789876543210 CT CU = FalseSym0 - TFHelper_0123456789876543210 CT CV = FalseSym0 - TFHelper_0123456789876543210 CT CW = FalseSym0 - TFHelper_0123456789876543210 CT CX = FalseSym0 - TFHelper_0123456789876543210 CT CY = FalseSym0 - TFHelper_0123456789876543210 CT CZ = FalseSym0 - TFHelper_0123456789876543210 CU CA = FalseSym0 - TFHelper_0123456789876543210 CU CB = FalseSym0 - TFHelper_0123456789876543210 CU CC = FalseSym0 - TFHelper_0123456789876543210 CU CD = FalseSym0 - TFHelper_0123456789876543210 CU CE = FalseSym0 - TFHelper_0123456789876543210 CU CF = FalseSym0 - TFHelper_0123456789876543210 CU CG = FalseSym0 - TFHelper_0123456789876543210 CU CH = FalseSym0 - TFHelper_0123456789876543210 CU CI = FalseSym0 - TFHelper_0123456789876543210 CU CJ = FalseSym0 - TFHelper_0123456789876543210 CU CK = FalseSym0 - TFHelper_0123456789876543210 CU CL = FalseSym0 - TFHelper_0123456789876543210 CU CM = FalseSym0 - TFHelper_0123456789876543210 CU CN = FalseSym0 - TFHelper_0123456789876543210 CU CO = FalseSym0 - TFHelper_0123456789876543210 CU CP = FalseSym0 - TFHelper_0123456789876543210 CU CQ = FalseSym0 - TFHelper_0123456789876543210 CU CR = FalseSym0 - TFHelper_0123456789876543210 CU CS = FalseSym0 - TFHelper_0123456789876543210 CU CT = FalseSym0 - TFHelper_0123456789876543210 CU CU = TrueSym0 - TFHelper_0123456789876543210 CU CV = FalseSym0 - TFHelper_0123456789876543210 CU CW = FalseSym0 - TFHelper_0123456789876543210 CU CX = FalseSym0 - TFHelper_0123456789876543210 CU CY = FalseSym0 - TFHelper_0123456789876543210 CU CZ = FalseSym0 - TFHelper_0123456789876543210 CV CA = FalseSym0 - TFHelper_0123456789876543210 CV CB = FalseSym0 - TFHelper_0123456789876543210 CV CC = FalseSym0 - TFHelper_0123456789876543210 CV CD = FalseSym0 - TFHelper_0123456789876543210 CV CE = FalseSym0 - TFHelper_0123456789876543210 CV CF = FalseSym0 - TFHelper_0123456789876543210 CV CG = FalseSym0 - TFHelper_0123456789876543210 CV CH = FalseSym0 - TFHelper_0123456789876543210 CV CI = FalseSym0 - TFHelper_0123456789876543210 CV CJ = FalseSym0 - TFHelper_0123456789876543210 CV CK = FalseSym0 - TFHelper_0123456789876543210 CV CL = FalseSym0 - TFHelper_0123456789876543210 CV CM = FalseSym0 - TFHelper_0123456789876543210 CV CN = FalseSym0 - TFHelper_0123456789876543210 CV CO = FalseSym0 - TFHelper_0123456789876543210 CV CP = FalseSym0 - TFHelper_0123456789876543210 CV CQ = FalseSym0 - TFHelper_0123456789876543210 CV CR = FalseSym0 - TFHelper_0123456789876543210 CV CS = FalseSym0 - TFHelper_0123456789876543210 CV CT = FalseSym0 - TFHelper_0123456789876543210 CV CU = FalseSym0 - TFHelper_0123456789876543210 CV CV = TrueSym0 - TFHelper_0123456789876543210 CV CW = FalseSym0 - TFHelper_0123456789876543210 CV CX = FalseSym0 - TFHelper_0123456789876543210 CV CY = FalseSym0 - TFHelper_0123456789876543210 CV CZ = FalseSym0 - TFHelper_0123456789876543210 CW CA = FalseSym0 - TFHelper_0123456789876543210 CW CB = FalseSym0 - TFHelper_0123456789876543210 CW CC = FalseSym0 - TFHelper_0123456789876543210 CW CD = FalseSym0 - TFHelper_0123456789876543210 CW CE = FalseSym0 - TFHelper_0123456789876543210 CW CF = FalseSym0 - TFHelper_0123456789876543210 CW CG = FalseSym0 - TFHelper_0123456789876543210 CW CH = FalseSym0 - TFHelper_0123456789876543210 CW CI = FalseSym0 - TFHelper_0123456789876543210 CW CJ = FalseSym0 - TFHelper_0123456789876543210 CW CK = FalseSym0 - TFHelper_0123456789876543210 CW CL = FalseSym0 - TFHelper_0123456789876543210 CW CM = FalseSym0 - TFHelper_0123456789876543210 CW CN = FalseSym0 - TFHelper_0123456789876543210 CW CO = FalseSym0 - TFHelper_0123456789876543210 CW CP = FalseSym0 - TFHelper_0123456789876543210 CW CQ = FalseSym0 - TFHelper_0123456789876543210 CW CR = FalseSym0 - TFHelper_0123456789876543210 CW CS = FalseSym0 - TFHelper_0123456789876543210 CW CT = FalseSym0 - TFHelper_0123456789876543210 CW CU = FalseSym0 - TFHelper_0123456789876543210 CW CV = FalseSym0 - TFHelper_0123456789876543210 CW CW = TrueSym0 - TFHelper_0123456789876543210 CW CX = FalseSym0 - TFHelper_0123456789876543210 CW CY = FalseSym0 - TFHelper_0123456789876543210 CW CZ = FalseSym0 - TFHelper_0123456789876543210 CX CA = FalseSym0 - TFHelper_0123456789876543210 CX CB = FalseSym0 - TFHelper_0123456789876543210 CX CC = FalseSym0 - TFHelper_0123456789876543210 CX CD = FalseSym0 - TFHelper_0123456789876543210 CX CE = FalseSym0 - TFHelper_0123456789876543210 CX CF = FalseSym0 - TFHelper_0123456789876543210 CX CG = FalseSym0 - TFHelper_0123456789876543210 CX CH = FalseSym0 - TFHelper_0123456789876543210 CX CI = FalseSym0 - TFHelper_0123456789876543210 CX CJ = FalseSym0 - TFHelper_0123456789876543210 CX CK = FalseSym0 - TFHelper_0123456789876543210 CX CL = FalseSym0 - TFHelper_0123456789876543210 CX CM = FalseSym0 - TFHelper_0123456789876543210 CX CN = FalseSym0 - TFHelper_0123456789876543210 CX CO = FalseSym0 - TFHelper_0123456789876543210 CX CP = FalseSym0 - TFHelper_0123456789876543210 CX CQ = FalseSym0 - TFHelper_0123456789876543210 CX CR = FalseSym0 - TFHelper_0123456789876543210 CX CS = FalseSym0 - TFHelper_0123456789876543210 CX CT = FalseSym0 - TFHelper_0123456789876543210 CX CU = FalseSym0 - TFHelper_0123456789876543210 CX CV = FalseSym0 - TFHelper_0123456789876543210 CX CW = FalseSym0 - TFHelper_0123456789876543210 CX CX = TrueSym0 - TFHelper_0123456789876543210 CX CY = FalseSym0 - TFHelper_0123456789876543210 CX CZ = FalseSym0 - TFHelper_0123456789876543210 CY CA = FalseSym0 - TFHelper_0123456789876543210 CY CB = FalseSym0 - TFHelper_0123456789876543210 CY CC = FalseSym0 - TFHelper_0123456789876543210 CY CD = FalseSym0 - TFHelper_0123456789876543210 CY CE = FalseSym0 - TFHelper_0123456789876543210 CY CF = FalseSym0 - TFHelper_0123456789876543210 CY CG = FalseSym0 - TFHelper_0123456789876543210 CY CH = FalseSym0 - TFHelper_0123456789876543210 CY CI = FalseSym0 - TFHelper_0123456789876543210 CY CJ = FalseSym0 - TFHelper_0123456789876543210 CY CK = FalseSym0 - TFHelper_0123456789876543210 CY CL = FalseSym0 - TFHelper_0123456789876543210 CY CM = FalseSym0 - TFHelper_0123456789876543210 CY CN = FalseSym0 - TFHelper_0123456789876543210 CY CO = FalseSym0 - TFHelper_0123456789876543210 CY CP = FalseSym0 - TFHelper_0123456789876543210 CY CQ = FalseSym0 - TFHelper_0123456789876543210 CY CR = FalseSym0 - TFHelper_0123456789876543210 CY CS = FalseSym0 - TFHelper_0123456789876543210 CY CT = FalseSym0 - TFHelper_0123456789876543210 CY CU = FalseSym0 - TFHelper_0123456789876543210 CY CV = FalseSym0 - TFHelper_0123456789876543210 CY CW = FalseSym0 - TFHelper_0123456789876543210 CY CX = FalseSym0 - TFHelper_0123456789876543210 CY CY = TrueSym0 - TFHelper_0123456789876543210 CY CZ = FalseSym0 - TFHelper_0123456789876543210 CZ CA = FalseSym0 - TFHelper_0123456789876543210 CZ CB = FalseSym0 - TFHelper_0123456789876543210 CZ CC = FalseSym0 - TFHelper_0123456789876543210 CZ CD = FalseSym0 - TFHelper_0123456789876543210 CZ CE = FalseSym0 - TFHelper_0123456789876543210 CZ CF = FalseSym0 - TFHelper_0123456789876543210 CZ CG = FalseSym0 - TFHelper_0123456789876543210 CZ CH = FalseSym0 - TFHelper_0123456789876543210 CZ CI = FalseSym0 - TFHelper_0123456789876543210 CZ CJ = FalseSym0 - TFHelper_0123456789876543210 CZ CK = FalseSym0 - TFHelper_0123456789876543210 CZ CL = FalseSym0 - TFHelper_0123456789876543210 CZ CM = FalseSym0 - TFHelper_0123456789876543210 CZ CN = FalseSym0 - TFHelper_0123456789876543210 CZ CO = FalseSym0 - TFHelper_0123456789876543210 CZ CP = FalseSym0 - TFHelper_0123456789876543210 CZ CQ = FalseSym0 - TFHelper_0123456789876543210 CZ CR = FalseSym0 - TFHelper_0123456789876543210 CZ CS = FalseSym0 - TFHelper_0123456789876543210 CZ CT = FalseSym0 - TFHelper_0123456789876543210 CZ CU = FalseSym0 - TFHelper_0123456789876543210 CZ CV = FalseSym0 - TFHelper_0123456789876543210 CZ CW = FalseSym0 - TFHelper_0123456789876543210 CZ CX = FalseSym0 - TFHelper_0123456789876543210 CZ CY = FalseSym0 - TFHelper_0123456789876543210 CZ CZ = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) AChar ((~>) AChar Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) AChar ((~>) AChar Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: AChar -> (~>) AChar Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: AChar) :: (~>) AChar Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: AChar -> AChar -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: AChar) (a0123456789876543210 :: AChar) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq AChar where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - sLookup :: - (forall (t :: [AChar]) (t :: Schema). - Sing t - -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) :: Type) - sOccurs :: - (forall (t :: [AChar]) (t :: Schema). - Sing t - -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) :: Type) - sDisjoint :: - (forall (t :: Schema) (t :: Schema). - Sing t - -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) :: Type) - sAttrNotIn :: - (forall (t :: Attribute) (t :: Schema). - Sing t - -> Sing t - -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) :: Type) - sAppend :: - (forall (t :: Schema) (t :: Schema). - Sing t - -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) :: Type) - 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 - GHC.Base.id - @(Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs))) - (case sScrutinee_0123456789876543210 of - STrue -> sU - SFalse - -> applySing - (applySing (singFun2 @LookupSym0 sLookup) sName) - (applySing (singFun1 @SchSym0 SSch) sAttrs)) - 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)) - 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) - 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)) - 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 SingI1 (LookupSym1 :: [AChar] -> (~>) Schema U) where - liftSing (s :: Sing (d :: [AChar])) - = singFun1 @(LookupSym1 (d :: [AChar])) (sLookup s) - 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 SingI1 (OccursSym1 :: [AChar] -> (~>) Schema Bool) where - liftSing (s :: Sing (d :: [AChar])) - = singFun1 @(OccursSym1 (d :: [AChar])) (sOccurs s) - 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 SingI1 (DisjointSym1 :: Schema -> (~>) Schema Bool) where - liftSing (s :: Sing (d :: Schema)) - = singFun1 @(DisjointSym1 (d :: Schema)) (sDisjoint s) - 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 SingI1 (AttrNotInSym1 :: Attribute - -> (~>) Schema Bool) where - liftSing (s :: Sing (d :: Attribute)) - = singFun1 @(AttrNotInSym1 (d :: Attribute)) (sAttrNotIn s) - 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)) - instance SingI1 (AppendSym1 :: Schema -> (~>) Schema Schema) where - liftSing (s :: Sing (d :: Schema)) - = singFun1 @(AppendSym1 (d :: Schema)) (sAppend s) - data SU :: U -> Type - where - SBOOL :: SU (BOOL :: U) - SSTRING :: SU (STRING :: U) - SNAT :: SU (NAT :: U) - SVEC :: forall (n :: U) (n :: Nat). - (Sing n) -> (Sing n) -> SU (VEC n n :: U) - type instance Sing @U = SU - 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 SAChar :: AChar -> Type - where - SCA :: SAChar (CA :: AChar) - SCB :: SAChar (CB :: AChar) - SCC :: SAChar (CC :: AChar) - SCD :: SAChar (CD :: AChar) - SCE :: SAChar (CE :: AChar) - SCF :: SAChar (CF :: AChar) - SCG :: SAChar (CG :: AChar) - SCH :: SAChar (CH :: AChar) - SCI :: SAChar (CI :: AChar) - SCJ :: SAChar (CJ :: AChar) - SCK :: SAChar (CK :: AChar) - SCL :: SAChar (CL :: AChar) - SCM :: SAChar (CM :: AChar) - SCN :: SAChar (CN :: AChar) - SCO :: SAChar (CO :: AChar) - SCP :: SAChar (CP :: AChar) - SCQ :: SAChar (CQ :: AChar) - SCR :: SAChar (CR :: AChar) - SCS :: SAChar (CS :: AChar) - SCT :: SAChar (CT :: AChar) - SCU :: SAChar (CU :: AChar) - SCV :: SAChar (CV :: AChar) - SCW :: SAChar (CW :: AChar) - SCX :: SAChar (CX :: AChar) - SCY :: SAChar (CY :: AChar) - SCZ :: SAChar (CZ :: AChar) - type instance Sing @AChar = SAChar - 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 SAttribute :: Attribute -> Type - where - SAttr :: forall (n :: [AChar]) (n :: U). - (Sing n) -> (Sing n) -> SAttribute (Attr n n :: Attribute) - type instance Sing @Attribute = SAttribute - 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 SSchema :: Schema -> Type - where - SSch :: forall (n :: [Attribute]). - (Sing n) -> SSchema (Sch n :: Schema) - type instance Sing @Schema = SSchema - 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 (SEq U, SEq Nat) => SEq U where - (%==) :: - forall (t1 :: U) (t2 :: U). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun U ((~>) U Bool) - -> Type) t1) t2) - (%==) 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 (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SVEC (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210) - instance (SShow U, SShow Nat) => SShow U where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: U) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) 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.Num.Natural.Natural) - (t2 :: AChar) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) 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 AChar where - (%==) :: - forall (t1 :: AChar) (t2 :: AChar). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun AChar ((~>) AChar Bool) - -> Type) t1) t2) - (%==) 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 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 (SDecide U, SDecide Nat) => - Data.Type.Equality.TestEquality (SU :: U -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance (SDecide U, SDecide Nat) => - Data.Type.Coercion.TestCoercion (SU :: U -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - instance SDecide AChar where - (%~) SCA SCA = Proved Refl - (%~) SCA SCB = Disproved (\ x -> case x of {}) - (%~) SCA SCC = Disproved (\ x -> case x of {}) - (%~) SCA SCD = Disproved (\ x -> case x of {}) - (%~) SCA SCE = Disproved (\ x -> case x of {}) - (%~) SCA SCF = Disproved (\ x -> case x of {}) - (%~) SCA SCG = Disproved (\ x -> case x of {}) - (%~) SCA SCH = Disproved (\ x -> case x of {}) - (%~) SCA SCI = Disproved (\ x -> case x of {}) - (%~) SCA SCJ = Disproved (\ x -> case x of {}) - (%~) SCA SCK = Disproved (\ x -> case x of {}) - (%~) SCA SCL = Disproved (\ x -> case x of {}) - (%~) SCA SCM = Disproved (\ x -> case x of {}) - (%~) SCA SCN = Disproved (\ x -> case x of {}) - (%~) SCA SCO = Disproved (\ x -> case x of {}) - (%~) SCA SCP = Disproved (\ x -> case x of {}) - (%~) SCA SCQ = Disproved (\ x -> case x of {}) - (%~) SCA SCR = Disproved (\ x -> case x of {}) - (%~) SCA SCS = Disproved (\ x -> case x of {}) - (%~) SCA SCT = Disproved (\ x -> case x of {}) - (%~) SCA SCU = Disproved (\ x -> case x of {}) - (%~) SCA SCV = Disproved (\ x -> case x of {}) - (%~) SCA SCW = Disproved (\ x -> case x of {}) - (%~) SCA SCX = Disproved (\ x -> case x of {}) - (%~) SCA SCY = Disproved (\ x -> case x of {}) - (%~) SCA SCZ = Disproved (\ x -> case x of {}) - (%~) SCB SCA = Disproved (\ x -> case x of {}) - (%~) SCB SCB = Proved Refl - (%~) SCB SCC = Disproved (\ x -> case x of {}) - (%~) SCB SCD = Disproved (\ x -> case x of {}) - (%~) SCB SCE = Disproved (\ x -> case x of {}) - (%~) SCB SCF = Disproved (\ x -> case x of {}) - (%~) SCB SCG = Disproved (\ x -> case x of {}) - (%~) SCB SCH = Disproved (\ x -> case x of {}) - (%~) SCB SCI = Disproved (\ x -> case x of {}) - (%~) SCB SCJ = Disproved (\ x -> case x of {}) - (%~) SCB SCK = Disproved (\ x -> case x of {}) - (%~) SCB SCL = Disproved (\ x -> case x of {}) - (%~) SCB SCM = Disproved (\ x -> case x of {}) - (%~) SCB SCN = Disproved (\ x -> case x of {}) - (%~) SCB SCO = Disproved (\ x -> case x of {}) - (%~) SCB SCP = Disproved (\ x -> case x of {}) - (%~) SCB SCQ = Disproved (\ x -> case x of {}) - (%~) SCB SCR = Disproved (\ x -> case x of {}) - (%~) SCB SCS = Disproved (\ x -> case x of {}) - (%~) SCB SCT = Disproved (\ x -> case x of {}) - (%~) SCB SCU = Disproved (\ x -> case x of {}) - (%~) SCB SCV = Disproved (\ x -> case x of {}) - (%~) SCB SCW = Disproved (\ x -> case x of {}) - (%~) SCB SCX = Disproved (\ x -> case x of {}) - (%~) SCB SCY = Disproved (\ x -> case x of {}) - (%~) SCB SCZ = Disproved (\ x -> case x of {}) - (%~) SCC SCA = Disproved (\ x -> case x of {}) - (%~) SCC SCB = Disproved (\ x -> case x of {}) - (%~) SCC SCC = Proved Refl - (%~) SCC SCD = Disproved (\ x -> case x of {}) - (%~) SCC SCE = Disproved (\ x -> case x of {}) - (%~) SCC SCF = Disproved (\ x -> case x of {}) - (%~) SCC SCG = Disproved (\ x -> case x of {}) - (%~) SCC SCH = Disproved (\ x -> case x of {}) - (%~) SCC SCI = Disproved (\ x -> case x of {}) - (%~) SCC SCJ = Disproved (\ x -> case x of {}) - (%~) SCC SCK = Disproved (\ x -> case x of {}) - (%~) SCC SCL = Disproved (\ x -> case x of {}) - (%~) SCC SCM = Disproved (\ x -> case x of {}) - (%~) SCC SCN = Disproved (\ x -> case x of {}) - (%~) SCC SCO = Disproved (\ x -> case x of {}) - (%~) SCC SCP = Disproved (\ x -> case x of {}) - (%~) SCC SCQ = Disproved (\ x -> case x of {}) - (%~) SCC SCR = Disproved (\ x -> case x of {}) - (%~) SCC SCS = Disproved (\ x -> case x of {}) - (%~) SCC SCT = Disproved (\ x -> case x of {}) - (%~) SCC SCU = Disproved (\ x -> case x of {}) - (%~) SCC SCV = Disproved (\ x -> case x of {}) - (%~) SCC SCW = Disproved (\ x -> case x of {}) - (%~) SCC SCX = Disproved (\ x -> case x of {}) - (%~) SCC SCY = Disproved (\ x -> case x of {}) - (%~) SCC SCZ = Disproved (\ x -> case x of {}) - (%~) SCD SCA = Disproved (\ x -> case x of {}) - (%~) SCD SCB = Disproved (\ x -> case x of {}) - (%~) SCD SCC = Disproved (\ x -> case x of {}) - (%~) SCD SCD = Proved Refl - (%~) SCD SCE = Disproved (\ x -> case x of {}) - (%~) SCD SCF = Disproved (\ x -> case x of {}) - (%~) SCD SCG = Disproved (\ x -> case x of {}) - (%~) SCD SCH = Disproved (\ x -> case x of {}) - (%~) SCD SCI = Disproved (\ x -> case x of {}) - (%~) SCD SCJ = Disproved (\ x -> case x of {}) - (%~) SCD SCK = Disproved (\ x -> case x of {}) - (%~) SCD SCL = Disproved (\ x -> case x of {}) - (%~) SCD SCM = Disproved (\ x -> case x of {}) - (%~) SCD SCN = Disproved (\ x -> case x of {}) - (%~) SCD SCO = Disproved (\ x -> case x of {}) - (%~) SCD SCP = Disproved (\ x -> case x of {}) - (%~) SCD SCQ = Disproved (\ x -> case x of {}) - (%~) SCD SCR = Disproved (\ x -> case x of {}) - (%~) SCD SCS = Disproved (\ x -> case x of {}) - (%~) SCD SCT = Disproved (\ x -> case x of {}) - (%~) SCD SCU = Disproved (\ x -> case x of {}) - (%~) SCD SCV = Disproved (\ x -> case x of {}) - (%~) SCD SCW = Disproved (\ x -> case x of {}) - (%~) SCD SCX = Disproved (\ x -> case x of {}) - (%~) SCD SCY = Disproved (\ x -> case x of {}) - (%~) SCD SCZ = Disproved (\ x -> case x of {}) - (%~) SCE SCA = Disproved (\ x -> case x of {}) - (%~) SCE SCB = Disproved (\ x -> case x of {}) - (%~) SCE SCC = Disproved (\ x -> case x of {}) - (%~) SCE SCD = Disproved (\ x -> case x of {}) - (%~) SCE SCE = Proved Refl - (%~) SCE SCF = Disproved (\ x -> case x of {}) - (%~) SCE SCG = Disproved (\ x -> case x of {}) - (%~) SCE SCH = Disproved (\ x -> case x of {}) - (%~) SCE SCI = Disproved (\ x -> case x of {}) - (%~) SCE SCJ = Disproved (\ x -> case x of {}) - (%~) SCE SCK = Disproved (\ x -> case x of {}) - (%~) SCE SCL = Disproved (\ x -> case x of {}) - (%~) SCE SCM = Disproved (\ x -> case x of {}) - (%~) SCE SCN = Disproved (\ x -> case x of {}) - (%~) SCE SCO = Disproved (\ x -> case x of {}) - (%~) SCE SCP = Disproved (\ x -> case x of {}) - (%~) SCE SCQ = Disproved (\ x -> case x of {}) - (%~) SCE SCR = Disproved (\ x -> case x of {}) - (%~) SCE SCS = Disproved (\ x -> case x of {}) - (%~) SCE SCT = Disproved (\ x -> case x of {}) - (%~) SCE SCU = Disproved (\ x -> case x of {}) - (%~) SCE SCV = Disproved (\ x -> case x of {}) - (%~) SCE SCW = Disproved (\ x -> case x of {}) - (%~) SCE SCX = Disproved (\ x -> case x of {}) - (%~) SCE SCY = Disproved (\ x -> case x of {}) - (%~) SCE SCZ = Disproved (\ x -> case x of {}) - (%~) SCF SCA = Disproved (\ x -> case x of {}) - (%~) SCF SCB = Disproved (\ x -> case x of {}) - (%~) SCF SCC = Disproved (\ x -> case x of {}) - (%~) SCF SCD = Disproved (\ x -> case x of {}) - (%~) SCF SCE = Disproved (\ x -> case x of {}) - (%~) SCF SCF = Proved Refl - (%~) SCF SCG = Disproved (\ x -> case x of {}) - (%~) SCF SCH = Disproved (\ x -> case x of {}) - (%~) SCF SCI = Disproved (\ x -> case x of {}) - (%~) SCF SCJ = Disproved (\ x -> case x of {}) - (%~) SCF SCK = Disproved (\ x -> case x of {}) - (%~) SCF SCL = Disproved (\ x -> case x of {}) - (%~) SCF SCM = Disproved (\ x -> case x of {}) - (%~) SCF SCN = Disproved (\ x -> case x of {}) - (%~) SCF SCO = Disproved (\ x -> case x of {}) - (%~) SCF SCP = Disproved (\ x -> case x of {}) - (%~) SCF SCQ = Disproved (\ x -> case x of {}) - (%~) SCF SCR = Disproved (\ x -> case x of {}) - (%~) SCF SCS = Disproved (\ x -> case x of {}) - (%~) SCF SCT = Disproved (\ x -> case x of {}) - (%~) SCF SCU = Disproved (\ x -> case x of {}) - (%~) SCF SCV = Disproved (\ x -> case x of {}) - (%~) SCF SCW = Disproved (\ x -> case x of {}) - (%~) SCF SCX = Disproved (\ x -> case x of {}) - (%~) SCF SCY = Disproved (\ x -> case x of {}) - (%~) SCF SCZ = Disproved (\ x -> case x of {}) - (%~) SCG SCA = Disproved (\ x -> case x of {}) - (%~) SCG SCB = Disproved (\ x -> case x of {}) - (%~) SCG SCC = Disproved (\ x -> case x of {}) - (%~) SCG SCD = Disproved (\ x -> case x of {}) - (%~) SCG SCE = Disproved (\ x -> case x of {}) - (%~) SCG SCF = Disproved (\ x -> case x of {}) - (%~) SCG SCG = Proved Refl - (%~) SCG SCH = Disproved (\ x -> case x of {}) - (%~) SCG SCI = Disproved (\ x -> case x of {}) - (%~) SCG SCJ = Disproved (\ x -> case x of {}) - (%~) SCG SCK = Disproved (\ x -> case x of {}) - (%~) SCG SCL = Disproved (\ x -> case x of {}) - (%~) SCG SCM = Disproved (\ x -> case x of {}) - (%~) SCG SCN = Disproved (\ x -> case x of {}) - (%~) SCG SCO = Disproved (\ x -> case x of {}) - (%~) SCG SCP = Disproved (\ x -> case x of {}) - (%~) SCG SCQ = Disproved (\ x -> case x of {}) - (%~) SCG SCR = Disproved (\ x -> case x of {}) - (%~) SCG SCS = Disproved (\ x -> case x of {}) - (%~) SCG SCT = Disproved (\ x -> case x of {}) - (%~) SCG SCU = Disproved (\ x -> case x of {}) - (%~) SCG SCV = Disproved (\ x -> case x of {}) - (%~) SCG SCW = Disproved (\ x -> case x of {}) - (%~) SCG SCX = Disproved (\ x -> case x of {}) - (%~) SCG SCY = Disproved (\ x -> case x of {}) - (%~) SCG SCZ = Disproved (\ x -> case x of {}) - (%~) SCH SCA = Disproved (\ x -> case x of {}) - (%~) SCH SCB = Disproved (\ x -> case x of {}) - (%~) SCH SCC = Disproved (\ x -> case x of {}) - (%~) SCH SCD = Disproved (\ x -> case x of {}) - (%~) SCH SCE = Disproved (\ x -> case x of {}) - (%~) SCH SCF = Disproved (\ x -> case x of {}) - (%~) SCH SCG = Disproved (\ x -> case x of {}) - (%~) SCH SCH = Proved Refl - (%~) SCH SCI = Disproved (\ x -> case x of {}) - (%~) SCH SCJ = Disproved (\ x -> case x of {}) - (%~) SCH SCK = Disproved (\ x -> case x of {}) - (%~) SCH SCL = Disproved (\ x -> case x of {}) - (%~) SCH SCM = Disproved (\ x -> case x of {}) - (%~) SCH SCN = Disproved (\ x -> case x of {}) - (%~) SCH SCO = Disproved (\ x -> case x of {}) - (%~) SCH SCP = Disproved (\ x -> case x of {}) - (%~) SCH SCQ = Disproved (\ x -> case x of {}) - (%~) SCH SCR = Disproved (\ x -> case x of {}) - (%~) SCH SCS = Disproved (\ x -> case x of {}) - (%~) SCH SCT = Disproved (\ x -> case x of {}) - (%~) SCH SCU = Disproved (\ x -> case x of {}) - (%~) SCH SCV = Disproved (\ x -> case x of {}) - (%~) SCH SCW = Disproved (\ x -> case x of {}) - (%~) SCH SCX = Disproved (\ x -> case x of {}) - (%~) SCH SCY = Disproved (\ x -> case x of {}) - (%~) SCH SCZ = Disproved (\ x -> case x of {}) - (%~) SCI SCA = Disproved (\ x -> case x of {}) - (%~) SCI SCB = Disproved (\ x -> case x of {}) - (%~) SCI SCC = Disproved (\ x -> case x of {}) - (%~) SCI SCD = Disproved (\ x -> case x of {}) - (%~) SCI SCE = Disproved (\ x -> case x of {}) - (%~) SCI SCF = Disproved (\ x -> case x of {}) - (%~) SCI SCG = Disproved (\ x -> case x of {}) - (%~) SCI SCH = Disproved (\ x -> case x of {}) - (%~) SCI SCI = Proved Refl - (%~) SCI SCJ = Disproved (\ x -> case x of {}) - (%~) SCI SCK = Disproved (\ x -> case x of {}) - (%~) SCI SCL = Disproved (\ x -> case x of {}) - (%~) SCI SCM = Disproved (\ x -> case x of {}) - (%~) SCI SCN = Disproved (\ x -> case x of {}) - (%~) SCI SCO = Disproved (\ x -> case x of {}) - (%~) SCI SCP = Disproved (\ x -> case x of {}) - (%~) SCI SCQ = Disproved (\ x -> case x of {}) - (%~) SCI SCR = Disproved (\ x -> case x of {}) - (%~) SCI SCS = Disproved (\ x -> case x of {}) - (%~) SCI SCT = Disproved (\ x -> case x of {}) - (%~) SCI SCU = Disproved (\ x -> case x of {}) - (%~) SCI SCV = Disproved (\ x -> case x of {}) - (%~) SCI SCW = Disproved (\ x -> case x of {}) - (%~) SCI SCX = Disproved (\ x -> case x of {}) - (%~) SCI SCY = Disproved (\ x -> case x of {}) - (%~) SCI SCZ = Disproved (\ x -> case x of {}) - (%~) SCJ SCA = Disproved (\ x -> case x of {}) - (%~) SCJ SCB = Disproved (\ x -> case x of {}) - (%~) SCJ SCC = Disproved (\ x -> case x of {}) - (%~) SCJ SCD = Disproved (\ x -> case x of {}) - (%~) SCJ SCE = Disproved (\ x -> case x of {}) - (%~) SCJ SCF = Disproved (\ x -> case x of {}) - (%~) SCJ SCG = Disproved (\ x -> case x of {}) - (%~) SCJ SCH = Disproved (\ x -> case x of {}) - (%~) SCJ SCI = Disproved (\ x -> case x of {}) - (%~) SCJ SCJ = Proved Refl - (%~) SCJ SCK = Disproved (\ x -> case x of {}) - (%~) SCJ SCL = Disproved (\ x -> case x of {}) - (%~) SCJ SCM = Disproved (\ x -> case x of {}) - (%~) SCJ SCN = Disproved (\ x -> case x of {}) - (%~) SCJ SCO = Disproved (\ x -> case x of {}) - (%~) SCJ SCP = Disproved (\ x -> case x of {}) - (%~) SCJ SCQ = Disproved (\ x -> case x of {}) - (%~) SCJ SCR = Disproved (\ x -> case x of {}) - (%~) SCJ SCS = Disproved (\ x -> case x of {}) - (%~) SCJ SCT = Disproved (\ x -> case x of {}) - (%~) SCJ SCU = Disproved (\ x -> case x of {}) - (%~) SCJ SCV = Disproved (\ x -> case x of {}) - (%~) SCJ SCW = Disproved (\ x -> case x of {}) - (%~) SCJ SCX = Disproved (\ x -> case x of {}) - (%~) SCJ SCY = Disproved (\ x -> case x of {}) - (%~) SCJ SCZ = Disproved (\ x -> case x of {}) - (%~) SCK SCA = Disproved (\ x -> case x of {}) - (%~) SCK SCB = Disproved (\ x -> case x of {}) - (%~) SCK SCC = Disproved (\ x -> case x of {}) - (%~) SCK SCD = Disproved (\ x -> case x of {}) - (%~) SCK SCE = Disproved (\ x -> case x of {}) - (%~) SCK SCF = Disproved (\ x -> case x of {}) - (%~) SCK SCG = Disproved (\ x -> case x of {}) - (%~) SCK SCH = Disproved (\ x -> case x of {}) - (%~) SCK SCI = Disproved (\ x -> case x of {}) - (%~) SCK SCJ = Disproved (\ x -> case x of {}) - (%~) SCK SCK = Proved Refl - (%~) SCK SCL = Disproved (\ x -> case x of {}) - (%~) SCK SCM = Disproved (\ x -> case x of {}) - (%~) SCK SCN = Disproved (\ x -> case x of {}) - (%~) SCK SCO = Disproved (\ x -> case x of {}) - (%~) SCK SCP = Disproved (\ x -> case x of {}) - (%~) SCK SCQ = Disproved (\ x -> case x of {}) - (%~) SCK SCR = Disproved (\ x -> case x of {}) - (%~) SCK SCS = Disproved (\ x -> case x of {}) - (%~) SCK SCT = Disproved (\ x -> case x of {}) - (%~) SCK SCU = Disproved (\ x -> case x of {}) - (%~) SCK SCV = Disproved (\ x -> case x of {}) - (%~) SCK SCW = Disproved (\ x -> case x of {}) - (%~) SCK SCX = Disproved (\ x -> case x of {}) - (%~) SCK SCY = Disproved (\ x -> case x of {}) - (%~) SCK SCZ = Disproved (\ x -> case x of {}) - (%~) SCL SCA = Disproved (\ x -> case x of {}) - (%~) SCL SCB = Disproved (\ x -> case x of {}) - (%~) SCL SCC = Disproved (\ x -> case x of {}) - (%~) SCL SCD = Disproved (\ x -> case x of {}) - (%~) SCL SCE = Disproved (\ x -> case x of {}) - (%~) SCL SCF = Disproved (\ x -> case x of {}) - (%~) SCL SCG = Disproved (\ x -> case x of {}) - (%~) SCL SCH = Disproved (\ x -> case x of {}) - (%~) SCL SCI = Disproved (\ x -> case x of {}) - (%~) SCL SCJ = Disproved (\ x -> case x of {}) - (%~) SCL SCK = Disproved (\ x -> case x of {}) - (%~) SCL SCL = Proved Refl - (%~) SCL SCM = Disproved (\ x -> case x of {}) - (%~) SCL SCN = Disproved (\ x -> case x of {}) - (%~) SCL SCO = Disproved (\ x -> case x of {}) - (%~) SCL SCP = Disproved (\ x -> case x of {}) - (%~) SCL SCQ = Disproved (\ x -> case x of {}) - (%~) SCL SCR = Disproved (\ x -> case x of {}) - (%~) SCL SCS = Disproved (\ x -> case x of {}) - (%~) SCL SCT = Disproved (\ x -> case x of {}) - (%~) SCL SCU = Disproved (\ x -> case x of {}) - (%~) SCL SCV = Disproved (\ x -> case x of {}) - (%~) SCL SCW = Disproved (\ x -> case x of {}) - (%~) SCL SCX = Disproved (\ x -> case x of {}) - (%~) SCL SCY = Disproved (\ x -> case x of {}) - (%~) SCL SCZ = Disproved (\ x -> case x of {}) - (%~) SCM SCA = Disproved (\ x -> case x of {}) - (%~) SCM SCB = Disproved (\ x -> case x of {}) - (%~) SCM SCC = Disproved (\ x -> case x of {}) - (%~) SCM SCD = Disproved (\ x -> case x of {}) - (%~) SCM SCE = Disproved (\ x -> case x of {}) - (%~) SCM SCF = Disproved (\ x -> case x of {}) - (%~) SCM SCG = Disproved (\ x -> case x of {}) - (%~) SCM SCH = Disproved (\ x -> case x of {}) - (%~) SCM SCI = Disproved (\ x -> case x of {}) - (%~) SCM SCJ = Disproved (\ x -> case x of {}) - (%~) SCM SCK = Disproved (\ x -> case x of {}) - (%~) SCM SCL = Disproved (\ x -> case x of {}) - (%~) SCM SCM = Proved Refl - (%~) SCM SCN = Disproved (\ x -> case x of {}) - (%~) SCM SCO = Disproved (\ x -> case x of {}) - (%~) SCM SCP = Disproved (\ x -> case x of {}) - (%~) SCM SCQ = Disproved (\ x -> case x of {}) - (%~) SCM SCR = Disproved (\ x -> case x of {}) - (%~) SCM SCS = Disproved (\ x -> case x of {}) - (%~) SCM SCT = Disproved (\ x -> case x of {}) - (%~) SCM SCU = Disproved (\ x -> case x of {}) - (%~) SCM SCV = Disproved (\ x -> case x of {}) - (%~) SCM SCW = Disproved (\ x -> case x of {}) - (%~) SCM SCX = Disproved (\ x -> case x of {}) - (%~) SCM SCY = Disproved (\ x -> case x of {}) - (%~) SCM SCZ = Disproved (\ x -> case x of {}) - (%~) SCN SCA = Disproved (\ x -> case x of {}) - (%~) SCN SCB = Disproved (\ x -> case x of {}) - (%~) SCN SCC = Disproved (\ x -> case x of {}) - (%~) SCN SCD = Disproved (\ x -> case x of {}) - (%~) SCN SCE = Disproved (\ x -> case x of {}) - (%~) SCN SCF = Disproved (\ x -> case x of {}) - (%~) SCN SCG = Disproved (\ x -> case x of {}) - (%~) SCN SCH = Disproved (\ x -> case x of {}) - (%~) SCN SCI = Disproved (\ x -> case x of {}) - (%~) SCN SCJ = Disproved (\ x -> case x of {}) - (%~) SCN SCK = Disproved (\ x -> case x of {}) - (%~) SCN SCL = Disproved (\ x -> case x of {}) - (%~) SCN SCM = Disproved (\ x -> case x of {}) - (%~) SCN SCN = Proved Refl - (%~) SCN SCO = Disproved (\ x -> case x of {}) - (%~) SCN SCP = Disproved (\ x -> case x of {}) - (%~) SCN SCQ = Disproved (\ x -> case x of {}) - (%~) SCN SCR = Disproved (\ x -> case x of {}) - (%~) SCN SCS = Disproved (\ x -> case x of {}) - (%~) SCN SCT = Disproved (\ x -> case x of {}) - (%~) SCN SCU = Disproved (\ x -> case x of {}) - (%~) SCN SCV = Disproved (\ x -> case x of {}) - (%~) SCN SCW = Disproved (\ x -> case x of {}) - (%~) SCN SCX = Disproved (\ x -> case x of {}) - (%~) SCN SCY = Disproved (\ x -> case x of {}) - (%~) SCN SCZ = Disproved (\ x -> case x of {}) - (%~) SCO SCA = Disproved (\ x -> case x of {}) - (%~) SCO SCB = Disproved (\ x -> case x of {}) - (%~) SCO SCC = Disproved (\ x -> case x of {}) - (%~) SCO SCD = Disproved (\ x -> case x of {}) - (%~) SCO SCE = Disproved (\ x -> case x of {}) - (%~) SCO SCF = Disproved (\ x -> case x of {}) - (%~) SCO SCG = Disproved (\ x -> case x of {}) - (%~) SCO SCH = Disproved (\ x -> case x of {}) - (%~) SCO SCI = Disproved (\ x -> case x of {}) - (%~) SCO SCJ = Disproved (\ x -> case x of {}) - (%~) SCO SCK = Disproved (\ x -> case x of {}) - (%~) SCO SCL = Disproved (\ x -> case x of {}) - (%~) SCO SCM = Disproved (\ x -> case x of {}) - (%~) SCO SCN = Disproved (\ x -> case x of {}) - (%~) SCO SCO = Proved Refl - (%~) SCO SCP = Disproved (\ x -> case x of {}) - (%~) SCO SCQ = Disproved (\ x -> case x of {}) - (%~) SCO SCR = Disproved (\ x -> case x of {}) - (%~) SCO SCS = Disproved (\ x -> case x of {}) - (%~) SCO SCT = Disproved (\ x -> case x of {}) - (%~) SCO SCU = Disproved (\ x -> case x of {}) - (%~) SCO SCV = Disproved (\ x -> case x of {}) - (%~) SCO SCW = Disproved (\ x -> case x of {}) - (%~) SCO SCX = Disproved (\ x -> case x of {}) - (%~) SCO SCY = Disproved (\ x -> case x of {}) - (%~) SCO SCZ = Disproved (\ x -> case x of {}) - (%~) SCP SCA = Disproved (\ x -> case x of {}) - (%~) SCP SCB = Disproved (\ x -> case x of {}) - (%~) SCP SCC = Disproved (\ x -> case x of {}) - (%~) SCP SCD = Disproved (\ x -> case x of {}) - (%~) SCP SCE = Disproved (\ x -> case x of {}) - (%~) SCP SCF = Disproved (\ x -> case x of {}) - (%~) SCP SCG = Disproved (\ x -> case x of {}) - (%~) SCP SCH = Disproved (\ x -> case x of {}) - (%~) SCP SCI = Disproved (\ x -> case x of {}) - (%~) SCP SCJ = Disproved (\ x -> case x of {}) - (%~) SCP SCK = Disproved (\ x -> case x of {}) - (%~) SCP SCL = Disproved (\ x -> case x of {}) - (%~) SCP SCM = Disproved (\ x -> case x of {}) - (%~) SCP SCN = Disproved (\ x -> case x of {}) - (%~) SCP SCO = Disproved (\ x -> case x of {}) - (%~) SCP SCP = Proved Refl - (%~) SCP SCQ = Disproved (\ x -> case x of {}) - (%~) SCP SCR = Disproved (\ x -> case x of {}) - (%~) SCP SCS = Disproved (\ x -> case x of {}) - (%~) SCP SCT = Disproved (\ x -> case x of {}) - (%~) SCP SCU = Disproved (\ x -> case x of {}) - (%~) SCP SCV = Disproved (\ x -> case x of {}) - (%~) SCP SCW = Disproved (\ x -> case x of {}) - (%~) SCP SCX = Disproved (\ x -> case x of {}) - (%~) SCP SCY = Disproved (\ x -> case x of {}) - (%~) SCP SCZ = Disproved (\ x -> case x of {}) - (%~) SCQ SCA = Disproved (\ x -> case x of {}) - (%~) SCQ SCB = Disproved (\ x -> case x of {}) - (%~) SCQ SCC = Disproved (\ x -> case x of {}) - (%~) SCQ SCD = Disproved (\ x -> case x of {}) - (%~) SCQ SCE = Disproved (\ x -> case x of {}) - (%~) SCQ SCF = Disproved (\ x -> case x of {}) - (%~) SCQ SCG = Disproved (\ x -> case x of {}) - (%~) SCQ SCH = Disproved (\ x -> case x of {}) - (%~) SCQ SCI = Disproved (\ x -> case x of {}) - (%~) SCQ SCJ = Disproved (\ x -> case x of {}) - (%~) SCQ SCK = Disproved (\ x -> case x of {}) - (%~) SCQ SCL = Disproved (\ x -> case x of {}) - (%~) SCQ SCM = Disproved (\ x -> case x of {}) - (%~) SCQ SCN = Disproved (\ x -> case x of {}) - (%~) SCQ SCO = Disproved (\ x -> case x of {}) - (%~) SCQ SCP = Disproved (\ x -> case x of {}) - (%~) SCQ SCQ = Proved Refl - (%~) SCQ SCR = Disproved (\ x -> case x of {}) - (%~) SCQ SCS = Disproved (\ x -> case x of {}) - (%~) SCQ SCT = Disproved (\ x -> case x of {}) - (%~) SCQ SCU = Disproved (\ x -> case x of {}) - (%~) SCQ SCV = Disproved (\ x -> case x of {}) - (%~) SCQ SCW = Disproved (\ x -> case x of {}) - (%~) SCQ SCX = Disproved (\ x -> case x of {}) - (%~) SCQ SCY = Disproved (\ x -> case x of {}) - (%~) SCQ SCZ = Disproved (\ x -> case x of {}) - (%~) SCR SCA = Disproved (\ x -> case x of {}) - (%~) SCR SCB = Disproved (\ x -> case x of {}) - (%~) SCR SCC = Disproved (\ x -> case x of {}) - (%~) SCR SCD = Disproved (\ x -> case x of {}) - (%~) SCR SCE = Disproved (\ x -> case x of {}) - (%~) SCR SCF = Disproved (\ x -> case x of {}) - (%~) SCR SCG = Disproved (\ x -> case x of {}) - (%~) SCR SCH = Disproved (\ x -> case x of {}) - (%~) SCR SCI = Disproved (\ x -> case x of {}) - (%~) SCR SCJ = Disproved (\ x -> case x of {}) - (%~) SCR SCK = Disproved (\ x -> case x of {}) - (%~) SCR SCL = Disproved (\ x -> case x of {}) - (%~) SCR SCM = Disproved (\ x -> case x of {}) - (%~) SCR SCN = Disproved (\ x -> case x of {}) - (%~) SCR SCO = Disproved (\ x -> case x of {}) - (%~) SCR SCP = Disproved (\ x -> case x of {}) - (%~) SCR SCQ = Disproved (\ x -> case x of {}) - (%~) SCR SCR = Proved Refl - (%~) SCR SCS = Disproved (\ x -> case x of {}) - (%~) SCR SCT = Disproved (\ x -> case x of {}) - (%~) SCR SCU = Disproved (\ x -> case x of {}) - (%~) SCR SCV = Disproved (\ x -> case x of {}) - (%~) SCR SCW = Disproved (\ x -> case x of {}) - (%~) SCR SCX = Disproved (\ x -> case x of {}) - (%~) SCR SCY = Disproved (\ x -> case x of {}) - (%~) SCR SCZ = Disproved (\ x -> case x of {}) - (%~) SCS SCA = Disproved (\ x -> case x of {}) - (%~) SCS SCB = Disproved (\ x -> case x of {}) - (%~) SCS SCC = Disproved (\ x -> case x of {}) - (%~) SCS SCD = Disproved (\ x -> case x of {}) - (%~) SCS SCE = Disproved (\ x -> case x of {}) - (%~) SCS SCF = Disproved (\ x -> case x of {}) - (%~) SCS SCG = Disproved (\ x -> case x of {}) - (%~) SCS SCH = Disproved (\ x -> case x of {}) - (%~) SCS SCI = Disproved (\ x -> case x of {}) - (%~) SCS SCJ = Disproved (\ x -> case x of {}) - (%~) SCS SCK = Disproved (\ x -> case x of {}) - (%~) SCS SCL = Disproved (\ x -> case x of {}) - (%~) SCS SCM = Disproved (\ x -> case x of {}) - (%~) SCS SCN = Disproved (\ x -> case x of {}) - (%~) SCS SCO = Disproved (\ x -> case x of {}) - (%~) SCS SCP = Disproved (\ x -> case x of {}) - (%~) SCS SCQ = Disproved (\ x -> case x of {}) - (%~) SCS SCR = Disproved (\ x -> case x of {}) - (%~) SCS SCS = Proved Refl - (%~) SCS SCT = Disproved (\ x -> case x of {}) - (%~) SCS SCU = Disproved (\ x -> case x of {}) - (%~) SCS SCV = Disproved (\ x -> case x of {}) - (%~) SCS SCW = Disproved (\ x -> case x of {}) - (%~) SCS SCX = Disproved (\ x -> case x of {}) - (%~) SCS SCY = Disproved (\ x -> case x of {}) - (%~) SCS SCZ = Disproved (\ x -> case x of {}) - (%~) SCT SCA = Disproved (\ x -> case x of {}) - (%~) SCT SCB = Disproved (\ x -> case x of {}) - (%~) SCT SCC = Disproved (\ x -> case x of {}) - (%~) SCT SCD = Disproved (\ x -> case x of {}) - (%~) SCT SCE = Disproved (\ x -> case x of {}) - (%~) SCT SCF = Disproved (\ x -> case x of {}) - (%~) SCT SCG = Disproved (\ x -> case x of {}) - (%~) SCT SCH = Disproved (\ x -> case x of {}) - (%~) SCT SCI = Disproved (\ x -> case x of {}) - (%~) SCT SCJ = Disproved (\ x -> case x of {}) - (%~) SCT SCK = Disproved (\ x -> case x of {}) - (%~) SCT SCL = Disproved (\ x -> case x of {}) - (%~) SCT SCM = Disproved (\ x -> case x of {}) - (%~) SCT SCN = Disproved (\ x -> case x of {}) - (%~) SCT SCO = Disproved (\ x -> case x of {}) - (%~) SCT SCP = Disproved (\ x -> case x of {}) - (%~) SCT SCQ = Disproved (\ x -> case x of {}) - (%~) SCT SCR = Disproved (\ x -> case x of {}) - (%~) SCT SCS = Disproved (\ x -> case x of {}) - (%~) SCT SCT = Proved Refl - (%~) SCT SCU = Disproved (\ x -> case x of {}) - (%~) SCT SCV = Disproved (\ x -> case x of {}) - (%~) SCT SCW = Disproved (\ x -> case x of {}) - (%~) SCT SCX = Disproved (\ x -> case x of {}) - (%~) SCT SCY = Disproved (\ x -> case x of {}) - (%~) SCT SCZ = Disproved (\ x -> case x of {}) - (%~) SCU SCA = Disproved (\ x -> case x of {}) - (%~) SCU SCB = Disproved (\ x -> case x of {}) - (%~) SCU SCC = Disproved (\ x -> case x of {}) - (%~) SCU SCD = Disproved (\ x -> case x of {}) - (%~) SCU SCE = Disproved (\ x -> case x of {}) - (%~) SCU SCF = Disproved (\ x -> case x of {}) - (%~) SCU SCG = Disproved (\ x -> case x of {}) - (%~) SCU SCH = Disproved (\ x -> case x of {}) - (%~) SCU SCI = Disproved (\ x -> case x of {}) - (%~) SCU SCJ = Disproved (\ x -> case x of {}) - (%~) SCU SCK = Disproved (\ x -> case x of {}) - (%~) SCU SCL = Disproved (\ x -> case x of {}) - (%~) SCU SCM = Disproved (\ x -> case x of {}) - (%~) SCU SCN = Disproved (\ x -> case x of {}) - (%~) SCU SCO = Disproved (\ x -> case x of {}) - (%~) SCU SCP = Disproved (\ x -> case x of {}) - (%~) SCU SCQ = Disproved (\ x -> case x of {}) - (%~) SCU SCR = Disproved (\ x -> case x of {}) - (%~) SCU SCS = Disproved (\ x -> case x of {}) - (%~) SCU SCT = Disproved (\ x -> case x of {}) - (%~) SCU SCU = Proved Refl - (%~) SCU SCV = Disproved (\ x -> case x of {}) - (%~) SCU SCW = Disproved (\ x -> case x of {}) - (%~) SCU SCX = Disproved (\ x -> case x of {}) - (%~) SCU SCY = Disproved (\ x -> case x of {}) - (%~) SCU SCZ = Disproved (\ x -> case x of {}) - (%~) SCV SCA = Disproved (\ x -> case x of {}) - (%~) SCV SCB = Disproved (\ x -> case x of {}) - (%~) SCV SCC = Disproved (\ x -> case x of {}) - (%~) SCV SCD = Disproved (\ x -> case x of {}) - (%~) SCV SCE = Disproved (\ x -> case x of {}) - (%~) SCV SCF = Disproved (\ x -> case x of {}) - (%~) SCV SCG = Disproved (\ x -> case x of {}) - (%~) SCV SCH = Disproved (\ x -> case x of {}) - (%~) SCV SCI = Disproved (\ x -> case x of {}) - (%~) SCV SCJ = Disproved (\ x -> case x of {}) - (%~) SCV SCK = Disproved (\ x -> case x of {}) - (%~) SCV SCL = Disproved (\ x -> case x of {}) - (%~) SCV SCM = Disproved (\ x -> case x of {}) - (%~) SCV SCN = Disproved (\ x -> case x of {}) - (%~) SCV SCO = Disproved (\ x -> case x of {}) - (%~) SCV SCP = Disproved (\ x -> case x of {}) - (%~) SCV SCQ = Disproved (\ x -> case x of {}) - (%~) SCV SCR = Disproved (\ x -> case x of {}) - (%~) SCV SCS = Disproved (\ x -> case x of {}) - (%~) SCV SCT = Disproved (\ x -> case x of {}) - (%~) SCV SCU = Disproved (\ x -> case x of {}) - (%~) SCV SCV = Proved Refl - (%~) SCV SCW = Disproved (\ x -> case x of {}) - (%~) SCV SCX = Disproved (\ x -> case x of {}) - (%~) SCV SCY = Disproved (\ x -> case x of {}) - (%~) SCV SCZ = Disproved (\ x -> case x of {}) - (%~) SCW SCA = Disproved (\ x -> case x of {}) - (%~) SCW SCB = Disproved (\ x -> case x of {}) - (%~) SCW SCC = Disproved (\ x -> case x of {}) - (%~) SCW SCD = Disproved (\ x -> case x of {}) - (%~) SCW SCE = Disproved (\ x -> case x of {}) - (%~) SCW SCF = Disproved (\ x -> case x of {}) - (%~) SCW SCG = Disproved (\ x -> case x of {}) - (%~) SCW SCH = Disproved (\ x -> case x of {}) - (%~) SCW SCI = Disproved (\ x -> case x of {}) - (%~) SCW SCJ = Disproved (\ x -> case x of {}) - (%~) SCW SCK = Disproved (\ x -> case x of {}) - (%~) SCW SCL = Disproved (\ x -> case x of {}) - (%~) SCW SCM = Disproved (\ x -> case x of {}) - (%~) SCW SCN = Disproved (\ x -> case x of {}) - (%~) SCW SCO = Disproved (\ x -> case x of {}) - (%~) SCW SCP = Disproved (\ x -> case x of {}) - (%~) SCW SCQ = Disproved (\ x -> case x of {}) - (%~) SCW SCR = Disproved (\ x -> case x of {}) - (%~) SCW SCS = Disproved (\ x -> case x of {}) - (%~) SCW SCT = Disproved (\ x -> case x of {}) - (%~) SCW SCU = Disproved (\ x -> case x of {}) - (%~) SCW SCV = Disproved (\ x -> case x of {}) - (%~) SCW SCW = Proved Refl - (%~) SCW SCX = Disproved (\ x -> case x of {}) - (%~) SCW SCY = Disproved (\ x -> case x of {}) - (%~) SCW SCZ = Disproved (\ x -> case x of {}) - (%~) SCX SCA = Disproved (\ x -> case x of {}) - (%~) SCX SCB = Disproved (\ x -> case x of {}) - (%~) SCX SCC = Disproved (\ x -> case x of {}) - (%~) SCX SCD = Disproved (\ x -> case x of {}) - (%~) SCX SCE = Disproved (\ x -> case x of {}) - (%~) SCX SCF = Disproved (\ x -> case x of {}) - (%~) SCX SCG = Disproved (\ x -> case x of {}) - (%~) SCX SCH = Disproved (\ x -> case x of {}) - (%~) SCX SCI = Disproved (\ x -> case x of {}) - (%~) SCX SCJ = Disproved (\ x -> case x of {}) - (%~) SCX SCK = Disproved (\ x -> case x of {}) - (%~) SCX SCL = Disproved (\ x -> case x of {}) - (%~) SCX SCM = Disproved (\ x -> case x of {}) - (%~) SCX SCN = Disproved (\ x -> case x of {}) - (%~) SCX SCO = Disproved (\ x -> case x of {}) - (%~) SCX SCP = Disproved (\ x -> case x of {}) - (%~) SCX SCQ = Disproved (\ x -> case x of {}) - (%~) SCX SCR = Disproved (\ x -> case x of {}) - (%~) SCX SCS = Disproved (\ x -> case x of {}) - (%~) SCX SCT = Disproved (\ x -> case x of {}) - (%~) SCX SCU = Disproved (\ x -> case x of {}) - (%~) SCX SCV = Disproved (\ x -> case x of {}) - (%~) SCX SCW = Disproved (\ x -> case x of {}) - (%~) SCX SCX = Proved Refl - (%~) SCX SCY = Disproved (\ x -> case x of {}) - (%~) SCX SCZ = Disproved (\ x -> case x of {}) - (%~) SCY SCA = Disproved (\ x -> case x of {}) - (%~) SCY SCB = Disproved (\ x -> case x of {}) - (%~) SCY SCC = Disproved (\ x -> case x of {}) - (%~) SCY SCD = Disproved (\ x -> case x of {}) - (%~) SCY SCE = Disproved (\ x -> case x of {}) - (%~) SCY SCF = Disproved (\ x -> case x of {}) - (%~) SCY SCG = Disproved (\ x -> case x of {}) - (%~) SCY SCH = Disproved (\ x -> case x of {}) - (%~) SCY SCI = Disproved (\ x -> case x of {}) - (%~) SCY SCJ = Disproved (\ x -> case x of {}) - (%~) SCY SCK = Disproved (\ x -> case x of {}) - (%~) SCY SCL = Disproved (\ x -> case x of {}) - (%~) SCY SCM = Disproved (\ x -> case x of {}) - (%~) SCY SCN = Disproved (\ x -> case x of {}) - (%~) SCY SCO = Disproved (\ x -> case x of {}) - (%~) SCY SCP = Disproved (\ x -> case x of {}) - (%~) SCY SCQ = Disproved (\ x -> case x of {}) - (%~) SCY SCR = Disproved (\ x -> case x of {}) - (%~) SCY SCS = Disproved (\ x -> case x of {}) - (%~) SCY SCT = Disproved (\ x -> case x of {}) - (%~) SCY SCU = Disproved (\ x -> case x of {}) - (%~) SCY SCV = Disproved (\ x -> case x of {}) - (%~) SCY SCW = Disproved (\ x -> case x of {}) - (%~) SCY SCX = Disproved (\ x -> case x of {}) - (%~) SCY SCY = Proved Refl - (%~) SCY SCZ = Disproved (\ x -> case x of {}) - (%~) SCZ SCA = Disproved (\ x -> case x of {}) - (%~) SCZ SCB = Disproved (\ x -> case x of {}) - (%~) SCZ SCC = Disproved (\ x -> case x of {}) - (%~) SCZ SCD = Disproved (\ x -> case x of {}) - (%~) SCZ SCE = Disproved (\ x -> case x of {}) - (%~) SCZ SCF = Disproved (\ x -> case x of {}) - (%~) SCZ SCG = Disproved (\ x -> case x of {}) - (%~) SCZ SCH = Disproved (\ x -> case x of {}) - (%~) SCZ SCI = Disproved (\ x -> case x of {}) - (%~) SCZ SCJ = Disproved (\ x -> case x of {}) - (%~) SCZ SCK = Disproved (\ x -> case x of {}) - (%~) SCZ SCL = Disproved (\ x -> case x of {}) - (%~) SCZ SCM = Disproved (\ x -> case x of {}) - (%~) SCZ SCN = Disproved (\ x -> case x of {}) - (%~) SCZ SCO = Disproved (\ x -> case x of {}) - (%~) SCZ SCP = Disproved (\ x -> case x of {}) - (%~) SCZ SCQ = Disproved (\ x -> case x of {}) - (%~) SCZ SCR = Disproved (\ x -> case x of {}) - (%~) SCZ SCS = Disproved (\ x -> case x of {}) - (%~) SCZ SCT = Disproved (\ x -> case x of {}) - (%~) SCZ SCU = Disproved (\ x -> case x of {}) - (%~) SCZ SCV = Disproved (\ x -> case x of {}) - (%~) SCZ SCW = Disproved (\ x -> case x of {}) - (%~) SCZ SCX = Disproved (\ x -> case x of {}) - (%~) SCZ SCY = Disproved (\ x -> case x of {}) - (%~) SCZ SCZ = Proved Refl - instance Data.Type.Equality.TestEquality (SAChar :: AChar - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (SAChar :: AChar - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance (Data.Singletons.ShowSing.ShowSing U, - Data.Singletons.ShowSing.ShowSing Nat) => - Show (SU (z :: U)) - deriving instance Show (SAChar (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 n => SingI1 (VEC (n :: U)) where - liftSing = SVEC sing - instance SingI2 VEC where - liftSing2 = SVEC - instance SingI (VECSym0 :: (~>) U ((~>) Nat U)) where - sing = singFun2 @VECSym0 SVEC - instance SingI d => SingI (VECSym1 (d :: U) :: (~>) Nat U) where - sing = singFun1 @(VECSym1 (d :: U)) (SVEC (sing @d)) - instance SingI1 (VECSym1 :: U -> (~>) Nat U) where - liftSing (s :: Sing (d :: U)) - = singFun1 @(VECSym1 (d :: U)) (SVEC s) - instance SingI CA where - sing = SCA - instance SingI CB where - sing = SCB - instance SingI CC where - sing = SCC - instance SingI CD where - sing = SCD - instance SingI CE where - sing = SCE - instance SingI CF where - sing = SCF - instance SingI CG where - sing = SCG - instance SingI CH where - sing = SCH - instance SingI CI where - sing = SCI - instance SingI CJ where - sing = SCJ - instance SingI CK where - sing = SCK - instance SingI CL where - sing = SCL - instance SingI CM where - sing = SCM - instance SingI CN where - sing = SCN - instance SingI CO where - sing = SCO - instance SingI CP where - sing = SCP - instance SingI CQ where - sing = SCQ - instance SingI CR where - sing = SCR - instance SingI CS where - sing = SCS - instance SingI CT where - sing = SCT - instance SingI CU where - sing = SCU - instance SingI CV where - sing = SCV - instance SingI CW where - sing = SCW - instance SingI CX where - sing = SCX - instance SingI CY where - sing = SCY - instance SingI CZ where - sing = SCZ - instance (SingI n, SingI n) => - SingI (Attr (n :: [AChar]) (n :: U)) where - sing = SAttr sing sing - instance SingI n => SingI1 (Attr (n :: [AChar])) where - liftSing = SAttr sing - instance SingI2 Attr where - liftSing2 = SAttr - instance SingI (AttrSym0 :: (~>) [AChar] ((~>) U Attribute)) where - sing = singFun2 @AttrSym0 SAttr - instance SingI d => - SingI (AttrSym1 (d :: [AChar]) :: (~>) U Attribute) where - sing = singFun1 @(AttrSym1 (d :: [AChar])) (SAttr (sing @d)) - instance SingI1 (AttrSym1 :: [AChar] -> (~>) U Attribute) where - liftSing (s :: Sing (d :: [AChar])) - = singFun1 @(AttrSym1 (d :: [AChar])) (SAttr s) - instance SingI n => SingI (Sch (n :: [Attribute])) where - sing = SSch sing - instance SingI1 Sch where - liftSing = SSch - instance SingI (SchSym0 :: (~>) [Attribute] Schema) where - sing = singFun1 @SchSym0 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 +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 :: Nat+ type family ZeroSym0 :: Nat where+ ZeroSym0 = Zero+ type SuccSym0 :: (~>) Nat Nat+ data SuccSym0 :: (~>) Nat Nat+ where+ SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>+ SuccSym0 a0123456789876543210+ type instance Apply @Nat @Nat SuccSym0 a0123456789876543210 = Succ a0123456789876543210+ instance SuppressUnusedWarnings SuccSym0 where+ suppressUnusedWarnings = snd ((,) SuccSym0KindInference ())+ type SuccSym1 :: Nat -> Nat+ type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where+ SuccSym1 a0123456789876543210 = Succ a0123456789876543210+ type TFHelper_0123456789876543210 :: Nat -> Nat -> Bool+ type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where+ TFHelper_0123456789876543210 Zero Zero = TrueSym0+ TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0+ TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0+ TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq Nat where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: Nat -> Nat -> Ordering+ type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where+ Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ Compare_0123456789876543210 Zero (Succ _) = LTSym0+ Compare_0123456789876543210 (Succ _) Zero = GTSym0+ instance POrd Nat where+ type Compare a a = Compare_0123456789876543210 a a+ data SNat :: Nat -> Type+ where+ SZero :: SNat (Zero :: Nat)+ SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat)+ type instance Sing @Nat = SNat+ 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))+ = (\cases (SomeSing c) -> SomeSing (SSucc c))+ (toSing b :: SomeSing Nat)+ instance SEq Nat => SEq Nat where+ (%==) SZero SZero = STrue+ (%==) SZero (SSucc _) = SFalse+ (%==) (SSucc _) SZero = SFalse+ (%==)+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SOrd Nat => SOrd Nat where+ sCompare SZero SZero+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ (applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing+ (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210)+ sB_0123456789876543210))+ SNil)+ sCompare SZero (SSucc _) = SLT+ sCompare (SSucc _) SZero = SGT+ instance SDecide Nat => SDecide Nat where+ (%~) SZero SZero = Proved Refl+ (%~) SZero (SSucc _) = Disproved (\case)+ (%~) (SSucc _) SZero = Disproved (\case)+ (%~) (SSucc a) (SSucc b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SNat (z :: Nat)) where+ (==) _ _ = True+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Equality.TestEquality (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SNat (z :: Nat)) where+ compare _ _ = EQ+ instance SingI Zero where+ sing = SZero+ instance SingI n => SingI (Succ (n :: Nat)) where+ sing = SSucc sing+ instance SingI1 Succ where+ liftSing = SSucc+ instance SingI (SuccSym0 :: (~>) Nat Nat) where+ sing = singFun1 @SuccSym0 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 :: U+ type family BOOLSym0 :: U where+ BOOLSym0 = BOOL+ type STRINGSym0 :: U+ type family STRINGSym0 :: U where+ STRINGSym0 = STRING+ type NATSym0 :: U+ type family NATSym0 :: U where+ NATSym0 = NAT+ type VECSym0 :: (~>) U ((~>) Nat U)+ data VECSym0 :: (~>) U ((~>) Nat U)+ where+ VECSym0KindInference :: SameKind (Apply VECSym0 arg) (VECSym1 arg) =>+ VECSym0 a0123456789876543210+ type instance Apply @U @((~>) Nat U) VECSym0 a0123456789876543210 = VECSym1 a0123456789876543210+ instance SuppressUnusedWarnings VECSym0 where+ suppressUnusedWarnings = snd ((,) VECSym0KindInference ())+ type VECSym1 :: U -> (~>) Nat U+ data VECSym1 (a0123456789876543210 :: U) :: (~>) Nat U+ where+ VECSym1KindInference :: SameKind (Apply (VECSym1 a0123456789876543210) arg) (VECSym2 a0123456789876543210 arg) =>+ VECSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @U (VECSym1 a0123456789876543210) a0123456789876543210 = VEC a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (VECSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) VECSym1KindInference ())+ type VECSym2 :: U -> Nat -> U+ type family VECSym2 (a0123456789876543210 :: U) (a0123456789876543210 :: Nat) :: U where+ VECSym2 a0123456789876543210 a0123456789876543210 = VEC a0123456789876543210 a0123456789876543210+ type CASym0 :: AChar+ type family CASym0 :: AChar where+ CASym0 = CA+ type CBSym0 :: AChar+ type family CBSym0 :: AChar where+ CBSym0 = CB+ type CCSym0 :: AChar+ type family CCSym0 :: AChar where+ CCSym0 = CC+ type CDSym0 :: AChar+ type family CDSym0 :: AChar where+ CDSym0 = CD+ type CESym0 :: AChar+ type family CESym0 :: AChar where+ CESym0 = CE+ type CFSym0 :: AChar+ type family CFSym0 :: AChar where+ CFSym0 = CF+ type CGSym0 :: AChar+ type family CGSym0 :: AChar where+ CGSym0 = CG+ type CHSym0 :: AChar+ type family CHSym0 :: AChar where+ CHSym0 = CH+ type CISym0 :: AChar+ type family CISym0 :: AChar where+ CISym0 = CI+ type CJSym0 :: AChar+ type family CJSym0 :: AChar where+ CJSym0 = CJ+ type CKSym0 :: AChar+ type family CKSym0 :: AChar where+ CKSym0 = CK+ type CLSym0 :: AChar+ type family CLSym0 :: AChar where+ CLSym0 = CL+ type CMSym0 :: AChar+ type family CMSym0 :: AChar where+ CMSym0 = CM+ type CNSym0 :: AChar+ type family CNSym0 :: AChar where+ CNSym0 = CN+ type COSym0 :: AChar+ type family COSym0 :: AChar where+ COSym0 = CO+ type CPSym0 :: AChar+ type family CPSym0 :: AChar where+ CPSym0 = CP+ type CQSym0 :: AChar+ type family CQSym0 :: AChar where+ CQSym0 = CQ+ type CRSym0 :: AChar+ type family CRSym0 :: AChar where+ CRSym0 = CR+ type CSSym0 :: AChar+ type family CSSym0 :: AChar where+ CSSym0 = CS+ type CTSym0 :: AChar+ type family CTSym0 :: AChar where+ CTSym0 = CT+ type CUSym0 :: AChar+ type family CUSym0 :: AChar where+ CUSym0 = CU+ type CVSym0 :: AChar+ type family CVSym0 :: AChar where+ CVSym0 = CV+ type CWSym0 :: AChar+ type family CWSym0 :: AChar where+ CWSym0 = CW+ type CXSym0 :: AChar+ type family CXSym0 :: AChar where+ CXSym0 = CX+ type CYSym0 :: AChar+ type family CYSym0 :: AChar where+ CYSym0 = CY+ type CZSym0 :: AChar+ type family CZSym0 :: AChar where+ CZSym0 = CZ+ type AttrSym0 :: (~>) [AChar] ((~>) U Attribute)+ data AttrSym0 :: (~>) [AChar] ((~>) U Attribute)+ where+ AttrSym0KindInference :: SameKind (Apply AttrSym0 arg) (AttrSym1 arg) =>+ AttrSym0 a0123456789876543210+ type instance Apply @[AChar] @((~>) U Attribute) AttrSym0 a0123456789876543210 = AttrSym1 a0123456789876543210+ instance SuppressUnusedWarnings AttrSym0 where+ suppressUnusedWarnings = snd ((,) AttrSym0KindInference ())+ type AttrSym1 :: [AChar] -> (~>) U Attribute+ data AttrSym1 (a0123456789876543210 :: [AChar]) :: (~>) U Attribute+ where+ AttrSym1KindInference :: SameKind (Apply (AttrSym1 a0123456789876543210) arg) (AttrSym2 a0123456789876543210 arg) =>+ AttrSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @U @Attribute (AttrSym1 a0123456789876543210) a0123456789876543210 = Attr a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (AttrSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) AttrSym1KindInference ())+ type AttrSym2 :: [AChar] -> U -> Attribute+ type family AttrSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: U) :: Attribute where+ AttrSym2 a0123456789876543210 a0123456789876543210 = Attr a0123456789876543210 a0123456789876543210+ type SchSym0 :: (~>) [Attribute] Schema+ data SchSym0 :: (~>) [Attribute] Schema+ where+ SchSym0KindInference :: SameKind (Apply SchSym0 arg) (SchSym1 arg) =>+ SchSym0 a0123456789876543210+ type instance Apply @[Attribute] @Schema SchSym0 a0123456789876543210 = Sch a0123456789876543210+ instance SuppressUnusedWarnings SchSym0 where+ suppressUnusedWarnings = snd ((,) SchSym0KindInference ())+ type SchSym1 :: [Attribute] -> Schema+ type family SchSym1 (a0123456789876543210 :: [Attribute]) :: Schema where+ SchSym1 a0123456789876543210 = Sch a0123456789876543210+ type family LamCases_0123456789876543210 (name0123456789876543210 :: [AChar]) name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 name name' u attrs 'True = u+ LamCases_0123456789876543210 name name' u attrs 'False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs)+ data LamCases_0123456789876543210Sym0 (name0123456789876543210 :: [AChar]) name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210) arg) (LamCases_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (name0123456789876543210 :: [AChar]) name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 a_01234567898765432100123456789876543210+ type LookupSym0 :: (~>) [AChar] ((~>) Schema U)+ data LookupSym0 :: (~>) [AChar] ((~>) Schema U)+ where+ LookupSym0KindInference :: SameKind (Apply LookupSym0 arg) (LookupSym1 arg) =>+ LookupSym0 a0123456789876543210+ type instance Apply @[AChar] @((~>) Schema U) LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210+ instance SuppressUnusedWarnings LookupSym0 where+ suppressUnusedWarnings = snd ((,) LookupSym0KindInference ())+ type LookupSym1 :: [AChar] -> (~>) Schema U+ data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U+ where+ LookupSym1KindInference :: SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) =>+ LookupSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Schema @U (LookupSym1 a0123456789876543210) a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) LookupSym1KindInference ())+ type LookupSym2 :: [AChar] -> Schema -> U+ type family LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) :: U where+ LookupSym2 a0123456789876543210 a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210+ type OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)+ data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)+ where+ OccursSym0KindInference :: SameKind (Apply OccursSym0 arg) (OccursSym1 arg) =>+ OccursSym0 a0123456789876543210+ type instance Apply @[AChar] @((~>) Schema Bool) OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210+ instance SuppressUnusedWarnings OccursSym0 where+ suppressUnusedWarnings = snd ((,) OccursSym0KindInference ())+ type OccursSym1 :: [AChar] -> (~>) Schema Bool+ data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool+ where+ OccursSym1KindInference :: SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) =>+ OccursSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Schema @Bool (OccursSym1 a0123456789876543210) a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) OccursSym1KindInference ())+ type OccursSym2 :: [AChar] -> Schema -> Bool+ type family OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) :: Bool where+ OccursSym2 a0123456789876543210 a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210+ type DisjointSym0 :: (~>) Schema ((~>) Schema Bool)+ data DisjointSym0 :: (~>) Schema ((~>) Schema Bool)+ where+ DisjointSym0KindInference :: SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) =>+ DisjointSym0 a0123456789876543210+ type instance Apply @Schema @((~>) Schema Bool) DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210+ instance SuppressUnusedWarnings DisjointSym0 where+ suppressUnusedWarnings = snd ((,) DisjointSym0KindInference ())+ type DisjointSym1 :: Schema -> (~>) Schema Bool+ data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool+ where+ DisjointSym1KindInference :: SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) =>+ DisjointSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Schema @Bool (DisjointSym1 a0123456789876543210) a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) DisjointSym1KindInference ())+ type DisjointSym2 :: Schema -> Schema -> Bool+ type family DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) :: Bool where+ DisjointSym2 a0123456789876543210 a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210+ type AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)+ data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)+ where+ AttrNotInSym0KindInference :: SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) =>+ AttrNotInSym0 a0123456789876543210+ type instance Apply @Attribute @((~>) Schema Bool) AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210+ instance SuppressUnusedWarnings AttrNotInSym0 where+ suppressUnusedWarnings = snd ((,) AttrNotInSym0KindInference ())+ type AttrNotInSym1 :: Attribute -> (~>) Schema Bool+ data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool+ where+ AttrNotInSym1KindInference :: SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) =>+ AttrNotInSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Schema @Bool (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) AttrNotInSym1KindInference ())+ type AttrNotInSym2 :: Attribute -> Schema -> Bool+ type family AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) :: Bool where+ AttrNotInSym2 a0123456789876543210 a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210+ type AppendSym0 :: (~>) Schema ((~>) Schema Schema)+ data AppendSym0 :: (~>) Schema ((~>) Schema Schema)+ where+ AppendSym0KindInference :: SameKind (Apply AppendSym0 arg) (AppendSym1 arg) =>+ AppendSym0 a0123456789876543210+ type instance Apply @Schema @((~>) Schema Schema) AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210+ instance SuppressUnusedWarnings AppendSym0 where+ suppressUnusedWarnings = snd ((,) AppendSym0KindInference ())+ type AppendSym1 :: Schema -> (~>) Schema Schema+ data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema+ where+ AppendSym1KindInference :: SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) =>+ AppendSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Schema @Schema (AppendSym1 a0123456789876543210) a0123456789876543210 = Append a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) AppendSym1KindInference ())+ type AppendSym2 :: Schema -> Schema -> Schema+ type family AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) :: Schema where+ AppendSym2 a0123456789876543210 a0123456789876543210 = Append a0123456789876543210 a0123456789876543210+ type Lookup :: [AChar] -> Schema -> U+ type family Lookup (a :: [AChar]) (a :: Schema) :: U where+ Lookup _ (Sch '[]) = UndefinedSym0+ Lookup name (Sch ('(:) (Attr name' u) attrs)) = Apply (LamCases_0123456789876543210Sym0 name name' u attrs) (Apply (Apply (==@#@$) name) name')+ type Occurs :: [AChar] -> Schema -> Bool+ 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 Disjoint :: Schema -> Schema -> Bool+ 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 AttrNotIn :: Attribute -> Schema -> Bool+ 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 Append :: Schema -> Schema -> Schema+ type family Append (a :: Schema) (a :: Schema) :: Schema where+ Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2)+ type TFHelper_0123456789876543210 :: U -> U -> Bool+ type family TFHelper_0123456789876543210 (a :: U) (a :: U) :: Bool where+ TFHelper_0123456789876543210 BOOL BOOL = TrueSym0+ TFHelper_0123456789876543210 BOOL STRING = FalseSym0+ TFHelper_0123456789876543210 BOOL NAT = FalseSym0+ TFHelper_0123456789876543210 BOOL (VEC _ _) = FalseSym0+ TFHelper_0123456789876543210 STRING BOOL = FalseSym0+ TFHelper_0123456789876543210 STRING STRING = TrueSym0+ TFHelper_0123456789876543210 STRING NAT = FalseSym0+ TFHelper_0123456789876543210 STRING (VEC _ _) = FalseSym0+ TFHelper_0123456789876543210 NAT BOOL = FalseSym0+ TFHelper_0123456789876543210 NAT STRING = FalseSym0+ TFHelper_0123456789876543210 NAT NAT = TrueSym0+ TFHelper_0123456789876543210 NAT (VEC _ _) = FalseSym0+ TFHelper_0123456789876543210 (VEC _ _) BOOL = FalseSym0+ TFHelper_0123456789876543210 (VEC _ _) STRING = FalseSym0+ TFHelper_0123456789876543210 (VEC _ _) NAT = FalseSym0+ TFHelper_0123456789876543210 (VEC a_0123456789876543210 a_0123456789876543210) (VEC b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)+ instance PEq U where+ type (==) a a = TFHelper_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> U -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (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+ instance PShow U where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> AChar -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (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+ instance PShow AChar where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type TFHelper_0123456789876543210 :: AChar -> AChar -> Bool+ type family TFHelper_0123456789876543210 (a :: AChar) (a :: AChar) :: Bool where+ TFHelper_0123456789876543210 CA CA = TrueSym0+ TFHelper_0123456789876543210 CA CB = FalseSym0+ TFHelper_0123456789876543210 CA CC = FalseSym0+ TFHelper_0123456789876543210 CA CD = FalseSym0+ TFHelper_0123456789876543210 CA CE = FalseSym0+ TFHelper_0123456789876543210 CA CF = FalseSym0+ TFHelper_0123456789876543210 CA CG = FalseSym0+ TFHelper_0123456789876543210 CA CH = FalseSym0+ TFHelper_0123456789876543210 CA CI = FalseSym0+ TFHelper_0123456789876543210 CA CJ = FalseSym0+ TFHelper_0123456789876543210 CA CK = FalseSym0+ TFHelper_0123456789876543210 CA CL = FalseSym0+ TFHelper_0123456789876543210 CA CM = FalseSym0+ TFHelper_0123456789876543210 CA CN = FalseSym0+ TFHelper_0123456789876543210 CA CO = FalseSym0+ TFHelper_0123456789876543210 CA CP = FalseSym0+ TFHelper_0123456789876543210 CA CQ = FalseSym0+ TFHelper_0123456789876543210 CA CR = FalseSym0+ TFHelper_0123456789876543210 CA CS = FalseSym0+ TFHelper_0123456789876543210 CA CT = FalseSym0+ TFHelper_0123456789876543210 CA CU = FalseSym0+ TFHelper_0123456789876543210 CA CV = FalseSym0+ TFHelper_0123456789876543210 CA CW = FalseSym0+ TFHelper_0123456789876543210 CA CX = FalseSym0+ TFHelper_0123456789876543210 CA CY = FalseSym0+ TFHelper_0123456789876543210 CA CZ = FalseSym0+ TFHelper_0123456789876543210 CB CA = FalseSym0+ TFHelper_0123456789876543210 CB CB = TrueSym0+ TFHelper_0123456789876543210 CB CC = FalseSym0+ TFHelper_0123456789876543210 CB CD = FalseSym0+ TFHelper_0123456789876543210 CB CE = FalseSym0+ TFHelper_0123456789876543210 CB CF = FalseSym0+ TFHelper_0123456789876543210 CB CG = FalseSym0+ TFHelper_0123456789876543210 CB CH = FalseSym0+ TFHelper_0123456789876543210 CB CI = FalseSym0+ TFHelper_0123456789876543210 CB CJ = FalseSym0+ TFHelper_0123456789876543210 CB CK = FalseSym0+ TFHelper_0123456789876543210 CB CL = FalseSym0+ TFHelper_0123456789876543210 CB CM = FalseSym0+ TFHelper_0123456789876543210 CB CN = FalseSym0+ TFHelper_0123456789876543210 CB CO = FalseSym0+ TFHelper_0123456789876543210 CB CP = FalseSym0+ TFHelper_0123456789876543210 CB CQ = FalseSym0+ TFHelper_0123456789876543210 CB CR = FalseSym0+ TFHelper_0123456789876543210 CB CS = FalseSym0+ TFHelper_0123456789876543210 CB CT = FalseSym0+ TFHelper_0123456789876543210 CB CU = FalseSym0+ TFHelper_0123456789876543210 CB CV = FalseSym0+ TFHelper_0123456789876543210 CB CW = FalseSym0+ TFHelper_0123456789876543210 CB CX = FalseSym0+ TFHelper_0123456789876543210 CB CY = FalseSym0+ TFHelper_0123456789876543210 CB CZ = FalseSym0+ TFHelper_0123456789876543210 CC CA = FalseSym0+ TFHelper_0123456789876543210 CC CB = FalseSym0+ TFHelper_0123456789876543210 CC CC = TrueSym0+ TFHelper_0123456789876543210 CC CD = FalseSym0+ TFHelper_0123456789876543210 CC CE = FalseSym0+ TFHelper_0123456789876543210 CC CF = FalseSym0+ TFHelper_0123456789876543210 CC CG = FalseSym0+ TFHelper_0123456789876543210 CC CH = FalseSym0+ TFHelper_0123456789876543210 CC CI = FalseSym0+ TFHelper_0123456789876543210 CC CJ = FalseSym0+ TFHelper_0123456789876543210 CC CK = FalseSym0+ TFHelper_0123456789876543210 CC CL = FalseSym0+ TFHelper_0123456789876543210 CC CM = FalseSym0+ TFHelper_0123456789876543210 CC CN = FalseSym0+ TFHelper_0123456789876543210 CC CO = FalseSym0+ TFHelper_0123456789876543210 CC CP = FalseSym0+ TFHelper_0123456789876543210 CC CQ = FalseSym0+ TFHelper_0123456789876543210 CC CR = FalseSym0+ TFHelper_0123456789876543210 CC CS = FalseSym0+ TFHelper_0123456789876543210 CC CT = FalseSym0+ TFHelper_0123456789876543210 CC CU = FalseSym0+ TFHelper_0123456789876543210 CC CV = FalseSym0+ TFHelper_0123456789876543210 CC CW = FalseSym0+ TFHelper_0123456789876543210 CC CX = FalseSym0+ TFHelper_0123456789876543210 CC CY = FalseSym0+ TFHelper_0123456789876543210 CC CZ = FalseSym0+ TFHelper_0123456789876543210 CD CA = FalseSym0+ TFHelper_0123456789876543210 CD CB = FalseSym0+ TFHelper_0123456789876543210 CD CC = FalseSym0+ TFHelper_0123456789876543210 CD CD = TrueSym0+ TFHelper_0123456789876543210 CD CE = FalseSym0+ TFHelper_0123456789876543210 CD CF = FalseSym0+ TFHelper_0123456789876543210 CD CG = FalseSym0+ TFHelper_0123456789876543210 CD CH = FalseSym0+ TFHelper_0123456789876543210 CD CI = FalseSym0+ TFHelper_0123456789876543210 CD CJ = FalseSym0+ TFHelper_0123456789876543210 CD CK = FalseSym0+ TFHelper_0123456789876543210 CD CL = FalseSym0+ TFHelper_0123456789876543210 CD CM = FalseSym0+ TFHelper_0123456789876543210 CD CN = FalseSym0+ TFHelper_0123456789876543210 CD CO = FalseSym0+ TFHelper_0123456789876543210 CD CP = FalseSym0+ TFHelper_0123456789876543210 CD CQ = FalseSym0+ TFHelper_0123456789876543210 CD CR = FalseSym0+ TFHelper_0123456789876543210 CD CS = FalseSym0+ TFHelper_0123456789876543210 CD CT = FalseSym0+ TFHelper_0123456789876543210 CD CU = FalseSym0+ TFHelper_0123456789876543210 CD CV = FalseSym0+ TFHelper_0123456789876543210 CD CW = FalseSym0+ TFHelper_0123456789876543210 CD CX = FalseSym0+ TFHelper_0123456789876543210 CD CY = FalseSym0+ TFHelper_0123456789876543210 CD CZ = FalseSym0+ TFHelper_0123456789876543210 CE CA = FalseSym0+ TFHelper_0123456789876543210 CE CB = FalseSym0+ TFHelper_0123456789876543210 CE CC = FalseSym0+ TFHelper_0123456789876543210 CE CD = FalseSym0+ TFHelper_0123456789876543210 CE CE = TrueSym0+ TFHelper_0123456789876543210 CE CF = FalseSym0+ TFHelper_0123456789876543210 CE CG = FalseSym0+ TFHelper_0123456789876543210 CE CH = FalseSym0+ TFHelper_0123456789876543210 CE CI = FalseSym0+ TFHelper_0123456789876543210 CE CJ = FalseSym0+ TFHelper_0123456789876543210 CE CK = FalseSym0+ TFHelper_0123456789876543210 CE CL = FalseSym0+ TFHelper_0123456789876543210 CE CM = FalseSym0+ TFHelper_0123456789876543210 CE CN = FalseSym0+ TFHelper_0123456789876543210 CE CO = FalseSym0+ TFHelper_0123456789876543210 CE CP = FalseSym0+ TFHelper_0123456789876543210 CE CQ = FalseSym0+ TFHelper_0123456789876543210 CE CR = FalseSym0+ TFHelper_0123456789876543210 CE CS = FalseSym0+ TFHelper_0123456789876543210 CE CT = FalseSym0+ TFHelper_0123456789876543210 CE CU = FalseSym0+ TFHelper_0123456789876543210 CE CV = FalseSym0+ TFHelper_0123456789876543210 CE CW = FalseSym0+ TFHelper_0123456789876543210 CE CX = FalseSym0+ TFHelper_0123456789876543210 CE CY = FalseSym0+ TFHelper_0123456789876543210 CE CZ = FalseSym0+ TFHelper_0123456789876543210 CF CA = FalseSym0+ TFHelper_0123456789876543210 CF CB = FalseSym0+ TFHelper_0123456789876543210 CF CC = FalseSym0+ TFHelper_0123456789876543210 CF CD = FalseSym0+ TFHelper_0123456789876543210 CF CE = FalseSym0+ TFHelper_0123456789876543210 CF CF = TrueSym0+ TFHelper_0123456789876543210 CF CG = FalseSym0+ TFHelper_0123456789876543210 CF CH = FalseSym0+ TFHelper_0123456789876543210 CF CI = FalseSym0+ TFHelper_0123456789876543210 CF CJ = FalseSym0+ TFHelper_0123456789876543210 CF CK = FalseSym0+ TFHelper_0123456789876543210 CF CL = FalseSym0+ TFHelper_0123456789876543210 CF CM = FalseSym0+ TFHelper_0123456789876543210 CF CN = FalseSym0+ TFHelper_0123456789876543210 CF CO = FalseSym0+ TFHelper_0123456789876543210 CF CP = FalseSym0+ TFHelper_0123456789876543210 CF CQ = FalseSym0+ TFHelper_0123456789876543210 CF CR = FalseSym0+ TFHelper_0123456789876543210 CF CS = FalseSym0+ TFHelper_0123456789876543210 CF CT = FalseSym0+ TFHelper_0123456789876543210 CF CU = FalseSym0+ TFHelper_0123456789876543210 CF CV = FalseSym0+ TFHelper_0123456789876543210 CF CW = FalseSym0+ TFHelper_0123456789876543210 CF CX = FalseSym0+ TFHelper_0123456789876543210 CF CY = FalseSym0+ TFHelper_0123456789876543210 CF CZ = FalseSym0+ TFHelper_0123456789876543210 CG CA = FalseSym0+ TFHelper_0123456789876543210 CG CB = FalseSym0+ TFHelper_0123456789876543210 CG CC = FalseSym0+ TFHelper_0123456789876543210 CG CD = FalseSym0+ TFHelper_0123456789876543210 CG CE = FalseSym0+ TFHelper_0123456789876543210 CG CF = FalseSym0+ TFHelper_0123456789876543210 CG CG = TrueSym0+ TFHelper_0123456789876543210 CG CH = FalseSym0+ TFHelper_0123456789876543210 CG CI = FalseSym0+ TFHelper_0123456789876543210 CG CJ = FalseSym0+ TFHelper_0123456789876543210 CG CK = FalseSym0+ TFHelper_0123456789876543210 CG CL = FalseSym0+ TFHelper_0123456789876543210 CG CM = FalseSym0+ TFHelper_0123456789876543210 CG CN = FalseSym0+ TFHelper_0123456789876543210 CG CO = FalseSym0+ TFHelper_0123456789876543210 CG CP = FalseSym0+ TFHelper_0123456789876543210 CG CQ = FalseSym0+ TFHelper_0123456789876543210 CG CR = FalseSym0+ TFHelper_0123456789876543210 CG CS = FalseSym0+ TFHelper_0123456789876543210 CG CT = FalseSym0+ TFHelper_0123456789876543210 CG CU = FalseSym0+ TFHelper_0123456789876543210 CG CV = FalseSym0+ TFHelper_0123456789876543210 CG CW = FalseSym0+ TFHelper_0123456789876543210 CG CX = FalseSym0+ TFHelper_0123456789876543210 CG CY = FalseSym0+ TFHelper_0123456789876543210 CG CZ = FalseSym0+ TFHelper_0123456789876543210 CH CA = FalseSym0+ TFHelper_0123456789876543210 CH CB = FalseSym0+ TFHelper_0123456789876543210 CH CC = FalseSym0+ TFHelper_0123456789876543210 CH CD = FalseSym0+ TFHelper_0123456789876543210 CH CE = FalseSym0+ TFHelper_0123456789876543210 CH CF = FalseSym0+ TFHelper_0123456789876543210 CH CG = FalseSym0+ TFHelper_0123456789876543210 CH CH = TrueSym0+ TFHelper_0123456789876543210 CH CI = FalseSym0+ TFHelper_0123456789876543210 CH CJ = FalseSym0+ TFHelper_0123456789876543210 CH CK = FalseSym0+ TFHelper_0123456789876543210 CH CL = FalseSym0+ TFHelper_0123456789876543210 CH CM = FalseSym0+ TFHelper_0123456789876543210 CH CN = FalseSym0+ TFHelper_0123456789876543210 CH CO = FalseSym0+ TFHelper_0123456789876543210 CH CP = FalseSym0+ TFHelper_0123456789876543210 CH CQ = FalseSym0+ TFHelper_0123456789876543210 CH CR = FalseSym0+ TFHelper_0123456789876543210 CH CS = FalseSym0+ TFHelper_0123456789876543210 CH CT = FalseSym0+ TFHelper_0123456789876543210 CH CU = FalseSym0+ TFHelper_0123456789876543210 CH CV = FalseSym0+ TFHelper_0123456789876543210 CH CW = FalseSym0+ TFHelper_0123456789876543210 CH CX = FalseSym0+ TFHelper_0123456789876543210 CH CY = FalseSym0+ TFHelper_0123456789876543210 CH CZ = FalseSym0+ TFHelper_0123456789876543210 CI CA = FalseSym0+ TFHelper_0123456789876543210 CI CB = FalseSym0+ TFHelper_0123456789876543210 CI CC = FalseSym0+ TFHelper_0123456789876543210 CI CD = FalseSym0+ TFHelper_0123456789876543210 CI CE = FalseSym0+ TFHelper_0123456789876543210 CI CF = FalseSym0+ TFHelper_0123456789876543210 CI CG = FalseSym0+ TFHelper_0123456789876543210 CI CH = FalseSym0+ TFHelper_0123456789876543210 CI CI = TrueSym0+ TFHelper_0123456789876543210 CI CJ = FalseSym0+ TFHelper_0123456789876543210 CI CK = FalseSym0+ TFHelper_0123456789876543210 CI CL = FalseSym0+ TFHelper_0123456789876543210 CI CM = FalseSym0+ TFHelper_0123456789876543210 CI CN = FalseSym0+ TFHelper_0123456789876543210 CI CO = FalseSym0+ TFHelper_0123456789876543210 CI CP = FalseSym0+ TFHelper_0123456789876543210 CI CQ = FalseSym0+ TFHelper_0123456789876543210 CI CR = FalseSym0+ TFHelper_0123456789876543210 CI CS = FalseSym0+ TFHelper_0123456789876543210 CI CT = FalseSym0+ TFHelper_0123456789876543210 CI CU = FalseSym0+ TFHelper_0123456789876543210 CI CV = FalseSym0+ TFHelper_0123456789876543210 CI CW = FalseSym0+ TFHelper_0123456789876543210 CI CX = FalseSym0+ TFHelper_0123456789876543210 CI CY = FalseSym0+ TFHelper_0123456789876543210 CI CZ = FalseSym0+ TFHelper_0123456789876543210 CJ CA = FalseSym0+ TFHelper_0123456789876543210 CJ CB = FalseSym0+ TFHelper_0123456789876543210 CJ CC = FalseSym0+ TFHelper_0123456789876543210 CJ CD = FalseSym0+ TFHelper_0123456789876543210 CJ CE = FalseSym0+ TFHelper_0123456789876543210 CJ CF = FalseSym0+ TFHelper_0123456789876543210 CJ CG = FalseSym0+ TFHelper_0123456789876543210 CJ CH = FalseSym0+ TFHelper_0123456789876543210 CJ CI = FalseSym0+ TFHelper_0123456789876543210 CJ CJ = TrueSym0+ TFHelper_0123456789876543210 CJ CK = FalseSym0+ TFHelper_0123456789876543210 CJ CL = FalseSym0+ TFHelper_0123456789876543210 CJ CM = FalseSym0+ TFHelper_0123456789876543210 CJ CN = FalseSym0+ TFHelper_0123456789876543210 CJ CO = FalseSym0+ TFHelper_0123456789876543210 CJ CP = FalseSym0+ TFHelper_0123456789876543210 CJ CQ = FalseSym0+ TFHelper_0123456789876543210 CJ CR = FalseSym0+ TFHelper_0123456789876543210 CJ CS = FalseSym0+ TFHelper_0123456789876543210 CJ CT = FalseSym0+ TFHelper_0123456789876543210 CJ CU = FalseSym0+ TFHelper_0123456789876543210 CJ CV = FalseSym0+ TFHelper_0123456789876543210 CJ CW = FalseSym0+ TFHelper_0123456789876543210 CJ CX = FalseSym0+ TFHelper_0123456789876543210 CJ CY = FalseSym0+ TFHelper_0123456789876543210 CJ CZ = FalseSym0+ TFHelper_0123456789876543210 CK CA = FalseSym0+ TFHelper_0123456789876543210 CK CB = FalseSym0+ TFHelper_0123456789876543210 CK CC = FalseSym0+ TFHelper_0123456789876543210 CK CD = FalseSym0+ TFHelper_0123456789876543210 CK CE = FalseSym0+ TFHelper_0123456789876543210 CK CF = FalseSym0+ TFHelper_0123456789876543210 CK CG = FalseSym0+ TFHelper_0123456789876543210 CK CH = FalseSym0+ TFHelper_0123456789876543210 CK CI = FalseSym0+ TFHelper_0123456789876543210 CK CJ = FalseSym0+ TFHelper_0123456789876543210 CK CK = TrueSym0+ TFHelper_0123456789876543210 CK CL = FalseSym0+ TFHelper_0123456789876543210 CK CM = FalseSym0+ TFHelper_0123456789876543210 CK CN = FalseSym0+ TFHelper_0123456789876543210 CK CO = FalseSym0+ TFHelper_0123456789876543210 CK CP = FalseSym0+ TFHelper_0123456789876543210 CK CQ = FalseSym0+ TFHelper_0123456789876543210 CK CR = FalseSym0+ TFHelper_0123456789876543210 CK CS = FalseSym0+ TFHelper_0123456789876543210 CK CT = FalseSym0+ TFHelper_0123456789876543210 CK CU = FalseSym0+ TFHelper_0123456789876543210 CK CV = FalseSym0+ TFHelper_0123456789876543210 CK CW = FalseSym0+ TFHelper_0123456789876543210 CK CX = FalseSym0+ TFHelper_0123456789876543210 CK CY = FalseSym0+ TFHelper_0123456789876543210 CK CZ = FalseSym0+ TFHelper_0123456789876543210 CL CA = FalseSym0+ TFHelper_0123456789876543210 CL CB = FalseSym0+ TFHelper_0123456789876543210 CL CC = FalseSym0+ TFHelper_0123456789876543210 CL CD = FalseSym0+ TFHelper_0123456789876543210 CL CE = FalseSym0+ TFHelper_0123456789876543210 CL CF = FalseSym0+ TFHelper_0123456789876543210 CL CG = FalseSym0+ TFHelper_0123456789876543210 CL CH = FalseSym0+ TFHelper_0123456789876543210 CL CI = FalseSym0+ TFHelper_0123456789876543210 CL CJ = FalseSym0+ TFHelper_0123456789876543210 CL CK = FalseSym0+ TFHelper_0123456789876543210 CL CL = TrueSym0+ TFHelper_0123456789876543210 CL CM = FalseSym0+ TFHelper_0123456789876543210 CL CN = FalseSym0+ TFHelper_0123456789876543210 CL CO = FalseSym0+ TFHelper_0123456789876543210 CL CP = FalseSym0+ TFHelper_0123456789876543210 CL CQ = FalseSym0+ TFHelper_0123456789876543210 CL CR = FalseSym0+ TFHelper_0123456789876543210 CL CS = FalseSym0+ TFHelper_0123456789876543210 CL CT = FalseSym0+ TFHelper_0123456789876543210 CL CU = FalseSym0+ TFHelper_0123456789876543210 CL CV = FalseSym0+ TFHelper_0123456789876543210 CL CW = FalseSym0+ TFHelper_0123456789876543210 CL CX = FalseSym0+ TFHelper_0123456789876543210 CL CY = FalseSym0+ TFHelper_0123456789876543210 CL CZ = FalseSym0+ TFHelper_0123456789876543210 CM CA = FalseSym0+ TFHelper_0123456789876543210 CM CB = FalseSym0+ TFHelper_0123456789876543210 CM CC = FalseSym0+ TFHelper_0123456789876543210 CM CD = FalseSym0+ TFHelper_0123456789876543210 CM CE = FalseSym0+ TFHelper_0123456789876543210 CM CF = FalseSym0+ TFHelper_0123456789876543210 CM CG = FalseSym0+ TFHelper_0123456789876543210 CM CH = FalseSym0+ TFHelper_0123456789876543210 CM CI = FalseSym0+ TFHelper_0123456789876543210 CM CJ = FalseSym0+ TFHelper_0123456789876543210 CM CK = FalseSym0+ TFHelper_0123456789876543210 CM CL = FalseSym0+ TFHelper_0123456789876543210 CM CM = TrueSym0+ TFHelper_0123456789876543210 CM CN = FalseSym0+ TFHelper_0123456789876543210 CM CO = FalseSym0+ TFHelper_0123456789876543210 CM CP = FalseSym0+ TFHelper_0123456789876543210 CM CQ = FalseSym0+ TFHelper_0123456789876543210 CM CR = FalseSym0+ TFHelper_0123456789876543210 CM CS = FalseSym0+ TFHelper_0123456789876543210 CM CT = FalseSym0+ TFHelper_0123456789876543210 CM CU = FalseSym0+ TFHelper_0123456789876543210 CM CV = FalseSym0+ TFHelper_0123456789876543210 CM CW = FalseSym0+ TFHelper_0123456789876543210 CM CX = FalseSym0+ TFHelper_0123456789876543210 CM CY = FalseSym0+ TFHelper_0123456789876543210 CM CZ = FalseSym0+ TFHelper_0123456789876543210 CN CA = FalseSym0+ TFHelper_0123456789876543210 CN CB = FalseSym0+ TFHelper_0123456789876543210 CN CC = FalseSym0+ TFHelper_0123456789876543210 CN CD = FalseSym0+ TFHelper_0123456789876543210 CN CE = FalseSym0+ TFHelper_0123456789876543210 CN CF = FalseSym0+ TFHelper_0123456789876543210 CN CG = FalseSym0+ TFHelper_0123456789876543210 CN CH = FalseSym0+ TFHelper_0123456789876543210 CN CI = FalseSym0+ TFHelper_0123456789876543210 CN CJ = FalseSym0+ TFHelper_0123456789876543210 CN CK = FalseSym0+ TFHelper_0123456789876543210 CN CL = FalseSym0+ TFHelper_0123456789876543210 CN CM = FalseSym0+ TFHelper_0123456789876543210 CN CN = TrueSym0+ TFHelper_0123456789876543210 CN CO = FalseSym0+ TFHelper_0123456789876543210 CN CP = FalseSym0+ TFHelper_0123456789876543210 CN CQ = FalseSym0+ TFHelper_0123456789876543210 CN CR = FalseSym0+ TFHelper_0123456789876543210 CN CS = FalseSym0+ TFHelper_0123456789876543210 CN CT = FalseSym0+ TFHelper_0123456789876543210 CN CU = FalseSym0+ TFHelper_0123456789876543210 CN CV = FalseSym0+ TFHelper_0123456789876543210 CN CW = FalseSym0+ TFHelper_0123456789876543210 CN CX = FalseSym0+ TFHelper_0123456789876543210 CN CY = FalseSym0+ TFHelper_0123456789876543210 CN CZ = FalseSym0+ TFHelper_0123456789876543210 CO CA = FalseSym0+ TFHelper_0123456789876543210 CO CB = FalseSym0+ TFHelper_0123456789876543210 CO CC = FalseSym0+ TFHelper_0123456789876543210 CO CD = FalseSym0+ TFHelper_0123456789876543210 CO CE = FalseSym0+ TFHelper_0123456789876543210 CO CF = FalseSym0+ TFHelper_0123456789876543210 CO CG = FalseSym0+ TFHelper_0123456789876543210 CO CH = FalseSym0+ TFHelper_0123456789876543210 CO CI = FalseSym0+ TFHelper_0123456789876543210 CO CJ = FalseSym0+ TFHelper_0123456789876543210 CO CK = FalseSym0+ TFHelper_0123456789876543210 CO CL = FalseSym0+ TFHelper_0123456789876543210 CO CM = FalseSym0+ TFHelper_0123456789876543210 CO CN = FalseSym0+ TFHelper_0123456789876543210 CO CO = TrueSym0+ TFHelper_0123456789876543210 CO CP = FalseSym0+ TFHelper_0123456789876543210 CO CQ = FalseSym0+ TFHelper_0123456789876543210 CO CR = FalseSym0+ TFHelper_0123456789876543210 CO CS = FalseSym0+ TFHelper_0123456789876543210 CO CT = FalseSym0+ TFHelper_0123456789876543210 CO CU = FalseSym0+ TFHelper_0123456789876543210 CO CV = FalseSym0+ TFHelper_0123456789876543210 CO CW = FalseSym0+ TFHelper_0123456789876543210 CO CX = FalseSym0+ TFHelper_0123456789876543210 CO CY = FalseSym0+ TFHelper_0123456789876543210 CO CZ = FalseSym0+ TFHelper_0123456789876543210 CP CA = FalseSym0+ TFHelper_0123456789876543210 CP CB = FalseSym0+ TFHelper_0123456789876543210 CP CC = FalseSym0+ TFHelper_0123456789876543210 CP CD = FalseSym0+ TFHelper_0123456789876543210 CP CE = FalseSym0+ TFHelper_0123456789876543210 CP CF = FalseSym0+ TFHelper_0123456789876543210 CP CG = FalseSym0+ TFHelper_0123456789876543210 CP CH = FalseSym0+ TFHelper_0123456789876543210 CP CI = FalseSym0+ TFHelper_0123456789876543210 CP CJ = FalseSym0+ TFHelper_0123456789876543210 CP CK = FalseSym0+ TFHelper_0123456789876543210 CP CL = FalseSym0+ TFHelper_0123456789876543210 CP CM = FalseSym0+ TFHelper_0123456789876543210 CP CN = FalseSym0+ TFHelper_0123456789876543210 CP CO = FalseSym0+ TFHelper_0123456789876543210 CP CP = TrueSym0+ TFHelper_0123456789876543210 CP CQ = FalseSym0+ TFHelper_0123456789876543210 CP CR = FalseSym0+ TFHelper_0123456789876543210 CP CS = FalseSym0+ TFHelper_0123456789876543210 CP CT = FalseSym0+ TFHelper_0123456789876543210 CP CU = FalseSym0+ TFHelper_0123456789876543210 CP CV = FalseSym0+ TFHelper_0123456789876543210 CP CW = FalseSym0+ TFHelper_0123456789876543210 CP CX = FalseSym0+ TFHelper_0123456789876543210 CP CY = FalseSym0+ TFHelper_0123456789876543210 CP CZ = FalseSym0+ TFHelper_0123456789876543210 CQ CA = FalseSym0+ TFHelper_0123456789876543210 CQ CB = FalseSym0+ TFHelper_0123456789876543210 CQ CC = FalseSym0+ TFHelper_0123456789876543210 CQ CD = FalseSym0+ TFHelper_0123456789876543210 CQ CE = FalseSym0+ TFHelper_0123456789876543210 CQ CF = FalseSym0+ TFHelper_0123456789876543210 CQ CG = FalseSym0+ TFHelper_0123456789876543210 CQ CH = FalseSym0+ TFHelper_0123456789876543210 CQ CI = FalseSym0+ TFHelper_0123456789876543210 CQ CJ = FalseSym0+ TFHelper_0123456789876543210 CQ CK = FalseSym0+ TFHelper_0123456789876543210 CQ CL = FalseSym0+ TFHelper_0123456789876543210 CQ CM = FalseSym0+ TFHelper_0123456789876543210 CQ CN = FalseSym0+ TFHelper_0123456789876543210 CQ CO = FalseSym0+ TFHelper_0123456789876543210 CQ CP = FalseSym0+ TFHelper_0123456789876543210 CQ CQ = TrueSym0+ TFHelper_0123456789876543210 CQ CR = FalseSym0+ TFHelper_0123456789876543210 CQ CS = FalseSym0+ TFHelper_0123456789876543210 CQ CT = FalseSym0+ TFHelper_0123456789876543210 CQ CU = FalseSym0+ TFHelper_0123456789876543210 CQ CV = FalseSym0+ TFHelper_0123456789876543210 CQ CW = FalseSym0+ TFHelper_0123456789876543210 CQ CX = FalseSym0+ TFHelper_0123456789876543210 CQ CY = FalseSym0+ TFHelper_0123456789876543210 CQ CZ = FalseSym0+ TFHelper_0123456789876543210 CR CA = FalseSym0+ TFHelper_0123456789876543210 CR CB = FalseSym0+ TFHelper_0123456789876543210 CR CC = FalseSym0+ TFHelper_0123456789876543210 CR CD = FalseSym0+ TFHelper_0123456789876543210 CR CE = FalseSym0+ TFHelper_0123456789876543210 CR CF = FalseSym0+ TFHelper_0123456789876543210 CR CG = FalseSym0+ TFHelper_0123456789876543210 CR CH = FalseSym0+ TFHelper_0123456789876543210 CR CI = FalseSym0+ TFHelper_0123456789876543210 CR CJ = FalseSym0+ TFHelper_0123456789876543210 CR CK = FalseSym0+ TFHelper_0123456789876543210 CR CL = FalseSym0+ TFHelper_0123456789876543210 CR CM = FalseSym0+ TFHelper_0123456789876543210 CR CN = FalseSym0+ TFHelper_0123456789876543210 CR CO = FalseSym0+ TFHelper_0123456789876543210 CR CP = FalseSym0+ TFHelper_0123456789876543210 CR CQ = FalseSym0+ TFHelper_0123456789876543210 CR CR = TrueSym0+ TFHelper_0123456789876543210 CR CS = FalseSym0+ TFHelper_0123456789876543210 CR CT = FalseSym0+ TFHelper_0123456789876543210 CR CU = FalseSym0+ TFHelper_0123456789876543210 CR CV = FalseSym0+ TFHelper_0123456789876543210 CR CW = FalseSym0+ TFHelper_0123456789876543210 CR CX = FalseSym0+ TFHelper_0123456789876543210 CR CY = FalseSym0+ TFHelper_0123456789876543210 CR CZ = FalseSym0+ TFHelper_0123456789876543210 CS CA = FalseSym0+ TFHelper_0123456789876543210 CS CB = FalseSym0+ TFHelper_0123456789876543210 CS CC = FalseSym0+ TFHelper_0123456789876543210 CS CD = FalseSym0+ TFHelper_0123456789876543210 CS CE = FalseSym0+ TFHelper_0123456789876543210 CS CF = FalseSym0+ TFHelper_0123456789876543210 CS CG = FalseSym0+ TFHelper_0123456789876543210 CS CH = FalseSym0+ TFHelper_0123456789876543210 CS CI = FalseSym0+ TFHelper_0123456789876543210 CS CJ = FalseSym0+ TFHelper_0123456789876543210 CS CK = FalseSym0+ TFHelper_0123456789876543210 CS CL = FalseSym0+ TFHelper_0123456789876543210 CS CM = FalseSym0+ TFHelper_0123456789876543210 CS CN = FalseSym0+ TFHelper_0123456789876543210 CS CO = FalseSym0+ TFHelper_0123456789876543210 CS CP = FalseSym0+ TFHelper_0123456789876543210 CS CQ = FalseSym0+ TFHelper_0123456789876543210 CS CR = FalseSym0+ TFHelper_0123456789876543210 CS CS = TrueSym0+ TFHelper_0123456789876543210 CS CT = FalseSym0+ TFHelper_0123456789876543210 CS CU = FalseSym0+ TFHelper_0123456789876543210 CS CV = FalseSym0+ TFHelper_0123456789876543210 CS CW = FalseSym0+ TFHelper_0123456789876543210 CS CX = FalseSym0+ TFHelper_0123456789876543210 CS CY = FalseSym0+ TFHelper_0123456789876543210 CS CZ = FalseSym0+ TFHelper_0123456789876543210 CT CA = FalseSym0+ TFHelper_0123456789876543210 CT CB = FalseSym0+ TFHelper_0123456789876543210 CT CC = FalseSym0+ TFHelper_0123456789876543210 CT CD = FalseSym0+ TFHelper_0123456789876543210 CT CE = FalseSym0+ TFHelper_0123456789876543210 CT CF = FalseSym0+ TFHelper_0123456789876543210 CT CG = FalseSym0+ TFHelper_0123456789876543210 CT CH = FalseSym0+ TFHelper_0123456789876543210 CT CI = FalseSym0+ TFHelper_0123456789876543210 CT CJ = FalseSym0+ TFHelper_0123456789876543210 CT CK = FalseSym0+ TFHelper_0123456789876543210 CT CL = FalseSym0+ TFHelper_0123456789876543210 CT CM = FalseSym0+ TFHelper_0123456789876543210 CT CN = FalseSym0+ TFHelper_0123456789876543210 CT CO = FalseSym0+ TFHelper_0123456789876543210 CT CP = FalseSym0+ TFHelper_0123456789876543210 CT CQ = FalseSym0+ TFHelper_0123456789876543210 CT CR = FalseSym0+ TFHelper_0123456789876543210 CT CS = FalseSym0+ TFHelper_0123456789876543210 CT CT = TrueSym0+ TFHelper_0123456789876543210 CT CU = FalseSym0+ TFHelper_0123456789876543210 CT CV = FalseSym0+ TFHelper_0123456789876543210 CT CW = FalseSym0+ TFHelper_0123456789876543210 CT CX = FalseSym0+ TFHelper_0123456789876543210 CT CY = FalseSym0+ TFHelper_0123456789876543210 CT CZ = FalseSym0+ TFHelper_0123456789876543210 CU CA = FalseSym0+ TFHelper_0123456789876543210 CU CB = FalseSym0+ TFHelper_0123456789876543210 CU CC = FalseSym0+ TFHelper_0123456789876543210 CU CD = FalseSym0+ TFHelper_0123456789876543210 CU CE = FalseSym0+ TFHelper_0123456789876543210 CU CF = FalseSym0+ TFHelper_0123456789876543210 CU CG = FalseSym0+ TFHelper_0123456789876543210 CU CH = FalseSym0+ TFHelper_0123456789876543210 CU CI = FalseSym0+ TFHelper_0123456789876543210 CU CJ = FalseSym0+ TFHelper_0123456789876543210 CU CK = FalseSym0+ TFHelper_0123456789876543210 CU CL = FalseSym0+ TFHelper_0123456789876543210 CU CM = FalseSym0+ TFHelper_0123456789876543210 CU CN = FalseSym0+ TFHelper_0123456789876543210 CU CO = FalseSym0+ TFHelper_0123456789876543210 CU CP = FalseSym0+ TFHelper_0123456789876543210 CU CQ = FalseSym0+ TFHelper_0123456789876543210 CU CR = FalseSym0+ TFHelper_0123456789876543210 CU CS = FalseSym0+ TFHelper_0123456789876543210 CU CT = FalseSym0+ TFHelper_0123456789876543210 CU CU = TrueSym0+ TFHelper_0123456789876543210 CU CV = FalseSym0+ TFHelper_0123456789876543210 CU CW = FalseSym0+ TFHelper_0123456789876543210 CU CX = FalseSym0+ TFHelper_0123456789876543210 CU CY = FalseSym0+ TFHelper_0123456789876543210 CU CZ = FalseSym0+ TFHelper_0123456789876543210 CV CA = FalseSym0+ TFHelper_0123456789876543210 CV CB = FalseSym0+ TFHelper_0123456789876543210 CV CC = FalseSym0+ TFHelper_0123456789876543210 CV CD = FalseSym0+ TFHelper_0123456789876543210 CV CE = FalseSym0+ TFHelper_0123456789876543210 CV CF = FalseSym0+ TFHelper_0123456789876543210 CV CG = FalseSym0+ TFHelper_0123456789876543210 CV CH = FalseSym0+ TFHelper_0123456789876543210 CV CI = FalseSym0+ TFHelper_0123456789876543210 CV CJ = FalseSym0+ TFHelper_0123456789876543210 CV CK = FalseSym0+ TFHelper_0123456789876543210 CV CL = FalseSym0+ TFHelper_0123456789876543210 CV CM = FalseSym0+ TFHelper_0123456789876543210 CV CN = FalseSym0+ TFHelper_0123456789876543210 CV CO = FalseSym0+ TFHelper_0123456789876543210 CV CP = FalseSym0+ TFHelper_0123456789876543210 CV CQ = FalseSym0+ TFHelper_0123456789876543210 CV CR = FalseSym0+ TFHelper_0123456789876543210 CV CS = FalseSym0+ TFHelper_0123456789876543210 CV CT = FalseSym0+ TFHelper_0123456789876543210 CV CU = FalseSym0+ TFHelper_0123456789876543210 CV CV = TrueSym0+ TFHelper_0123456789876543210 CV CW = FalseSym0+ TFHelper_0123456789876543210 CV CX = FalseSym0+ TFHelper_0123456789876543210 CV CY = FalseSym0+ TFHelper_0123456789876543210 CV CZ = FalseSym0+ TFHelper_0123456789876543210 CW CA = FalseSym0+ TFHelper_0123456789876543210 CW CB = FalseSym0+ TFHelper_0123456789876543210 CW CC = FalseSym0+ TFHelper_0123456789876543210 CW CD = FalseSym0+ TFHelper_0123456789876543210 CW CE = FalseSym0+ TFHelper_0123456789876543210 CW CF = FalseSym0+ TFHelper_0123456789876543210 CW CG = FalseSym0+ TFHelper_0123456789876543210 CW CH = FalseSym0+ TFHelper_0123456789876543210 CW CI = FalseSym0+ TFHelper_0123456789876543210 CW CJ = FalseSym0+ TFHelper_0123456789876543210 CW CK = FalseSym0+ TFHelper_0123456789876543210 CW CL = FalseSym0+ TFHelper_0123456789876543210 CW CM = FalseSym0+ TFHelper_0123456789876543210 CW CN = FalseSym0+ TFHelper_0123456789876543210 CW CO = FalseSym0+ TFHelper_0123456789876543210 CW CP = FalseSym0+ TFHelper_0123456789876543210 CW CQ = FalseSym0+ TFHelper_0123456789876543210 CW CR = FalseSym0+ TFHelper_0123456789876543210 CW CS = FalseSym0+ TFHelper_0123456789876543210 CW CT = FalseSym0+ TFHelper_0123456789876543210 CW CU = FalseSym0+ TFHelper_0123456789876543210 CW CV = FalseSym0+ TFHelper_0123456789876543210 CW CW = TrueSym0+ TFHelper_0123456789876543210 CW CX = FalseSym0+ TFHelper_0123456789876543210 CW CY = FalseSym0+ TFHelper_0123456789876543210 CW CZ = FalseSym0+ TFHelper_0123456789876543210 CX CA = FalseSym0+ TFHelper_0123456789876543210 CX CB = FalseSym0+ TFHelper_0123456789876543210 CX CC = FalseSym0+ TFHelper_0123456789876543210 CX CD = FalseSym0+ TFHelper_0123456789876543210 CX CE = FalseSym0+ TFHelper_0123456789876543210 CX CF = FalseSym0+ TFHelper_0123456789876543210 CX CG = FalseSym0+ TFHelper_0123456789876543210 CX CH = FalseSym0+ TFHelper_0123456789876543210 CX CI = FalseSym0+ TFHelper_0123456789876543210 CX CJ = FalseSym0+ TFHelper_0123456789876543210 CX CK = FalseSym0+ TFHelper_0123456789876543210 CX CL = FalseSym0+ TFHelper_0123456789876543210 CX CM = FalseSym0+ TFHelper_0123456789876543210 CX CN = FalseSym0+ TFHelper_0123456789876543210 CX CO = FalseSym0+ TFHelper_0123456789876543210 CX CP = FalseSym0+ TFHelper_0123456789876543210 CX CQ = FalseSym0+ TFHelper_0123456789876543210 CX CR = FalseSym0+ TFHelper_0123456789876543210 CX CS = FalseSym0+ TFHelper_0123456789876543210 CX CT = FalseSym0+ TFHelper_0123456789876543210 CX CU = FalseSym0+ TFHelper_0123456789876543210 CX CV = FalseSym0+ TFHelper_0123456789876543210 CX CW = FalseSym0+ TFHelper_0123456789876543210 CX CX = TrueSym0+ TFHelper_0123456789876543210 CX CY = FalseSym0+ TFHelper_0123456789876543210 CX CZ = FalseSym0+ TFHelper_0123456789876543210 CY CA = FalseSym0+ TFHelper_0123456789876543210 CY CB = FalseSym0+ TFHelper_0123456789876543210 CY CC = FalseSym0+ TFHelper_0123456789876543210 CY CD = FalseSym0+ TFHelper_0123456789876543210 CY CE = FalseSym0+ TFHelper_0123456789876543210 CY CF = FalseSym0+ TFHelper_0123456789876543210 CY CG = FalseSym0+ TFHelper_0123456789876543210 CY CH = FalseSym0+ TFHelper_0123456789876543210 CY CI = FalseSym0+ TFHelper_0123456789876543210 CY CJ = FalseSym0+ TFHelper_0123456789876543210 CY CK = FalseSym0+ TFHelper_0123456789876543210 CY CL = FalseSym0+ TFHelper_0123456789876543210 CY CM = FalseSym0+ TFHelper_0123456789876543210 CY CN = FalseSym0+ TFHelper_0123456789876543210 CY CO = FalseSym0+ TFHelper_0123456789876543210 CY CP = FalseSym0+ TFHelper_0123456789876543210 CY CQ = FalseSym0+ TFHelper_0123456789876543210 CY CR = FalseSym0+ TFHelper_0123456789876543210 CY CS = FalseSym0+ TFHelper_0123456789876543210 CY CT = FalseSym0+ TFHelper_0123456789876543210 CY CU = FalseSym0+ TFHelper_0123456789876543210 CY CV = FalseSym0+ TFHelper_0123456789876543210 CY CW = FalseSym0+ TFHelper_0123456789876543210 CY CX = FalseSym0+ TFHelper_0123456789876543210 CY CY = TrueSym0+ TFHelper_0123456789876543210 CY CZ = FalseSym0+ TFHelper_0123456789876543210 CZ CA = FalseSym0+ TFHelper_0123456789876543210 CZ CB = FalseSym0+ TFHelper_0123456789876543210 CZ CC = FalseSym0+ TFHelper_0123456789876543210 CZ CD = FalseSym0+ TFHelper_0123456789876543210 CZ CE = FalseSym0+ TFHelper_0123456789876543210 CZ CF = FalseSym0+ TFHelper_0123456789876543210 CZ CG = FalseSym0+ TFHelper_0123456789876543210 CZ CH = FalseSym0+ TFHelper_0123456789876543210 CZ CI = FalseSym0+ TFHelper_0123456789876543210 CZ CJ = FalseSym0+ TFHelper_0123456789876543210 CZ CK = FalseSym0+ TFHelper_0123456789876543210 CZ CL = FalseSym0+ TFHelper_0123456789876543210 CZ CM = FalseSym0+ TFHelper_0123456789876543210 CZ CN = FalseSym0+ TFHelper_0123456789876543210 CZ CO = FalseSym0+ TFHelper_0123456789876543210 CZ CP = FalseSym0+ TFHelper_0123456789876543210 CZ CQ = FalseSym0+ TFHelper_0123456789876543210 CZ CR = FalseSym0+ TFHelper_0123456789876543210 CZ CS = FalseSym0+ TFHelper_0123456789876543210 CZ CT = FalseSym0+ TFHelper_0123456789876543210 CZ CU = FalseSym0+ TFHelper_0123456789876543210 CZ CV = FalseSym0+ TFHelper_0123456789876543210 CZ CW = FalseSym0+ TFHelper_0123456789876543210 CZ CX = FalseSym0+ TFHelper_0123456789876543210 CZ CY = FalseSym0+ TFHelper_0123456789876543210 CZ CZ = TrueSym0+ instance PEq AChar where+ type (==) a a = TFHelper_0123456789876543210 a a+ sLookup ::+ (forall (t :: [AChar]) (t :: Schema).+ Sing t -> Sing t -> Sing (Lookup t t :: U) :: Type)+ sOccurs ::+ (forall (t :: [AChar]) (t :: Schema).+ Sing t -> Sing t -> Sing (Occurs t t :: Bool) :: Type)+ sDisjoint ::+ (forall (t :: Schema) (t :: Schema).+ Sing t -> Sing t -> Sing (Disjoint t t :: Bool) :: Type)+ sAttrNotIn ::+ (forall (t :: Attribute) (t :: Schema).+ Sing t -> Sing t -> Sing (AttrNotIn t t :: Bool) :: Type)+ sAppend ::+ (forall (t :: Schema) (t :: Schema).+ Sing t -> Sing t -> Sing (Append t t :: Schema) :: Type)+ sLookup _ (SSch SNil) = sUndefined+ sLookup+ (sName :: Sing name)+ (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u))+ (sAttrs :: Sing attrs)))+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 name name' u attrs)+ (\cases+ STrue -> sU+ SFalse+ -> applySing+ (applySing (singFun2 @LookupSym0 sLookup) sName)+ (applySing (singFun1 @SchSym0 SSch) sAttrs)))+ (applySing (applySing (singFun2 @(==@#@$) (%==)) sName) sName')+ 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))+ 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)+ 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))+ 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 SingI1 (LookupSym1 :: [AChar] -> (~>) Schema U) where+ liftSing (s :: Sing (d :: [AChar]))+ = singFun1 @(LookupSym1 (d :: [AChar])) (sLookup s)+ 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 SingI1 (OccursSym1 :: [AChar] -> (~>) Schema Bool) where+ liftSing (s :: Sing (d :: [AChar]))+ = singFun1 @(OccursSym1 (d :: [AChar])) (sOccurs s)+ 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 SingI1 (DisjointSym1 :: Schema -> (~>) Schema Bool) where+ liftSing (s :: Sing (d :: Schema))+ = singFun1 @(DisjointSym1 (d :: Schema)) (sDisjoint s)+ 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 SingI1 (AttrNotInSym1 :: Attribute+ -> (~>) Schema Bool) where+ liftSing (s :: Sing (d :: Attribute))+ = singFun1 @(AttrNotInSym1 (d :: Attribute)) (sAttrNotIn s)+ 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))+ instance SingI1 (AppendSym1 :: Schema -> (~>) Schema Schema) where+ liftSing (s :: Sing (d :: Schema))+ = singFun1 @(AppendSym1 (d :: Schema)) (sAppend s)+ data SU :: U -> Type+ where+ SBOOL :: SU (BOOL :: U)+ SSTRING :: SU (STRING :: U)+ SNAT :: SU (NAT :: U)+ SVEC :: forall (n :: U) (n :: Nat).+ (Sing n) -> (Sing n) -> SU (VEC n n :: U)+ type instance Sing @U = SU+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SVEC c c))+ (toSing b :: SomeSing U) (toSing b :: SomeSing Nat)+ data SAChar :: AChar -> Type+ where+ SCA :: SAChar (CA :: AChar)+ SCB :: SAChar (CB :: AChar)+ SCC :: SAChar (CC :: AChar)+ SCD :: SAChar (CD :: AChar)+ SCE :: SAChar (CE :: AChar)+ SCF :: SAChar (CF :: AChar)+ SCG :: SAChar (CG :: AChar)+ SCH :: SAChar (CH :: AChar)+ SCI :: SAChar (CI :: AChar)+ SCJ :: SAChar (CJ :: AChar)+ SCK :: SAChar (CK :: AChar)+ SCL :: SAChar (CL :: AChar)+ SCM :: SAChar (CM :: AChar)+ SCN :: SAChar (CN :: AChar)+ SCO :: SAChar (CO :: AChar)+ SCP :: SAChar (CP :: AChar)+ SCQ :: SAChar (CQ :: AChar)+ SCR :: SAChar (CR :: AChar)+ SCS :: SAChar (CS :: AChar)+ SCT :: SAChar (CT :: AChar)+ SCU :: SAChar (CU :: AChar)+ SCV :: SAChar (CV :: AChar)+ SCW :: SAChar (CW :: AChar)+ SCX :: SAChar (CX :: AChar)+ SCY :: SAChar (CY :: AChar)+ SCZ :: SAChar (CZ :: AChar)+ type instance Sing @AChar = SAChar+ 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 SAttribute :: Attribute -> Type+ where+ SAttr :: forall (n :: [AChar]) (n :: U).+ (Sing n) -> (Sing n) -> SAttribute (Attr n n :: Attribute)+ type instance Sing @Attribute = SAttribute+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SAttr c c))+ (toSing b :: SomeSing [AChar]) (toSing b :: SomeSing U)+ data SSchema :: Schema -> Type+ where+ SSch :: forall (n :: [Attribute]).+ (Sing n) -> SSchema (Sch n :: Schema)+ type instance Sing @Schema = SSchema+ instance SingKind Schema where+ type Demote Schema = Schema+ fromSing (SSch b) = Sch (fromSing b)+ toSing (Sch (b :: Demote [Attribute]))+ = (\cases (SomeSing c) -> SomeSing (SSch c))+ (toSing b :: SomeSing [Attribute])+ 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 (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SVEC (sB_0123456789876543210 :: Sing b_0123456789876543210)+ (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)+ instance (SShow U, SShow Nat) => SShow U where+ 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+ _+ 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 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 U, SDecide Nat) => SDecide U where+ (%~) SBOOL SBOOL = Proved Refl+ (%~) SBOOL SSTRING = Disproved (\case)+ (%~) SBOOL SNAT = Disproved (\case)+ (%~) SBOOL (SVEC _ _) = Disproved (\case)+ (%~) SSTRING SBOOL = Disproved (\case)+ (%~) SSTRING SSTRING = Proved Refl+ (%~) SSTRING SNAT = Disproved (\case)+ (%~) SSTRING (SVEC _ _) = Disproved (\case)+ (%~) SNAT SBOOL = Disproved (\case)+ (%~) SNAT SSTRING = Disproved (\case)+ (%~) SNAT SNAT = Proved Refl+ (%~) SNAT (SVEC _ _) = Disproved (\case)+ (%~) (SVEC _ _) SBOOL = Disproved (\case)+ (%~) (SVEC _ _) SSTRING = Disproved (\case)+ (%~) (SVEC _ _) SNAT = Disproved (\case)+ (%~) (SVEC a a) (SVEC b b)+ = (\cases+ (Proved Refl) (Proved Refl) -> Proved Refl+ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b)+ instance Eq (SU (z :: U)) where+ (==) _ _ = True+ instance (SDecide U, SDecide Nat) =>+ GHC.Internal.Data.Type.Equality.TestEquality (SU :: U+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance (SDecide U, SDecide Nat) =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SU :: U+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance SDecide AChar where+ (%~) SCA SCA = Proved Refl+ (%~) SCA SCB = Disproved (\case)+ (%~) SCA SCC = Disproved (\case)+ (%~) SCA SCD = Disproved (\case)+ (%~) SCA SCE = Disproved (\case)+ (%~) SCA SCF = Disproved (\case)+ (%~) SCA SCG = Disproved (\case)+ (%~) SCA SCH = Disproved (\case)+ (%~) SCA SCI = Disproved (\case)+ (%~) SCA SCJ = Disproved (\case)+ (%~) SCA SCK = Disproved (\case)+ (%~) SCA SCL = Disproved (\case)+ (%~) SCA SCM = Disproved (\case)+ (%~) SCA SCN = Disproved (\case)+ (%~) SCA SCO = Disproved (\case)+ (%~) SCA SCP = Disproved (\case)+ (%~) SCA SCQ = Disproved (\case)+ (%~) SCA SCR = Disproved (\case)+ (%~) SCA SCS = Disproved (\case)+ (%~) SCA SCT = Disproved (\case)+ (%~) SCA SCU = Disproved (\case)+ (%~) SCA SCV = Disproved (\case)+ (%~) SCA SCW = Disproved (\case)+ (%~) SCA SCX = Disproved (\case)+ (%~) SCA SCY = Disproved (\case)+ (%~) SCA SCZ = Disproved (\case)+ (%~) SCB SCA = Disproved (\case)+ (%~) SCB SCB = Proved Refl+ (%~) SCB SCC = Disproved (\case)+ (%~) SCB SCD = Disproved (\case)+ (%~) SCB SCE = Disproved (\case)+ (%~) SCB SCF = Disproved (\case)+ (%~) SCB SCG = Disproved (\case)+ (%~) SCB SCH = Disproved (\case)+ (%~) SCB SCI = Disproved (\case)+ (%~) SCB SCJ = Disproved (\case)+ (%~) SCB SCK = Disproved (\case)+ (%~) SCB SCL = Disproved (\case)+ (%~) SCB SCM = Disproved (\case)+ (%~) SCB SCN = Disproved (\case)+ (%~) SCB SCO = Disproved (\case)+ (%~) SCB SCP = Disproved (\case)+ (%~) SCB SCQ = Disproved (\case)+ (%~) SCB SCR = Disproved (\case)+ (%~) SCB SCS = Disproved (\case)+ (%~) SCB SCT = Disproved (\case)+ (%~) SCB SCU = Disproved (\case)+ (%~) SCB SCV = Disproved (\case)+ (%~) SCB SCW = Disproved (\case)+ (%~) SCB SCX = Disproved (\case)+ (%~) SCB SCY = Disproved (\case)+ (%~) SCB SCZ = Disproved (\case)+ (%~) SCC SCA = Disproved (\case)+ (%~) SCC SCB = Disproved (\case)+ (%~) SCC SCC = Proved Refl+ (%~) SCC SCD = Disproved (\case)+ (%~) SCC SCE = Disproved (\case)+ (%~) SCC SCF = Disproved (\case)+ (%~) SCC SCG = Disproved (\case)+ (%~) SCC SCH = Disproved (\case)+ (%~) SCC SCI = Disproved (\case)+ (%~) SCC SCJ = Disproved (\case)+ (%~) SCC SCK = Disproved (\case)+ (%~) SCC SCL = Disproved (\case)+ (%~) SCC SCM = Disproved (\case)+ (%~) SCC SCN = Disproved (\case)+ (%~) SCC SCO = Disproved (\case)+ (%~) SCC SCP = Disproved (\case)+ (%~) SCC SCQ = Disproved (\case)+ (%~) SCC SCR = Disproved (\case)+ (%~) SCC SCS = Disproved (\case)+ (%~) SCC SCT = Disproved (\case)+ (%~) SCC SCU = Disproved (\case)+ (%~) SCC SCV = Disproved (\case)+ (%~) SCC SCW = Disproved (\case)+ (%~) SCC SCX = Disproved (\case)+ (%~) SCC SCY = Disproved (\case)+ (%~) SCC SCZ = Disproved (\case)+ (%~) SCD SCA = Disproved (\case)+ (%~) SCD SCB = Disproved (\case)+ (%~) SCD SCC = Disproved (\case)+ (%~) SCD SCD = Proved Refl+ (%~) SCD SCE = Disproved (\case)+ (%~) SCD SCF = Disproved (\case)+ (%~) SCD SCG = Disproved (\case)+ (%~) SCD SCH = Disproved (\case)+ (%~) SCD SCI = Disproved (\case)+ (%~) SCD SCJ = Disproved (\case)+ (%~) SCD SCK = Disproved (\case)+ (%~) SCD SCL = Disproved (\case)+ (%~) SCD SCM = Disproved (\case)+ (%~) SCD SCN = Disproved (\case)+ (%~) SCD SCO = Disproved (\case)+ (%~) SCD SCP = Disproved (\case)+ (%~) SCD SCQ = Disproved (\case)+ (%~) SCD SCR = Disproved (\case)+ (%~) SCD SCS = Disproved (\case)+ (%~) SCD SCT = Disproved (\case)+ (%~) SCD SCU = Disproved (\case)+ (%~) SCD SCV = Disproved (\case)+ (%~) SCD SCW = Disproved (\case)+ (%~) SCD SCX = Disproved (\case)+ (%~) SCD SCY = Disproved (\case)+ (%~) SCD SCZ = Disproved (\case)+ (%~) SCE SCA = Disproved (\case)+ (%~) SCE SCB = Disproved (\case)+ (%~) SCE SCC = Disproved (\case)+ (%~) SCE SCD = Disproved (\case)+ (%~) SCE SCE = Proved Refl+ (%~) SCE SCF = Disproved (\case)+ (%~) SCE SCG = Disproved (\case)+ (%~) SCE SCH = Disproved (\case)+ (%~) SCE SCI = Disproved (\case)+ (%~) SCE SCJ = Disproved (\case)+ (%~) SCE SCK = Disproved (\case)+ (%~) SCE SCL = Disproved (\case)+ (%~) SCE SCM = Disproved (\case)+ (%~) SCE SCN = Disproved (\case)+ (%~) SCE SCO = Disproved (\case)+ (%~) SCE SCP = Disproved (\case)+ (%~) SCE SCQ = Disproved (\case)+ (%~) SCE SCR = Disproved (\case)+ (%~) SCE SCS = Disproved (\case)+ (%~) SCE SCT = Disproved (\case)+ (%~) SCE SCU = Disproved (\case)+ (%~) SCE SCV = Disproved (\case)+ (%~) SCE SCW = Disproved (\case)+ (%~) SCE SCX = Disproved (\case)+ (%~) SCE SCY = Disproved (\case)+ (%~) SCE SCZ = Disproved (\case)+ (%~) SCF SCA = Disproved (\case)+ (%~) SCF SCB = Disproved (\case)+ (%~) SCF SCC = Disproved (\case)+ (%~) SCF SCD = Disproved (\case)+ (%~) SCF SCE = Disproved (\case)+ (%~) SCF SCF = Proved Refl+ (%~) SCF SCG = Disproved (\case)+ (%~) SCF SCH = Disproved (\case)+ (%~) SCF SCI = Disproved (\case)+ (%~) SCF SCJ = Disproved (\case)+ (%~) SCF SCK = Disproved (\case)+ (%~) SCF SCL = Disproved (\case)+ (%~) SCF SCM = Disproved (\case)+ (%~) SCF SCN = Disproved (\case)+ (%~) SCF SCO = Disproved (\case)+ (%~) SCF SCP = Disproved (\case)+ (%~) SCF SCQ = Disproved (\case)+ (%~) SCF SCR = Disproved (\case)+ (%~) SCF SCS = Disproved (\case)+ (%~) SCF SCT = Disproved (\case)+ (%~) SCF SCU = Disproved (\case)+ (%~) SCF SCV = Disproved (\case)+ (%~) SCF SCW = Disproved (\case)+ (%~) SCF SCX = Disproved (\case)+ (%~) SCF SCY = Disproved (\case)+ (%~) SCF SCZ = Disproved (\case)+ (%~) SCG SCA = Disproved (\case)+ (%~) SCG SCB = Disproved (\case)+ (%~) SCG SCC = Disproved (\case)+ (%~) SCG SCD = Disproved (\case)+ (%~) SCG SCE = Disproved (\case)+ (%~) SCG SCF = Disproved (\case)+ (%~) SCG SCG = Proved Refl+ (%~) SCG SCH = Disproved (\case)+ (%~) SCG SCI = Disproved (\case)+ (%~) SCG SCJ = Disproved (\case)+ (%~) SCG SCK = Disproved (\case)+ (%~) SCG SCL = Disproved (\case)+ (%~) SCG SCM = Disproved (\case)+ (%~) SCG SCN = Disproved (\case)+ (%~) SCG SCO = Disproved (\case)+ (%~) SCG SCP = Disproved (\case)+ (%~) SCG SCQ = Disproved (\case)+ (%~) SCG SCR = Disproved (\case)+ (%~) SCG SCS = Disproved (\case)+ (%~) SCG SCT = Disproved (\case)+ (%~) SCG SCU = Disproved (\case)+ (%~) SCG SCV = Disproved (\case)+ (%~) SCG SCW = Disproved (\case)+ (%~) SCG SCX = Disproved (\case)+ (%~) SCG SCY = Disproved (\case)+ (%~) SCG SCZ = Disproved (\case)+ (%~) SCH SCA = Disproved (\case)+ (%~) SCH SCB = Disproved (\case)+ (%~) SCH SCC = Disproved (\case)+ (%~) SCH SCD = Disproved (\case)+ (%~) SCH SCE = Disproved (\case)+ (%~) SCH SCF = Disproved (\case)+ (%~) SCH SCG = Disproved (\case)+ (%~) SCH SCH = Proved Refl+ (%~) SCH SCI = Disproved (\case)+ (%~) SCH SCJ = Disproved (\case)+ (%~) SCH SCK = Disproved (\case)+ (%~) SCH SCL = Disproved (\case)+ (%~) SCH SCM = Disproved (\case)+ (%~) SCH SCN = Disproved (\case)+ (%~) SCH SCO = Disproved (\case)+ (%~) SCH SCP = Disproved (\case)+ (%~) SCH SCQ = Disproved (\case)+ (%~) SCH SCR = Disproved (\case)+ (%~) SCH SCS = Disproved (\case)+ (%~) SCH SCT = Disproved (\case)+ (%~) SCH SCU = Disproved (\case)+ (%~) SCH SCV = Disproved (\case)+ (%~) SCH SCW = Disproved (\case)+ (%~) SCH SCX = Disproved (\case)+ (%~) SCH SCY = Disproved (\case)+ (%~) SCH SCZ = Disproved (\case)+ (%~) SCI SCA = Disproved (\case)+ (%~) SCI SCB = Disproved (\case)+ (%~) SCI SCC = Disproved (\case)+ (%~) SCI SCD = Disproved (\case)+ (%~) SCI SCE = Disproved (\case)+ (%~) SCI SCF = Disproved (\case)+ (%~) SCI SCG = Disproved (\case)+ (%~) SCI SCH = Disproved (\case)+ (%~) SCI SCI = Proved Refl+ (%~) SCI SCJ = Disproved (\case)+ (%~) SCI SCK = Disproved (\case)+ (%~) SCI SCL = Disproved (\case)+ (%~) SCI SCM = Disproved (\case)+ (%~) SCI SCN = Disproved (\case)+ (%~) SCI SCO = Disproved (\case)+ (%~) SCI SCP = Disproved (\case)+ (%~) SCI SCQ = Disproved (\case)+ (%~) SCI SCR = Disproved (\case)+ (%~) SCI SCS = Disproved (\case)+ (%~) SCI SCT = Disproved (\case)+ (%~) SCI SCU = Disproved (\case)+ (%~) SCI SCV = Disproved (\case)+ (%~) SCI SCW = Disproved (\case)+ (%~) SCI SCX = Disproved (\case)+ (%~) SCI SCY = Disproved (\case)+ (%~) SCI SCZ = Disproved (\case)+ (%~) SCJ SCA = Disproved (\case)+ (%~) SCJ SCB = Disproved (\case)+ (%~) SCJ SCC = Disproved (\case)+ (%~) SCJ SCD = Disproved (\case)+ (%~) SCJ SCE = Disproved (\case)+ (%~) SCJ SCF = Disproved (\case)+ (%~) SCJ SCG = Disproved (\case)+ (%~) SCJ SCH = Disproved (\case)+ (%~) SCJ SCI = Disproved (\case)+ (%~) SCJ SCJ = Proved Refl+ (%~) SCJ SCK = Disproved (\case)+ (%~) SCJ SCL = Disproved (\case)+ (%~) SCJ SCM = Disproved (\case)+ (%~) SCJ SCN = Disproved (\case)+ (%~) SCJ SCO = Disproved (\case)+ (%~) SCJ SCP = Disproved (\case)+ (%~) SCJ SCQ = Disproved (\case)+ (%~) SCJ SCR = Disproved (\case)+ (%~) SCJ SCS = Disproved (\case)+ (%~) SCJ SCT = Disproved (\case)+ (%~) SCJ SCU = Disproved (\case)+ (%~) SCJ SCV = Disproved (\case)+ (%~) SCJ SCW = Disproved (\case)+ (%~) SCJ SCX = Disproved (\case)+ (%~) SCJ SCY = Disproved (\case)+ (%~) SCJ SCZ = Disproved (\case)+ (%~) SCK SCA = Disproved (\case)+ (%~) SCK SCB = Disproved (\case)+ (%~) SCK SCC = Disproved (\case)+ (%~) SCK SCD = Disproved (\case)+ (%~) SCK SCE = Disproved (\case)+ (%~) SCK SCF = Disproved (\case)+ (%~) SCK SCG = Disproved (\case)+ (%~) SCK SCH = Disproved (\case)+ (%~) SCK SCI = Disproved (\case)+ (%~) SCK SCJ = Disproved (\case)+ (%~) SCK SCK = Proved Refl+ (%~) SCK SCL = Disproved (\case)+ (%~) SCK SCM = Disproved (\case)+ (%~) SCK SCN = Disproved (\case)+ (%~) SCK SCO = Disproved (\case)+ (%~) SCK SCP = Disproved (\case)+ (%~) SCK SCQ = Disproved (\case)+ (%~) SCK SCR = Disproved (\case)+ (%~) SCK SCS = Disproved (\case)+ (%~) SCK SCT = Disproved (\case)+ (%~) SCK SCU = Disproved (\case)+ (%~) SCK SCV = Disproved (\case)+ (%~) SCK SCW = Disproved (\case)+ (%~) SCK SCX = Disproved (\case)+ (%~) SCK SCY = Disproved (\case)+ (%~) SCK SCZ = Disproved (\case)+ (%~) SCL SCA = Disproved (\case)+ (%~) SCL SCB = Disproved (\case)+ (%~) SCL SCC = Disproved (\case)+ (%~) SCL SCD = Disproved (\case)+ (%~) SCL SCE = Disproved (\case)+ (%~) SCL SCF = Disproved (\case)+ (%~) SCL SCG = Disproved (\case)+ (%~) SCL SCH = Disproved (\case)+ (%~) SCL SCI = Disproved (\case)+ (%~) SCL SCJ = Disproved (\case)+ (%~) SCL SCK = Disproved (\case)+ (%~) SCL SCL = Proved Refl+ (%~) SCL SCM = Disproved (\case)+ (%~) SCL SCN = Disproved (\case)+ (%~) SCL SCO = Disproved (\case)+ (%~) SCL SCP = Disproved (\case)+ (%~) SCL SCQ = Disproved (\case)+ (%~) SCL SCR = Disproved (\case)+ (%~) SCL SCS = Disproved (\case)+ (%~) SCL SCT = Disproved (\case)+ (%~) SCL SCU = Disproved (\case)+ (%~) SCL SCV = Disproved (\case)+ (%~) SCL SCW = Disproved (\case)+ (%~) SCL SCX = Disproved (\case)+ (%~) SCL SCY = Disproved (\case)+ (%~) SCL SCZ = Disproved (\case)+ (%~) SCM SCA = Disproved (\case)+ (%~) SCM SCB = Disproved (\case)+ (%~) SCM SCC = Disproved (\case)+ (%~) SCM SCD = Disproved (\case)+ (%~) SCM SCE = Disproved (\case)+ (%~) SCM SCF = Disproved (\case)+ (%~) SCM SCG = Disproved (\case)+ (%~) SCM SCH = Disproved (\case)+ (%~) SCM SCI = Disproved (\case)+ (%~) SCM SCJ = Disproved (\case)+ (%~) SCM SCK = Disproved (\case)+ (%~) SCM SCL = Disproved (\case)+ (%~) SCM SCM = Proved Refl+ (%~) SCM SCN = Disproved (\case)+ (%~) SCM SCO = Disproved (\case)+ (%~) SCM SCP = Disproved (\case)+ (%~) SCM SCQ = Disproved (\case)+ (%~) SCM SCR = Disproved (\case)+ (%~) SCM SCS = Disproved (\case)+ (%~) SCM SCT = Disproved (\case)+ (%~) SCM SCU = Disproved (\case)+ (%~) SCM SCV = Disproved (\case)+ (%~) SCM SCW = Disproved (\case)+ (%~) SCM SCX = Disproved (\case)+ (%~) SCM SCY = Disproved (\case)+ (%~) SCM SCZ = Disproved (\case)+ (%~) SCN SCA = Disproved (\case)+ (%~) SCN SCB = Disproved (\case)+ (%~) SCN SCC = Disproved (\case)+ (%~) SCN SCD = Disproved (\case)+ (%~) SCN SCE = Disproved (\case)+ (%~) SCN SCF = Disproved (\case)+ (%~) SCN SCG = Disproved (\case)+ (%~) SCN SCH = Disproved (\case)+ (%~) SCN SCI = Disproved (\case)+ (%~) SCN SCJ = Disproved (\case)+ (%~) SCN SCK = Disproved (\case)+ (%~) SCN SCL = Disproved (\case)+ (%~) SCN SCM = Disproved (\case)+ (%~) SCN SCN = Proved Refl+ (%~) SCN SCO = Disproved (\case)+ (%~) SCN SCP = Disproved (\case)+ (%~) SCN SCQ = Disproved (\case)+ (%~) SCN SCR = Disproved (\case)+ (%~) SCN SCS = Disproved (\case)+ (%~) SCN SCT = Disproved (\case)+ (%~) SCN SCU = Disproved (\case)+ (%~) SCN SCV = Disproved (\case)+ (%~) SCN SCW = Disproved (\case)+ (%~) SCN SCX = Disproved (\case)+ (%~) SCN SCY = Disproved (\case)+ (%~) SCN SCZ = Disproved (\case)+ (%~) SCO SCA = Disproved (\case)+ (%~) SCO SCB = Disproved (\case)+ (%~) SCO SCC = Disproved (\case)+ (%~) SCO SCD = Disproved (\case)+ (%~) SCO SCE = Disproved (\case)+ (%~) SCO SCF = Disproved (\case)+ (%~) SCO SCG = Disproved (\case)+ (%~) SCO SCH = Disproved (\case)+ (%~) SCO SCI = Disproved (\case)+ (%~) SCO SCJ = Disproved (\case)+ (%~) SCO SCK = Disproved (\case)+ (%~) SCO SCL = Disproved (\case)+ (%~) SCO SCM = Disproved (\case)+ (%~) SCO SCN = Disproved (\case)+ (%~) SCO SCO = Proved Refl+ (%~) SCO SCP = Disproved (\case)+ (%~) SCO SCQ = Disproved (\case)+ (%~) SCO SCR = Disproved (\case)+ (%~) SCO SCS = Disproved (\case)+ (%~) SCO SCT = Disproved (\case)+ (%~) SCO SCU = Disproved (\case)+ (%~) SCO SCV = Disproved (\case)+ (%~) SCO SCW = Disproved (\case)+ (%~) SCO SCX = Disproved (\case)+ (%~) SCO SCY = Disproved (\case)+ (%~) SCO SCZ = Disproved (\case)+ (%~) SCP SCA = Disproved (\case)+ (%~) SCP SCB = Disproved (\case)+ (%~) SCP SCC = Disproved (\case)+ (%~) SCP SCD = Disproved (\case)+ (%~) SCP SCE = Disproved (\case)+ (%~) SCP SCF = Disproved (\case)+ (%~) SCP SCG = Disproved (\case)+ (%~) SCP SCH = Disproved (\case)+ (%~) SCP SCI = Disproved (\case)+ (%~) SCP SCJ = Disproved (\case)+ (%~) SCP SCK = Disproved (\case)+ (%~) SCP SCL = Disproved (\case)+ (%~) SCP SCM = Disproved (\case)+ (%~) SCP SCN = Disproved (\case)+ (%~) SCP SCO = Disproved (\case)+ (%~) SCP SCP = Proved Refl+ (%~) SCP SCQ = Disproved (\case)+ (%~) SCP SCR = Disproved (\case)+ (%~) SCP SCS = Disproved (\case)+ (%~) SCP SCT = Disproved (\case)+ (%~) SCP SCU = Disproved (\case)+ (%~) SCP SCV = Disproved (\case)+ (%~) SCP SCW = Disproved (\case)+ (%~) SCP SCX = Disproved (\case)+ (%~) SCP SCY = Disproved (\case)+ (%~) SCP SCZ = Disproved (\case)+ (%~) SCQ SCA = Disproved (\case)+ (%~) SCQ SCB = Disproved (\case)+ (%~) SCQ SCC = Disproved (\case)+ (%~) SCQ SCD = Disproved (\case)+ (%~) SCQ SCE = Disproved (\case)+ (%~) SCQ SCF = Disproved (\case)+ (%~) SCQ SCG = Disproved (\case)+ (%~) SCQ SCH = Disproved (\case)+ (%~) SCQ SCI = Disproved (\case)+ (%~) SCQ SCJ = Disproved (\case)+ (%~) SCQ SCK = Disproved (\case)+ (%~) SCQ SCL = Disproved (\case)+ (%~) SCQ SCM = Disproved (\case)+ (%~) SCQ SCN = Disproved (\case)+ (%~) SCQ SCO = Disproved (\case)+ (%~) SCQ SCP = Disproved (\case)+ (%~) SCQ SCQ = Proved Refl+ (%~) SCQ SCR = Disproved (\case)+ (%~) SCQ SCS = Disproved (\case)+ (%~) SCQ SCT = Disproved (\case)+ (%~) SCQ SCU = Disproved (\case)+ (%~) SCQ SCV = Disproved (\case)+ (%~) SCQ SCW = Disproved (\case)+ (%~) SCQ SCX = Disproved (\case)+ (%~) SCQ SCY = Disproved (\case)+ (%~) SCQ SCZ = Disproved (\case)+ (%~) SCR SCA = Disproved (\case)+ (%~) SCR SCB = Disproved (\case)+ (%~) SCR SCC = Disproved (\case)+ (%~) SCR SCD = Disproved (\case)+ (%~) SCR SCE = Disproved (\case)+ (%~) SCR SCF = Disproved (\case)+ (%~) SCR SCG = Disproved (\case)+ (%~) SCR SCH = Disproved (\case)+ (%~) SCR SCI = Disproved (\case)+ (%~) SCR SCJ = Disproved (\case)+ (%~) SCR SCK = Disproved (\case)+ (%~) SCR SCL = Disproved (\case)+ (%~) SCR SCM = Disproved (\case)+ (%~) SCR SCN = Disproved (\case)+ (%~) SCR SCO = Disproved (\case)+ (%~) SCR SCP = Disproved (\case)+ (%~) SCR SCQ = Disproved (\case)+ (%~) SCR SCR = Proved Refl+ (%~) SCR SCS = Disproved (\case)+ (%~) SCR SCT = Disproved (\case)+ (%~) SCR SCU = Disproved (\case)+ (%~) SCR SCV = Disproved (\case)+ (%~) SCR SCW = Disproved (\case)+ (%~) SCR SCX = Disproved (\case)+ (%~) SCR SCY = Disproved (\case)+ (%~) SCR SCZ = Disproved (\case)+ (%~) SCS SCA = Disproved (\case)+ (%~) SCS SCB = Disproved (\case)+ (%~) SCS SCC = Disproved (\case)+ (%~) SCS SCD = Disproved (\case)+ (%~) SCS SCE = Disproved (\case)+ (%~) SCS SCF = Disproved (\case)+ (%~) SCS SCG = Disproved (\case)+ (%~) SCS SCH = Disproved (\case)+ (%~) SCS SCI = Disproved (\case)+ (%~) SCS SCJ = Disproved (\case)+ (%~) SCS SCK = Disproved (\case)+ (%~) SCS SCL = Disproved (\case)+ (%~) SCS SCM = Disproved (\case)+ (%~) SCS SCN = Disproved (\case)+ (%~) SCS SCO = Disproved (\case)+ (%~) SCS SCP = Disproved (\case)+ (%~) SCS SCQ = Disproved (\case)+ (%~) SCS SCR = Disproved (\case)+ (%~) SCS SCS = Proved Refl+ (%~) SCS SCT = Disproved (\case)+ (%~) SCS SCU = Disproved (\case)+ (%~) SCS SCV = Disproved (\case)+ (%~) SCS SCW = Disproved (\case)+ (%~) SCS SCX = Disproved (\case)+ (%~) SCS SCY = Disproved (\case)+ (%~) SCS SCZ = Disproved (\case)+ (%~) SCT SCA = Disproved (\case)+ (%~) SCT SCB = Disproved (\case)+ (%~) SCT SCC = Disproved (\case)+ (%~) SCT SCD = Disproved (\case)+ (%~) SCT SCE = Disproved (\case)+ (%~) SCT SCF = Disproved (\case)+ (%~) SCT SCG = Disproved (\case)+ (%~) SCT SCH = Disproved (\case)+ (%~) SCT SCI = Disproved (\case)+ (%~) SCT SCJ = Disproved (\case)+ (%~) SCT SCK = Disproved (\case)+ (%~) SCT SCL = Disproved (\case)+ (%~) SCT SCM = Disproved (\case)+ (%~) SCT SCN = Disproved (\case)+ (%~) SCT SCO = Disproved (\case)+ (%~) SCT SCP = Disproved (\case)+ (%~) SCT SCQ = Disproved (\case)+ (%~) SCT SCR = Disproved (\case)+ (%~) SCT SCS = Disproved (\case)+ (%~) SCT SCT = Proved Refl+ (%~) SCT SCU = Disproved (\case)+ (%~) SCT SCV = Disproved (\case)+ (%~) SCT SCW = Disproved (\case)+ (%~) SCT SCX = Disproved (\case)+ (%~) SCT SCY = Disproved (\case)+ (%~) SCT SCZ = Disproved (\case)+ (%~) SCU SCA = Disproved (\case)+ (%~) SCU SCB = Disproved (\case)+ (%~) SCU SCC = Disproved (\case)+ (%~) SCU SCD = Disproved (\case)+ (%~) SCU SCE = Disproved (\case)+ (%~) SCU SCF = Disproved (\case)+ (%~) SCU SCG = Disproved (\case)+ (%~) SCU SCH = Disproved (\case)+ (%~) SCU SCI = Disproved (\case)+ (%~) SCU SCJ = Disproved (\case)+ (%~) SCU SCK = Disproved (\case)+ (%~) SCU SCL = Disproved (\case)+ (%~) SCU SCM = Disproved (\case)+ (%~) SCU SCN = Disproved (\case)+ (%~) SCU SCO = Disproved (\case)+ (%~) SCU SCP = Disproved (\case)+ (%~) SCU SCQ = Disproved (\case)+ (%~) SCU SCR = Disproved (\case)+ (%~) SCU SCS = Disproved (\case)+ (%~) SCU SCT = Disproved (\case)+ (%~) SCU SCU = Proved Refl+ (%~) SCU SCV = Disproved (\case)+ (%~) SCU SCW = Disproved (\case)+ (%~) SCU SCX = Disproved (\case)+ (%~) SCU SCY = Disproved (\case)+ (%~) SCU SCZ = Disproved (\case)+ (%~) SCV SCA = Disproved (\case)+ (%~) SCV SCB = Disproved (\case)+ (%~) SCV SCC = Disproved (\case)+ (%~) SCV SCD = Disproved (\case)+ (%~) SCV SCE = Disproved (\case)+ (%~) SCV SCF = Disproved (\case)+ (%~) SCV SCG = Disproved (\case)+ (%~) SCV SCH = Disproved (\case)+ (%~) SCV SCI = Disproved (\case)+ (%~) SCV SCJ = Disproved (\case)+ (%~) SCV SCK = Disproved (\case)+ (%~) SCV SCL = Disproved (\case)+ (%~) SCV SCM = Disproved (\case)+ (%~) SCV SCN = Disproved (\case)+ (%~) SCV SCO = Disproved (\case)+ (%~) SCV SCP = Disproved (\case)+ (%~) SCV SCQ = Disproved (\case)+ (%~) SCV SCR = Disproved (\case)+ (%~) SCV SCS = Disproved (\case)+ (%~) SCV SCT = Disproved (\case)+ (%~) SCV SCU = Disproved (\case)+ (%~) SCV SCV = Proved Refl+ (%~) SCV SCW = Disproved (\case)+ (%~) SCV SCX = Disproved (\case)+ (%~) SCV SCY = Disproved (\case)+ (%~) SCV SCZ = Disproved (\case)+ (%~) SCW SCA = Disproved (\case)+ (%~) SCW SCB = Disproved (\case)+ (%~) SCW SCC = Disproved (\case)+ (%~) SCW SCD = Disproved (\case)+ (%~) SCW SCE = Disproved (\case)+ (%~) SCW SCF = Disproved (\case)+ (%~) SCW SCG = Disproved (\case)+ (%~) SCW SCH = Disproved (\case)+ (%~) SCW SCI = Disproved (\case)+ (%~) SCW SCJ = Disproved (\case)+ (%~) SCW SCK = Disproved (\case)+ (%~) SCW SCL = Disproved (\case)+ (%~) SCW SCM = Disproved (\case)+ (%~) SCW SCN = Disproved (\case)+ (%~) SCW SCO = Disproved (\case)+ (%~) SCW SCP = Disproved (\case)+ (%~) SCW SCQ = Disproved (\case)+ (%~) SCW SCR = Disproved (\case)+ (%~) SCW SCS = Disproved (\case)+ (%~) SCW SCT = Disproved (\case)+ (%~) SCW SCU = Disproved (\case)+ (%~) SCW SCV = Disproved (\case)+ (%~) SCW SCW = Proved Refl+ (%~) SCW SCX = Disproved (\case)+ (%~) SCW SCY = Disproved (\case)+ (%~) SCW SCZ = Disproved (\case)+ (%~) SCX SCA = Disproved (\case)+ (%~) SCX SCB = Disproved (\case)+ (%~) SCX SCC = Disproved (\case)+ (%~) SCX SCD = Disproved (\case)+ (%~) SCX SCE = Disproved (\case)+ (%~) SCX SCF = Disproved (\case)+ (%~) SCX SCG = Disproved (\case)+ (%~) SCX SCH = Disproved (\case)+ (%~) SCX SCI = Disproved (\case)+ (%~) SCX SCJ = Disproved (\case)+ (%~) SCX SCK = Disproved (\case)+ (%~) SCX SCL = Disproved (\case)+ (%~) SCX SCM = Disproved (\case)+ (%~) SCX SCN = Disproved (\case)+ (%~) SCX SCO = Disproved (\case)+ (%~) SCX SCP = Disproved (\case)+ (%~) SCX SCQ = Disproved (\case)+ (%~) SCX SCR = Disproved (\case)+ (%~) SCX SCS = Disproved (\case)+ (%~) SCX SCT = Disproved (\case)+ (%~) SCX SCU = Disproved (\case)+ (%~) SCX SCV = Disproved (\case)+ (%~) SCX SCW = Disproved (\case)+ (%~) SCX SCX = Proved Refl+ (%~) SCX SCY = Disproved (\case)+ (%~) SCX SCZ = Disproved (\case)+ (%~) SCY SCA = Disproved (\case)+ (%~) SCY SCB = Disproved (\case)+ (%~) SCY SCC = Disproved (\case)+ (%~) SCY SCD = Disproved (\case)+ (%~) SCY SCE = Disproved (\case)+ (%~) SCY SCF = Disproved (\case)+ (%~) SCY SCG = Disproved (\case)+ (%~) SCY SCH = Disproved (\case)+ (%~) SCY SCI = Disproved (\case)+ (%~) SCY SCJ = Disproved (\case)+ (%~) SCY SCK = Disproved (\case)+ (%~) SCY SCL = Disproved (\case)+ (%~) SCY SCM = Disproved (\case)+ (%~) SCY SCN = Disproved (\case)+ (%~) SCY SCO = Disproved (\case)+ (%~) SCY SCP = Disproved (\case)+ (%~) SCY SCQ = Disproved (\case)+ (%~) SCY SCR = Disproved (\case)+ (%~) SCY SCS = Disproved (\case)+ (%~) SCY SCT = Disproved (\case)+ (%~) SCY SCU = Disproved (\case)+ (%~) SCY SCV = Disproved (\case)+ (%~) SCY SCW = Disproved (\case)+ (%~) SCY SCX = Disproved (\case)+ (%~) SCY SCY = Proved Refl+ (%~) SCY SCZ = Disproved (\case)+ (%~) SCZ SCA = Disproved (\case)+ (%~) SCZ SCB = Disproved (\case)+ (%~) SCZ SCC = Disproved (\case)+ (%~) SCZ SCD = Disproved (\case)+ (%~) SCZ SCE = Disproved (\case)+ (%~) SCZ SCF = Disproved (\case)+ (%~) SCZ SCG = Disproved (\case)+ (%~) SCZ SCH = Disproved (\case)+ (%~) SCZ SCI = Disproved (\case)+ (%~) SCZ SCJ = Disproved (\case)+ (%~) SCZ SCK = Disproved (\case)+ (%~) SCZ SCL = Disproved (\case)+ (%~) SCZ SCM = Disproved (\case)+ (%~) SCZ SCN = Disproved (\case)+ (%~) SCZ SCO = Disproved (\case)+ (%~) SCZ SCP = Disproved (\case)+ (%~) SCZ SCQ = Disproved (\case)+ (%~) SCZ SCR = Disproved (\case)+ (%~) SCZ SCS = Disproved (\case)+ (%~) SCZ SCT = Disproved (\case)+ (%~) SCZ SCU = Disproved (\case)+ (%~) SCZ SCV = Disproved (\case)+ (%~) SCZ SCW = Disproved (\case)+ (%~) SCZ SCX = Disproved (\case)+ (%~) SCZ SCY = Disproved (\case)+ (%~) SCZ SCZ = Proved Refl+ instance Eq (SAChar (z :: AChar)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (SAChar :: AChar+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (SAChar :: AChar+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ deriving instance (Data.Singletons.ShowSing.ShowSing U,+ Data.Singletons.ShowSing.ShowSing Nat) =>+ Show (SU (z :: U))+ deriving instance Show (SAChar (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 n => SingI1 (VEC (n :: U)) where+ liftSing = SVEC sing+ instance SingI2 VEC where+ liftSing2 = SVEC+ instance SingI (VECSym0 :: (~>) U ((~>) Nat U)) where+ sing = singFun2 @VECSym0 SVEC+ instance SingI d => SingI (VECSym1 (d :: U) :: (~>) Nat U) where+ sing = singFun1 @(VECSym1 (d :: U)) (SVEC (sing @d))+ instance SingI1 (VECSym1 :: U -> (~>) Nat U) where+ liftSing (s :: Sing (d :: U))+ = singFun1 @(VECSym1 (d :: U)) (SVEC s)+ instance SingI CA where+ sing = SCA+ instance SingI CB where+ sing = SCB+ instance SingI CC where+ sing = SCC+ instance SingI CD where+ sing = SCD+ instance SingI CE where+ sing = SCE+ instance SingI CF where+ sing = SCF+ instance SingI CG where+ sing = SCG+ instance SingI CH where+ sing = SCH+ instance SingI CI where+ sing = SCI+ instance SingI CJ where+ sing = SCJ+ instance SingI CK where+ sing = SCK+ instance SingI CL where+ sing = SCL+ instance SingI CM where+ sing = SCM+ instance SingI CN where+ sing = SCN+ instance SingI CO where+ sing = SCO+ instance SingI CP where+ sing = SCP+ instance SingI CQ where+ sing = SCQ+ instance SingI CR where+ sing = SCR+ instance SingI CS where+ sing = SCS+ instance SingI CT where+ sing = SCT+ instance SingI CU where+ sing = SCU+ instance SingI CV where+ sing = SCV+ instance SingI CW where+ sing = SCW+ instance SingI CX where+ sing = SCX+ instance SingI CY where+ sing = SCY+ instance SingI CZ where+ sing = SCZ+ instance (SingI n, SingI n) =>+ SingI (Attr (n :: [AChar]) (n :: U)) where+ sing = SAttr sing sing+ instance SingI n => SingI1 (Attr (n :: [AChar])) where+ liftSing = SAttr sing+ instance SingI2 Attr where+ liftSing2 = SAttr+ instance SingI (AttrSym0 :: (~>) [AChar] ((~>) U Attribute)) where+ sing = singFun2 @AttrSym0 SAttr+ instance SingI d =>+ SingI (AttrSym1 (d :: [AChar]) :: (~>) U Attribute) where+ sing = singFun1 @(AttrSym1 (d :: [AChar])) (SAttr (sing @d))+ instance SingI1 (AttrSym1 :: [AChar] -> (~>) U Attribute) where+ liftSing (s :: Sing (d :: [AChar]))+ = singFun1 @(AttrSym1 (d :: [AChar])) (SAttr s)+ instance SingI n => SingI (Sch (n :: [Attribute])) where+ sing = SSch sing+ instance SingI1 Sch where+ liftSing = SSch+ instance SingI (SchSym0 :: (~>) [Attribute] Schema) where+ sing = singFun1 @SchSym0 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 |]+ ======>+ (\cases+ (EmptyRow _) -> changeId ((++) n (getId r)) r+ (ConsRow _ _) -> changeId ((++) n (getId r)) r)+ r
tests/compile-and-dump/GradingClient/Database.hs view
@@ -1,545 +1,545 @@-{- 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/ - --} - --- 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 Control.Monad -import Control.Monad.Except ( throwError ) -import Data.Kind (Type) -import qualified Data.List as List -import Data.Singletons.Base.TH -import Prelude hiding ( tail, id ) -import Prelude.Singletons hiding ( Lookup, sLookup, LookupSym0, LookupSym1, LookupSym2 ) -import Text.Show.Singletons - -$(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 $ List.unionBy eqRow rowsa rowsb -query (Diff ra rb) = do - rowsa <- query ra - rowsb <- query rb - return $ List.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 +{- 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/++-}++-- 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 Control.Monad+import Control.Monad.Except ( throwError )+import Data.Kind (Type)+import qualified Data.List as List+import Data.Singletons.Base.TH+import Prelude hiding ( tail, id )+import Prelude.Singletons hiding ( Lookup, sLookup, LookupSym0, LookupSym1, LookupSym2 )+import Text.Show.Singletons++$(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 ->+ case readsPrec 0 sh of+ [] ->+ throwError $ "No parse of " ++ sh ++ " as a " +++ (show (fromSing u))+ result:_ ->+ let item = fst result 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 $ List.unionBy eqRow rowsa rowsb+query (Diff ra rb) = do+ rowsa <- query ra+ rowsb <- query rb+ return $ List.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.golden view
@@ -1,169 +1,169 @@-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 NamesSym0 :: Schema - type family NamesSym0 :: Schema where - NamesSym0 = Names - type GradingSchemaSym0 :: Schema - type family GradingSchemaSym0 :: Schema where - GradingSchemaSym0 = GradingSchema - type MajorNameSym0 :: [AChar] - type family MajorNameSym0 :: [AChar] where - MajorNameSym0 = MajorName - type GradeNameSym0 :: [AChar] - type family GradeNameSym0 :: [AChar] where - GradeNameSym0 = GradeName - type YearNameSym0 :: [AChar] - type family YearNameSym0 :: [AChar] where - YearNameSym0 = YearName - type FirstNameSym0 :: [AChar] - type family FirstNameSym0 :: [AChar] where - FirstNameSym0 = FirstName - type LastNameSym0 :: [AChar] - type family LastNameSym0 :: [AChar] where - LastNameSym0 = LastName - type Names :: Schema - type family Names :: Schema where - Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) NilSym0)) - type GradingSchema :: Schema - 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)) NilSym0))))) - type MajorName :: [AChar] - type family MajorName :: [AChar] where - MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) NilSym0)))) - type GradeName :: [AChar] - type family GradeName :: [AChar] where - GradeName = Apply (Apply (:@#@$) CGSym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CDSym0) (Apply (Apply (:@#@$) CESym0) NilSym0)))) - type YearName :: [AChar] - type family YearName :: [AChar] where - YearName = Apply (Apply (:@#@$) CYSym0) (Apply (Apply (:@#@$) CESym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CRSym0) NilSym0))) - type FirstName :: [AChar] - type family FirstName :: [AChar] where - FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) NilSym0)))) - type LastName :: [AChar] - type family LastName :: [AChar] where - LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) NilSym0))) - sNames :: (Sing (NamesSym0 :: Schema) :: Type) - sGradingSchema :: (Sing (GradingSchemaSym0 :: Schema) :: Type) - sMajorName :: (Sing (MajorNameSym0 :: [AChar]) :: Type) - sGradeName :: (Sing (GradeNameSym0 :: [AChar]) :: Type) - sYearName :: (Sing (YearNameSym0 :: [AChar]) :: Type) - sFirstName :: (Sing (FirstNameSym0 :: [AChar]) :: Type) - sLastName :: (Sing (LastNameSym0 :: [AChar]) :: Type) - 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)) - 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))))) - 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))) +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 NamesSym0 :: Schema+ type family NamesSym0 :: Schema where+ NamesSym0 = Names+ type GradingSchemaSym0 :: Schema+ type family GradingSchemaSym0 :: Schema where+ GradingSchemaSym0 = GradingSchema+ type MajorNameSym0 :: [AChar]+ type family MajorNameSym0 :: [AChar] where+ MajorNameSym0 = MajorName+ type GradeNameSym0 :: [AChar]+ type family GradeNameSym0 :: [AChar] where+ GradeNameSym0 = GradeName+ type YearNameSym0 :: [AChar]+ type family YearNameSym0 :: [AChar] where+ YearNameSym0 = YearName+ type FirstNameSym0 :: [AChar]+ type family FirstNameSym0 :: [AChar] where+ FirstNameSym0 = FirstName+ type LastNameSym0 :: [AChar]+ type family LastNameSym0 :: [AChar] where+ LastNameSym0 = LastName+ type Names :: Schema+ type family Names :: Schema where+ Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) NilSym0))+ type GradingSchema :: Schema+ 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)) NilSym0)))))+ type MajorName :: [AChar]+ type family MajorName :: [AChar] where+ MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) NilSym0))))+ type GradeName :: [AChar]+ type family GradeName :: [AChar] where+ GradeName = Apply (Apply (:@#@$) CGSym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CDSym0) (Apply (Apply (:@#@$) CESym0) NilSym0))))+ type YearName :: [AChar]+ type family YearName :: [AChar] where+ YearName = Apply (Apply (:@#@$) CYSym0) (Apply (Apply (:@#@$) CESym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CRSym0) NilSym0)))+ type FirstName :: [AChar]+ type family FirstName :: [AChar] where+ FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) NilSym0))))+ type LastName :: [AChar]+ type family LastName :: [AChar] where+ LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) NilSym0)))+ sNames :: (Sing (Names :: Schema) :: Type)+ sGradingSchema :: (Sing (GradingSchema :: Schema) :: Type)+ sMajorName :: (Sing (MajorName :: [AChar]) :: Type)+ sGradeName :: (Sing (GradeName :: [AChar]) :: Type)+ sYearName :: (Sing (YearName :: [AChar]) :: Type)+ sFirstName :: (Sing (FirstName :: [AChar]) :: Type)+ sLastName :: (Sing (LastName :: [AChar]) :: Type)+ 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))+ 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)))))+ 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)))
tests/compile-and-dump/GradingClient/Main.hs view
@@ -1,52 +1,52 @@-{- 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. - --} - -module Main where - -import Data.List.Singletons -import Data.Singletons -import Data.Singletons.TH -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" +{- 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.++-}++module Main where++import Data.List.Singletons+import Data.Singletons+import Data.Singletons.TH+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.golden view
@@ -1,224 +1,192 @@-InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations - singletons [d| data Nat = Zero | Succ Nat |] - ======> - data Nat = Zero | Succ Nat - type ZeroSym0 :: Nat - type family ZeroSym0 :: Nat where - ZeroSym0 = Zero - type SuccSym0 :: (~>) Nat Nat - data SuccSym0 :: (~>) Nat Nat - where - SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0 a0123456789876543210 - type instance Apply SuccSym0 a0123456789876543210 = Succ a0123456789876543210 - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings = snd ((,) SuccSym0KindInference ()) - type SuccSym1 :: Nat -> Nat - type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where - SuccSym1 a0123456789876543210 = Succ a0123456789876543210 - data SNat :: Nat -> Type - where - SZero :: SNat (Zero :: Nat) - SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat) - type instance Sing @Nat = SNat - 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 SingI1 Succ where - liftSing = SSucc - instance SingI (SuccSym0 :: (~>) Nat Nat) where - sing = singFun1 @SuccSym0 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) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 n0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 - 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 InsertionSortSym0 :: (~>) [Nat] [Nat] - data InsertionSortSym0 :: (~>) [Nat] [Nat] - where - InsertionSortSym0KindInference :: SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => - InsertionSortSym0 a0123456789876543210 - type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210 - instance SuppressUnusedWarnings InsertionSortSym0 where - suppressUnusedWarnings - = snd ((,) InsertionSortSym0KindInference ()) - type InsertionSortSym1 :: [Nat] -> [Nat] - type family InsertionSortSym1 (a0123456789876543210 :: [Nat]) :: [Nat] where - InsertionSortSym1 a0123456789876543210 = InsertionSort a0123456789876543210 - type InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) - data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) - where - InsertSym0KindInference :: SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => - InsertSym0 a0123456789876543210 - type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 - instance SuppressUnusedWarnings InsertSym0 where - suppressUnusedWarnings = snd ((,) InsertSym0KindInference ()) - type InsertSym1 :: Nat -> (~>) [Nat] [Nat] - data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat] - where - InsertSym1KindInference :: SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) => - InsertSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (InsertSym1 a0123456789876543210) a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) InsertSym1KindInference ()) - type InsertSym2 :: Nat -> [Nat] -> [Nat] - type family InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) :: [Nat] where - InsertSym2 a0123456789876543210 a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210 - type LeqSym0 :: (~>) Nat ((~>) Nat Bool) - data LeqSym0 :: (~>) Nat ((~>) Nat Bool) - where - LeqSym0KindInference :: SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => - LeqSym0 a0123456789876543210 - type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 - instance SuppressUnusedWarnings LeqSym0 where - suppressUnusedWarnings = snd ((,) LeqSym0KindInference ()) - type LeqSym1 :: Nat -> (~>) Nat Bool - data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool - where - LeqSym1KindInference :: SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => - LeqSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) LeqSym1KindInference ()) - type LeqSym2 :: Nat -> Nat -> Bool - type family LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Bool where - LeqSym2 a0123456789876543210 a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210 - type InsertionSort :: [Nat] -> [Nat] - type family InsertionSort (a :: [Nat]) :: [Nat] where - InsertionSort '[] = NilSym0 - InsertionSort ('(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) - type Insert :: Nat -> [Nat] -> [Nat] - type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where - Insert n '[] = Apply (Apply (:@#@$) n) NilSym0 - Insert n ('(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) - type Leq :: Nat -> Nat -> Bool - 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 - sInsertionSort :: - (forall (t :: [Nat]). - Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) :: Type) - sInsert :: - (forall (t :: Nat) (t :: [Nat]). - Sing t - -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) :: Type) - sLeq :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) :: Type) - sInsertionSort SNil = SNil - sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) - = applySing - (applySing (singFun2 @InsertSym0 sInsert) sH) - (applySing (singFun1 @InsertionSortSym0 sInsertionSort) sT) - 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 - id - @(Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t))) - (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)) - sLeq SZero _ = STrue - sLeq (SSucc _) SZero = SFalse - sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) - = applySing (applySing (singFun2 @LeqSym0 sLeq) sA) sB - instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where - sing = singFun1 @InsertionSortSym0 sInsertionSort - 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 SingI1 (InsertSym1 :: Nat -> (~>) [Nat] [Nat]) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(InsertSym1 (d :: Nat)) (sInsert s) - 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 SingI1 (LeqSym1 :: Nat -> (~>) Nat Bool) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(LeqSym1 (d :: Nat)) (sLeq s) +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations+ singletons [d| data Nat = Zero | Succ Nat |]+ ======>+ data Nat = Zero | Succ Nat+ type ZeroSym0 :: Nat+ type family ZeroSym0 :: Nat where+ ZeroSym0 = Zero+ type SuccSym0 :: (~>) Nat Nat+ data SuccSym0 :: (~>) Nat Nat+ where+ SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>+ SuccSym0 a0123456789876543210+ type instance Apply @Nat @Nat SuccSym0 a0123456789876543210 = Succ a0123456789876543210+ instance SuppressUnusedWarnings SuccSym0 where+ suppressUnusedWarnings = snd ((,) SuccSym0KindInference ())+ type SuccSym1 :: Nat -> Nat+ type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where+ SuccSym1 a0123456789876543210 = Succ a0123456789876543210+ data SNat :: Nat -> Type+ where+ SZero :: SNat (Zero :: Nat)+ SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat)+ type instance Sing @Nat = SNat+ 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))+ = (\cases (SomeSing c) -> SomeSing (SSucc c))+ (toSing b :: SomeSing Nat)+ instance SingI Zero where+ sing = SZero+ instance SingI n => SingI (Succ (n :: Nat)) where+ sing = SSucc sing+ instance SingI1 Succ where+ liftSing = SSucc+ instance SingI (SuccSym0 :: (~>) Nat Nat) where+ sing = singFun1 @SuccSym0 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 family LamCases_0123456789876543210 (n0123456789876543210 :: Nat) h0123456789876543210 t0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 n h t 'True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t)+ LamCases_0123456789876543210 n h t 'False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t)+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: Nat) h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210 h0123456789876543210 t0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 t0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210 h0123456789876543210 t0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210 h0123456789876543210 t0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: Nat) h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210+ type InsertionSortSym0 :: (~>) [Nat] [Nat]+ data InsertionSortSym0 :: (~>) [Nat] [Nat]+ where+ InsertionSortSym0KindInference :: SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) =>+ InsertionSortSym0 a0123456789876543210+ type instance Apply @[Nat] @[Nat] InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210+ instance SuppressUnusedWarnings InsertionSortSym0 where+ suppressUnusedWarnings+ = snd ((,) InsertionSortSym0KindInference ())+ type InsertionSortSym1 :: [Nat] -> [Nat]+ type family InsertionSortSym1 (a0123456789876543210 :: [Nat]) :: [Nat] where+ InsertionSortSym1 a0123456789876543210 = InsertionSort a0123456789876543210+ type InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])+ data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])+ where+ InsertSym0KindInference :: SameKind (Apply InsertSym0 arg) (InsertSym1 arg) =>+ InsertSym0 a0123456789876543210+ type instance Apply @Nat @((~>) [Nat] [Nat]) InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210+ instance SuppressUnusedWarnings InsertSym0 where+ suppressUnusedWarnings = snd ((,) InsertSym0KindInference ())+ type InsertSym1 :: Nat -> (~>) [Nat] [Nat]+ data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat]+ where+ InsertSym1KindInference :: SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) =>+ InsertSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[Nat] @[Nat] (InsertSym1 a0123456789876543210) a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) InsertSym1KindInference ())+ type InsertSym2 :: Nat -> [Nat] -> [Nat]+ type family InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) :: [Nat] where+ InsertSym2 a0123456789876543210 a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210+ type LeqSym0 :: (~>) Nat ((~>) Nat Bool)+ data LeqSym0 :: (~>) Nat ((~>) Nat Bool)+ where+ LeqSym0KindInference :: SameKind (Apply LeqSym0 arg) (LeqSym1 arg) =>+ LeqSym0 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Bool) LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210+ instance SuppressUnusedWarnings LeqSym0 where+ suppressUnusedWarnings = snd ((,) LeqSym0KindInference ())+ type LeqSym1 :: Nat -> (~>) Nat Bool+ data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool+ where+ LeqSym1KindInference :: SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) =>+ LeqSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Bool (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) LeqSym1KindInference ())+ type LeqSym2 :: Nat -> Nat -> Bool+ type family LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Bool where+ LeqSym2 a0123456789876543210 a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210+ type InsertionSort :: [Nat] -> [Nat]+ type family InsertionSort (a :: [Nat]) :: [Nat] where+ InsertionSort '[] = NilSym0+ InsertionSort ('(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t)+ type Insert :: Nat -> [Nat] -> [Nat]+ type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where+ Insert n '[] = Apply (Apply (:@#@$) n) NilSym0+ Insert n ('(:) h t) = Apply (LamCases_0123456789876543210Sym0 n h t) (Apply (Apply LeqSym0 n) h)+ type Leq :: Nat -> Nat -> Bool+ 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+ sInsertionSort ::+ (forall (t :: [Nat]).+ Sing t -> Sing (InsertionSort t :: [Nat]) :: Type)+ sInsert ::+ (forall (t :: Nat) (t :: [Nat]).+ Sing t -> Sing t -> Sing (Insert t t :: [Nat]) :: Type)+ sLeq ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing (Leq t t :: Bool) :: Type)+ sInsertionSort SNil = SNil+ sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t))+ = applySing+ (applySing (singFun2 @InsertSym0 sInsert) sH)+ (applySing (singFun1 @InsertionSortSym0 sInsertionSort) sT)+ sInsert (sN :: Sing n) SNil+ = applySing (applySing (singFun2 @(:@#@$) SCons) sN) SNil+ sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t))+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n h t)+ (\cases+ 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)))+ (applySing (applySing (singFun2 @LeqSym0 sLeq) sN) sH)+ sLeq SZero _ = STrue+ sLeq (SSucc _) SZero = SFalse+ sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b))+ = applySing (applySing (singFun2 @LeqSym0 sLeq) sA) sB+ instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where+ sing = singFun1 @InsertionSortSym0 sInsertionSort+ 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 SingI1 (InsertSym1 :: Nat -> (~>) [Nat] [Nat]) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(InsertSym1 (d :: Nat)) (sInsert s)+ 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 SingI1 (LeqSym1 :: Nat -> (~>) Nat Bool) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(LeqSym1 (d :: Nat)) (sLeq s)
tests/compile-and-dump/InsertionSort/InsertionSortImp.hs view
@@ -1,199 +1,199 @@-{- 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. - --} - -module InsertionSort.InsertionSortImp where - -import Data.Kind (Type) -import Data.Singletons.TH -import Prelude.Singletons - -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) +{- 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.++-}++module InsertionSort.InsertionSortImp where++import Data.Kind (Type)+import Data.Singletons.TH+import Prelude.Singletons++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.golden view
@@ -1,73 +1,73 @@-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 family FooSym0 :: Foo where - FooSym0 = Foo - type (:+@#@$) :: (~>) Foo ((~>) Foo Foo) - data (:+@#@$) :: (~>) Foo ((~>) Foo Foo) - where - (::+@#@$###) :: SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => - (:+@#@$) a0123456789876543210 - type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:+@#@$) where - suppressUnusedWarnings = snd ((,) (::+@#@$###) ()) - type (:+@#@$$) :: Foo -> (~>) Foo Foo - data (:+@#@$$) (a0123456789876543210 :: Foo) :: (~>) Foo Foo - where - (::+@#@$$###) :: SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) => - (:+@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:+@#@$$) a0123456789876543210) a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::+@#@$$###) ()) - type (:+@#@$$$) :: Foo -> Foo -> Foo - type family (:+@#@$$$) (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Foo where - (:+@#@$$$) a0123456789876543210 a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210 - type BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) - data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: Bar - -> (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) - data BarSym1 (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) - where - BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) => - BarSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym1 a0123456789876543210) a0123456789876543210 = BarSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BarSym1KindInference ()) - type BarSym2 :: Bar -> Bar -> (~>) Bar ((~>) Bar ((~>) Foo Bar)) - data BarSym2 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar)) - where - BarSym2KindInference :: SameKind (Apply (BarSym2 a0123456789876543210 a0123456789876543210) arg) (BarSym3 a0123456789876543210 a0123456789876543210 arg) => - BarSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BarSym2KindInference ()) - type BarSym3 :: Bar -> Bar -> Bar -> (~>) Bar ((~>) Foo Bar) - data BarSym3 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar) - where - BarSym3KindInference :: SameKind (Apply (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BarSym3KindInference ()) - type BarSym4 :: Bar -> Bar -> Bar -> Bar -> (~>) Foo Bar - data BarSym4 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Foo Bar - where - BarSym4KindInference :: SameKind (Apply (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BarSym5 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BarSym4KindInference ()) - type BarSym5 :: Bar -> Bar -> Bar -> Bar -> Foo -> Bar - type family BarSym5 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Foo) :: Bar where - BarSym5 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 +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 family FooSym0 :: Foo where+ FooSym0 = Foo+ type (:+@#@$) :: (~>) Foo ((~>) Foo Foo)+ data (:+@#@$) :: (~>) Foo ((~>) Foo Foo)+ where+ (::+@#@$###) :: SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>+ (:+@#@$) a0123456789876543210+ type instance Apply @Foo @((~>) Foo Foo) (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:+@#@$) where+ suppressUnusedWarnings = snd ((,) (::+@#@$###) ())+ type (:+@#@$$) :: Foo -> (~>) Foo Foo+ data (:+@#@$$) (a0123456789876543210 :: Foo) :: (~>) Foo Foo+ where+ (::+@#@$$###) :: SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) =>+ (:+@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Foo @Foo ((:+@#@$$) a0123456789876543210) a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::+@#@$$###) ())+ type (:+@#@$$$) :: Foo -> Foo -> Foo+ type family (:+@#@$$$) (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Foo where+ (:+@#@$$$) a0123456789876543210 a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210+ type BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))))+ data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))))+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @Bar @((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: Bar+ -> (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))+ data BarSym1 (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))+ where+ BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) =>+ BarSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bar @((~>) Bar ((~>) Bar ((~>) Foo Bar))) (BarSym1 a0123456789876543210) a0123456789876543210 = BarSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym1KindInference ())+ type BarSym2 :: Bar -> Bar -> (~>) Bar ((~>) Bar ((~>) Foo Bar))+ data BarSym2 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar))+ where+ BarSym2KindInference :: SameKind (Apply (BarSym2 a0123456789876543210 a0123456789876543210) arg) (BarSym3 a0123456789876543210 a0123456789876543210 arg) =>+ BarSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Bar @((~>) Bar ((~>) Foo Bar)) (BarSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym2KindInference ())+ type BarSym3 :: Bar -> Bar -> Bar -> (~>) Bar ((~>) Foo Bar)+ data BarSym3 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar)+ where+ BarSym3KindInference :: SameKind (Apply (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Bar @((~>) Foo Bar) (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym3KindInference ())+ type BarSym4 :: Bar -> Bar -> Bar -> Bar -> (~>) Foo Bar+ data BarSym4 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) :: (~>) Foo Bar+ where+ BarSym4KindInference :: SameKind (Apply (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BarSym5 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Foo @Bar (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym4KindInference ())+ type BarSym5 :: Bar -> Bar -> Bar -> Bar -> Foo -> Bar+ type family BarSym5 (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Bar) (a0123456789876543210 :: Foo) :: Bar where+ BarSym5 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210
tests/compile-and-dump/Promote/Constructors.hs view
@@ -1,12 +1,12 @@-module Promote.Constructors where - -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 - |]) +module Promote.Constructors where++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.golden view
@@ -1,63 +1,63 @@-Promote/GenDefunSymbols.hs:0:0:: Splicing declarations - genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] - ======> - type LiftMaybeSym0 :: forall (a :: Type) - (b :: Type). (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b)) - data LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b)) - where - LiftMaybeSym0KindInference :: Data.Singletons.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => - LiftMaybeSym0 a0123456789876543210 - type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings LiftMaybeSym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) LiftMaybeSym0KindInference ()) - type LiftMaybeSym1 :: forall (a :: Type) (b :: Type). (~>) a b - -> (~>) (Maybe a) (Maybe b) - data LiftMaybeSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Maybe a) (Maybe b) - where - LiftMaybeSym1KindInference :: Data.Singletons.SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => - LiftMaybeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) LiftMaybeSym1KindInference ()) - type LiftMaybeSym2 :: forall (a :: Type) (b :: Type). (~>) a b - -> Maybe a -> Maybe b - type family LiftMaybeSym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Maybe a) :: Maybe b where - LiftMaybeSym2 a0123456789876543210 a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 - type ZeroSym0 :: NatT - type family ZeroSym0 :: NatT where - ZeroSym0 = 'Zero - type SuccSym0 :: (~>) NatT NatT - data SuccSym0 :: (~>) NatT NatT - where - SuccSym0KindInference :: Data.Singletons.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0 a0123456789876543210 - type instance Apply SuccSym0 a0123456789876543210 = 'Succ a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings SuccSym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) SuccSym0KindInference ()) - type SuccSym1 :: NatT -> NatT - type family SuccSym1 (a0123456789876543210 :: NatT) :: NatT where - SuccSym1 a0123456789876543210 = 'Succ a0123456789876543210 - type (:+@#@$) :: (~>) Natural ((~>) Natural Natural) - data (:+@#@$) :: (~>) Natural ((~>) Natural Natural) - where - (::+@#@$###) :: Data.Singletons.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => - (:+@#@$) a0123456789876543210 - type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (:+@#@$) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) (::+@#@$###) ()) - type (:+@#@$$) :: Natural -> (~>) Natural Natural - data (:+@#@$$) (a0123456789876543210 :: Natural) :: (~>) Natural Natural - where - (::+@#@$$###) :: Data.Singletons.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) => - (:+@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:+@#@$$) a0123456789876543210) a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) (::+@#@$$###) ()) - type (:+@#@$$$) :: Natural -> Natural -> Natural - type family (:+@#@$$$) (a0123456789876543210 :: Natural) (a0123456789876543210 :: Natural) :: Natural where - (:+@#@$$$) a0123456789876543210 a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210 +Promote/GenDefunSymbols.hs:0:0:: Splicing declarations+ genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)]+ ======>+ type LiftMaybeSym0 :: forall (a :: Type)+ (b :: Type). (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))+ data LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))+ where+ LiftMaybeSym0KindInference :: Data.Singletons.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>+ LiftMaybeSym0 a0123456789876543210+ type instance Apply @((~>) a b) @((~>) (Maybe a) (Maybe b)) LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings LiftMaybeSym0 where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) LiftMaybeSym0KindInference ())+ type LiftMaybeSym1 :: forall (a :: Type) (b :: Type). (~>) a b+ -> (~>) (Maybe a) (Maybe b)+ data LiftMaybeSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Maybe a) (Maybe b)+ where+ LiftMaybeSym1KindInference :: Data.Singletons.SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) =>+ LiftMaybeSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @(Maybe b) (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) LiftMaybeSym1KindInference ())+ type LiftMaybeSym2 :: forall (a :: Type) (b :: Type). (~>) a b+ -> Maybe a -> Maybe b+ type family LiftMaybeSym2 @(a :: Type) @(b :: Type) (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Maybe a) :: Maybe b where+ LiftMaybeSym2 a0123456789876543210 a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210+ type ZeroSym0 :: NatT+ type family ZeroSym0 :: NatT where+ ZeroSym0 = 'Zero+ type SuccSym0 :: (~>) NatT NatT+ data SuccSym0 :: (~>) NatT NatT+ where+ SuccSym0KindInference :: Data.Singletons.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>+ SuccSym0 a0123456789876543210+ type instance Apply @NatT @NatT SuccSym0 a0123456789876543210 = 'Succ a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings SuccSym0 where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) SuccSym0KindInference ())+ type SuccSym1 :: NatT -> NatT+ type family SuccSym1 (a0123456789876543210 :: NatT) :: NatT where+ SuccSym1 a0123456789876543210 = 'Succ a0123456789876543210+ type (:+@#@$) :: (~>) Natural ((~>) Natural Natural)+ data (:+@#@$) :: (~>) Natural ((~>) Natural Natural)+ where+ (::+@#@$###) :: Data.Singletons.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>+ (:+@#@$) a0123456789876543210+ type instance Apply @Natural @((~>) Natural Natural) (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (:+@#@$) where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) (::+@#@$###) ())+ type (:+@#@$$) :: Natural -> (~>) Natural Natural+ data (:+@#@$$) (a0123456789876543210 :: Natural) :: (~>) Natural Natural+ where+ (::+@#@$$###) :: Data.Singletons.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) =>+ (:+@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Natural @Natural ((:+@#@$$) a0123456789876543210) a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) (::+@#@$$###) ())+ type (:+@#@$$$) :: Natural -> Natural -> Natural+ type family (:+@#@$$$) (a0123456789876543210 :: Natural) (a0123456789876543210 :: Natural) :: Natural where+ (:+@#@$$$) a0123456789876543210 a0123456789876543210 = (:+) a0123456789876543210 a0123456789876543210
tests/compile-and-dump/Promote/GenDefunSymbols.hs view
@@ -1,16 +1,16 @@-module Promote.GenDefunSymbols where - -import Data.Singletons (Apply, type (~>)) -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, ''(:+) ]) +module Promote.GenDefunSymbols where++import Data.Singletons (Apply, type (~>))+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.golden view
@@ -1,73 +1,52 @@-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 FooSym0 :: (~>) Nat Foo - data FooSym0 :: (~>) Nat Foo - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: Nat -> Foo - type family FooSym1 (a0123456789876543210 :: Nat) :: Foo where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type BarSym0 :: (~>) Nat Bar - data BarSym0 :: (~>) Nat Bar - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: Nat -> Bar - type family BarSym1 (a0123456789876543210 :: Nat) :: Bar where - BarSym1 a0123456789876543210 = Bar a0123456789876543210 - type UnBarSym0 :: (~>) Bar Nat - data UnBarSym0 :: (~>) Bar Nat - where - UnBarSym0KindInference :: SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => - UnBarSym0 a0123456789876543210 - type instance Apply UnBarSym0 a0123456789876543210 = UnBar a0123456789876543210 - instance SuppressUnusedWarnings UnBarSym0 where - suppressUnusedWarnings = snd ((,) UnBarSym0KindInference ()) - type UnBarSym1 :: Bar -> Nat - type family UnBarSym1 (a0123456789876543210 :: Bar) :: Nat where - UnBarSym1 a0123456789876543210 = UnBar a0123456789876543210 - type UnBar :: Bar -> Nat - type family UnBar (a :: Bar) :: Nat where - UnBar (Bar field) = field - type TFHelper_0123456789876543210 :: Foo -> Foo -> Bool - type family TFHelper_0123456789876543210 (a :: Foo) (a :: Foo) :: Bool where - TFHelper_0123456789876543210 (Foo a_0123456789876543210) (Foo b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Foo -> (~>) Foo Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Foo -> Foo -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Foo where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a +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 FooSym0 :: (~>) Nat Foo+ data FooSym0 :: (~>) Nat Foo+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @Nat @Foo FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: Nat -> Foo+ type family FooSym1 (a0123456789876543210 :: Nat) :: Foo where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type BarSym0 :: (~>) Nat Bar+ data BarSym0 :: (~>) Nat Bar+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @Nat @Bar BarSym0 a0123456789876543210 = Bar a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: Nat -> Bar+ type family BarSym1 (a0123456789876543210 :: Nat) :: Bar where+ BarSym1 a0123456789876543210 = Bar a0123456789876543210+ type UnBarSym0 :: (~>) Bar Nat+ data UnBarSym0 :: (~>) Bar Nat+ where+ UnBarSym0KindInference :: SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) =>+ UnBarSym0 a0123456789876543210+ type instance Apply @Bar @Nat UnBarSym0 a0123456789876543210 = UnBar a0123456789876543210+ instance SuppressUnusedWarnings UnBarSym0 where+ suppressUnusedWarnings = snd ((,) UnBarSym0KindInference ())+ type UnBarSym1 :: Bar -> Nat+ type family UnBarSym1 (a0123456789876543210 :: Bar) :: Nat where+ UnBarSym1 a0123456789876543210 = UnBar a0123456789876543210+ type UnBar :: Bar -> Nat+ type family UnBar (a :: Bar) :: Nat where+ UnBar (Bar field) = field+ type TFHelper_0123456789876543210 :: Foo -> Foo -> Bool+ type family TFHelper_0123456789876543210 (a :: Foo) (a :: Foo) :: Bool where+ TFHelper_0123456789876543210 (Foo a_0123456789876543210) (Foo b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq Foo where+ type (==) a a = TFHelper_0123456789876543210 a a
tests/compile-and-dump/Promote/Newtypes.hs view
@@ -1,9 +1,9 @@-module Promote.Newtypes where - -import Data.Singletons.Base.TH -import Singletons.Nat - -$(promote [d| - newtype Foo = Foo Nat deriving (Eq) - newtype Bar = Bar { unBar :: Nat } - |]) +module Promote.Newtypes where++import Data.Singletons.Base.TH+import Singletons.Nat++$(promote [d|+ newtype Foo = Foo Nat deriving (Eq)+ newtype Bar = Bar { unBar :: Nat }+ |])
tests/compile-and-dump/Promote/Pragmas.golden view
@@ -1,15 +1,15 @@-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 :: Bool - type family FooSym0 :: Bool where - FooSym0 = Foo - type Foo :: Bool - type family Foo :: Bool where - Foo = TrueSym0 +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 :: Bool+ type family FooSym0 :: Bool where+ FooSym0 = Foo+ type Foo :: Bool+ type family Foo :: Bool where+ Foo = TrueSym0
tests/compile-and-dump/Promote/Pragmas.hs view
@@ -1,10 +1,10 @@-module Promote.Pragmas where - -import Data.Singletons.TH -import Prelude.Singletons - -$(promote [d| - {-# INLINE foo #-} - foo :: Bool - foo = True - |]) +module Promote.Pragmas where++import Data.Singletons.TH+import Prelude.Singletons++$(promote [d|+ {-# INLINE foo #-}+ foo :: Bool+ foo = True+ |])
tests/compile-and-dump/Promote/Prelude.golden view
@@ -1,21 +1,21 @@-Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations - promoteOnly - [d| odd :: Natural -> Bool - odd 0 = False - odd n = not . odd $ n - 1 |] - ======> - type OddSym0 :: (~>) Natural Bool - data OddSym0 :: (~>) Natural Bool - where - OddSym0KindInference :: SameKind (Apply OddSym0 arg) (OddSym1 arg) => - OddSym0 a0123456789876543210 - type instance Apply OddSym0 a0123456789876543210 = Odd a0123456789876543210 - instance SuppressUnusedWarnings OddSym0 where - suppressUnusedWarnings = snd ((,) OddSym0KindInference ()) - type OddSym1 :: Natural -> Bool - type family OddSym1 (a0123456789876543210 :: Natural) :: Bool where - OddSym1 a0123456789876543210 = Odd a0123456789876543210 - type Odd :: Natural -> Bool - type family Odd (a :: Natural) :: Bool where - Odd 0 = FalseSym0 - Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1)) +Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations+ promoteOnly+ [d| odd :: Natural -> Bool+ odd 0 = False+ odd n = not . odd $ n - 1 |]+ ======>+ type OddSym0 :: (~>) Natural Bool+ data OddSym0 :: (~>) Natural Bool+ where+ OddSym0KindInference :: SameKind (Apply OddSym0 arg) (OddSym1 arg) =>+ OddSym0 a0123456789876543210+ type instance Apply @Natural @Bool OddSym0 a0123456789876543210 = Odd a0123456789876543210+ instance SuppressUnusedWarnings OddSym0 where+ suppressUnusedWarnings = snd ((,) OddSym0KindInference ())+ type OddSym1 :: Natural -> Bool+ type family OddSym1 (a0123456789876543210 :: Natural) :: Bool where+ OddSym1 a0123456789876543210 = Odd a0123456789876543210+ type Odd :: Natural -> Bool+ type family Odd (a :: Natural) :: 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 view
@@ -1,132 +1,132 @@-module Promote.Prelude where - -import Data.List.Singletons -import Data.Singletons.TH -import GHC.TypeLits -import Prelude.Singletons - -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 :: Natural -> 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 +module Promote.Prelude where++import Data.List.Singletons+import Data.Singletons.TH+import GHC.TypeLits+import Prelude.Singletons++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 :: Natural -> 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.golden view
@@ -1,59 +1,59 @@-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 X1Sym0 :: (~>) Symbol X - data X1Sym0 :: (~>) Symbol X - where - X1Sym0KindInference :: SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => - X1Sym0 a0123456789876543210 - type instance Apply X1Sym0 a0123456789876543210 = X1 a0123456789876543210 - instance SuppressUnusedWarnings X1Sym0 where - suppressUnusedWarnings = snd ((,) X1Sym0KindInference ()) - type X1Sym1 :: Symbol -> X - type family X1Sym1 (a0123456789876543210 :: Symbol) :: X where - X1Sym1 a0123456789876543210 = X1 a0123456789876543210 - type X2Sym0 :: (~>) Symbol X - data X2Sym0 :: (~>) Symbol X - where - X2Sym0KindInference :: SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => - X2Sym0 a0123456789876543210 - type instance Apply X2Sym0 a0123456789876543210 = X2 a0123456789876543210 - instance SuppressUnusedWarnings X2Sym0 where - suppressUnusedWarnings = snd ((,) X2Sym0KindInference ()) - type X2Sym1 :: Symbol -> X - type family X2Sym1 (a0123456789876543210 :: Symbol) :: X where - X2Sym1 a0123456789876543210 = X2 a0123456789876543210 - data ZSym0 a0123456789876543210 - where - ZSym0KindInference :: SameKind (Apply ZSym0 arg) (ZSym1 arg) => - ZSym0 a0123456789876543210 - type instance Apply ZSym0 a0123456789876543210 = Z a0123456789876543210 - instance SuppressUnusedWarnings ZSym0 where - suppressUnusedWarnings = snd ((,) ZSym0KindInference ()) - type family ZSym1 a0123456789876543210 where - ZSym1 a0123456789876543210 = Z a0123456789876543210 - type YSym0 :: (~>) X Symbol - data YSym0 :: (~>) X Symbol - where - YSym0KindInference :: SameKind (Apply YSym0 arg) (YSym1 arg) => - YSym0 a0123456789876543210 - type instance Apply YSym0 a0123456789876543210 = Y a0123456789876543210 - instance SuppressUnusedWarnings YSym0 where - suppressUnusedWarnings = snd ((,) YSym0KindInference ()) - type YSym1 :: X -> Symbol - type family YSym1 (a0123456789876543210 :: X) :: Symbol where - YSym1 a0123456789876543210 = Y a0123456789876543210 - type family Z a where - Z (X1 x) = x - Z (X2 x) = x - type Y :: X -> Symbol - type family Y (a :: X) :: Symbol where - Y (X1 field) = field - Y (X2 field) = field +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 X1Sym0 :: (~>) Symbol X+ data X1Sym0 :: (~>) Symbol X+ where+ X1Sym0KindInference :: SameKind (Apply X1Sym0 arg) (X1Sym1 arg) =>+ X1Sym0 a0123456789876543210+ type instance Apply @Symbol @X X1Sym0 a0123456789876543210 = X1 a0123456789876543210+ instance SuppressUnusedWarnings X1Sym0 where+ suppressUnusedWarnings = snd ((,) X1Sym0KindInference ())+ type X1Sym1 :: Symbol -> X+ type family X1Sym1 (a0123456789876543210 :: Symbol) :: X where+ X1Sym1 a0123456789876543210 = X1 a0123456789876543210+ type X2Sym0 :: (~>) Symbol X+ data X2Sym0 :: (~>) Symbol X+ where+ X2Sym0KindInference :: SameKind (Apply X2Sym0 arg) (X2Sym1 arg) =>+ X2Sym0 a0123456789876543210+ type instance Apply @Symbol @X X2Sym0 a0123456789876543210 = X2 a0123456789876543210+ instance SuppressUnusedWarnings X2Sym0 where+ suppressUnusedWarnings = snd ((,) X2Sym0KindInference ())+ type X2Sym1 :: Symbol -> X+ type family X2Sym1 (a0123456789876543210 :: Symbol) :: X where+ X2Sym1 a0123456789876543210 = X2 a0123456789876543210+ data ZSym0 a0123456789876543210+ where+ ZSym0KindInference :: SameKind (Apply ZSym0 arg) (ZSym1 arg) =>+ ZSym0 a0123456789876543210+ type instance Apply @_ @_ ZSym0 a0123456789876543210 = Z a0123456789876543210+ instance SuppressUnusedWarnings ZSym0 where+ suppressUnusedWarnings = snd ((,) ZSym0KindInference ())+ type family ZSym1 a0123456789876543210 where+ ZSym1 a0123456789876543210 = Z a0123456789876543210+ type YSym0 :: (~>) X Symbol+ data YSym0 :: (~>) X Symbol+ where+ YSym0KindInference :: SameKind (Apply YSym0 arg) (YSym1 arg) =>+ YSym0 a0123456789876543210+ type instance Apply @X @Symbol YSym0 a0123456789876543210 = Y a0123456789876543210+ instance SuppressUnusedWarnings YSym0 where+ suppressUnusedWarnings = snd ((,) YSym0KindInference ())+ type YSym1 :: X -> Symbol+ type family YSym1 (a0123456789876543210 :: X) :: Symbol where+ YSym1 a0123456789876543210 = Y a0123456789876543210+ type family Z a where+ Z (X1 x) = x+ Z (X2 x) = x+ type Y :: X -> Symbol+ type family Y (a :: X) :: Symbol where+ Y (X1 field) = field+ Y (X2 field) = field
tests/compile-and-dump/Promote/T180.hs view
@@ -1,10 +1,10 @@-module T180 where - -import Data.Singletons.TH -import Prelude.Singletons - -promote [d| - data X = X1 {y :: Symbol} | X2 {y :: Symbol} - z (X1 x) = x - z (X2 x) = x - |] +module T180 where++import Data.Singletons.TH+import Prelude.Singletons++promote [d|+ data X = X1 {y :: Symbol} | X2 {y :: Symbol}+ z (X1 x) = x+ z (X2 x) = x+ |]
tests/compile-and-dump/Promote/T361.golden view
@@ -1,27 +1,27 @@-Promote/T361.hs:0:0:: Splicing declarations - genDefunSymbols [''Proxy] - ======> - type ProxySym0 :: forall k (t :: k). Proxy (t :: k) - type family ProxySym0 :: Proxy (t :: k) where - 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 FSym0 :: (~>) (Proxy 1) (Proxy 2) - data FSym0 :: (~>) (Proxy 1) (Proxy 2) - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: Proxy 1 -> Proxy 2 - type family FSym1 (a0123456789876543210 :: Proxy 1) :: Proxy 2 where - FSym1 a0123456789876543210 = F a0123456789876543210 - type F :: Proxy 1 -> Proxy 2 - type family F (a :: Proxy 1) :: Proxy 2 where - F 'Proxy = ProxySym0 +Promote/T361.hs:0:0:: Splicing declarations+ genDefunSymbols [''Proxy]+ ======>+ type ProxySym0 :: forall {k :: Type} (t :: k). Proxy t+ type family ProxySym0 @(t :: k) :: Proxy t where+ 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 FSym0 :: (~>) (Proxy 1) (Proxy 2)+ data FSym0 :: (~>) (Proxy 1) (Proxy 2)+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @(Proxy 1) @(Proxy 2) FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: Proxy 1 -> Proxy 2+ type family FSym1 (a0123456789876543210 :: Proxy 1) :: Proxy 2 where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type F :: Proxy 1 -> Proxy 2+ type family F (a :: Proxy 1) :: Proxy 2 where+ F 'Proxy = ProxySym0
tests/compile-and-dump/Promote/T361.hs view
@@ -1,11 +1,11 @@-module T361 where - -import Data.Proxy -import Data.Singletons.TH - -$(genDefunSymbols [''Proxy]) - -$(promote [d| - f :: Proxy 1 -> Proxy 2 - f Proxy = Proxy - |]) +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/Promote/T601a.golden view
@@ -0,0 +1,73 @@+Promote/T601a.hs:(0,0)-(0,0): Splicing declarations+ promote+ [d| type MyApplicative :: (Type -> Type) -> Constraint+ + class Functor f => MyApplicative f where+ ap :: f (a -> b) -> f a -> f b+ rightSparrow :: f a -> f b -> f b+ rightSparrow x y = ap (id <$ x) y |]+ ======>+ type MyApplicative :: (Type -> Type) -> Constraint+ class Functor f => MyApplicative f where+ ap :: f (a -> b) -> f a -> f b+ rightSparrow :: f a -> f b -> f b+ rightSparrow x y = ap (id <$ x) y+ type ApSym0 :: forall (f :: Type -> Type)+ a+ b. (~>) (f ((~>) a b)) ((~>) (f a) (f b))+ data ApSym0 :: (~>) (f ((~>) a b)) ((~>) (f a) (f b))+ where+ ApSym0KindInference :: SameKind (Apply ApSym0 arg) (ApSym1 arg) =>+ ApSym0 a0123456789876543210+ type instance Apply @(f ((~>) a b)) @((~>) (f a) (f b)) ApSym0 a0123456789876543210 = ApSym1 a0123456789876543210+ instance SuppressUnusedWarnings ApSym0 where+ suppressUnusedWarnings = snd ((,) ApSym0KindInference ())+ type ApSym1 :: forall (f :: Type -> Type) a b. f ((~>) a b)+ -> (~>) (f a) (f b)+ data ApSym1 (a0123456789876543210 :: f ((~>) a b)) :: (~>) (f a) (f b)+ where+ ApSym1KindInference :: SameKind (Apply (ApSym1 a0123456789876543210) arg) (ApSym2 a0123456789876543210 arg) =>+ ApSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(f a) @(f b) (ApSym1 a0123456789876543210) a0123456789876543210 = Ap a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ApSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ApSym1KindInference ())+ type ApSym2 :: forall (f :: Type -> Type) a b. f ((~>) a b)+ -> f a -> f b+ type family ApSym2 @(f :: Type+ -> Type) @a @b (a0123456789876543210 :: f ((~>) a b)) (a0123456789876543210 :: f a) :: f b where+ ApSym2 a0123456789876543210 a0123456789876543210 = Ap a0123456789876543210 a0123456789876543210+ type RightSparrowSym0 :: forall (f :: Type -> Type)+ a+ b. (~>) (f a) ((~>) (f b) (f b))+ data RightSparrowSym0 :: (~>) (f a) ((~>) (f b) (f b))+ where+ RightSparrowSym0KindInference :: SameKind (Apply RightSparrowSym0 arg) (RightSparrowSym1 arg) =>+ RightSparrowSym0 a0123456789876543210+ type instance Apply @(f a) @((~>) (f b) (f b)) RightSparrowSym0 a0123456789876543210 = RightSparrowSym1 a0123456789876543210+ instance SuppressUnusedWarnings RightSparrowSym0 where+ suppressUnusedWarnings = snd ((,) RightSparrowSym0KindInference ())+ type RightSparrowSym1 :: forall (f :: Type -> Type) a b. f a+ -> (~>) (f b) (f b)+ data RightSparrowSym1 (a0123456789876543210 :: f a) :: (~>) (f b) (f b)+ where+ RightSparrowSym1KindInference :: SameKind (Apply (RightSparrowSym1 a0123456789876543210) arg) (RightSparrowSym2 a0123456789876543210 arg) =>+ RightSparrowSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(f b) @(f b) (RightSparrowSym1 a0123456789876543210) a0123456789876543210 = RightSparrow a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (RightSparrowSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) RightSparrowSym1KindInference ())+ type RightSparrowSym2 :: forall (f :: Type -> Type) a b. f a+ -> f b -> f b+ type family RightSparrowSym2 @(f :: Type+ -> Type) @a @b (a0123456789876543210 :: f a) (a0123456789876543210 :: f b) :: f b where+ RightSparrowSym2 a0123456789876543210 a0123456789876543210 = RightSparrow a0123456789876543210 a0123456789876543210+ type RightSparrow_0123456789876543210 :: forall (f :: Type -> Type)+ a+ b. f a -> f b -> f b+ type family RightSparrow_0123456789876543210 @(f :: Type+ -> Type) @a @b (a :: f a) (a :: f b) :: f b where+ RightSparrow_0123456789876543210 @f @a @b (x :: f a) (y :: f b) = Apply (Apply ApSym0 (Apply (Apply (<$@#@$) IdSym0) x)) y+ type PMyApplicative :: (Type -> Type) -> Constraint+ class PMyApplicative f where+ type family Ap (arg :: f ((~>) a b)) (arg :: f a) :: f b+ type family RightSparrow (arg :: f a) (arg :: f b) :: f b+ type RightSparrow a a = RightSparrow_0123456789876543210 a a
+ tests/compile-and-dump/Promote/T601a.hs view
@@ -0,0 +1,14 @@+module T601a where++import Data.Kind+import Data.Singletons.Base.TH+import Prelude.Singletons++$(promote [d|+ type MyApplicative :: (Type -> Type) -> Constraint+ class Functor f => MyApplicative f where+ ap :: f (a -> b) -> f a -> f b++ rightSparrow :: f a -> f b -> f b+ rightSparrow x y = ap (id <$ x) y+ |])
+ tests/compile-and-dump/Promote/T605.golden view
@@ -0,0 +1,39 @@+Promote/T605.hs:(0,0)-(0,0): Splicing declarations+ promoteOnly+ [d| type Traversable' :: (Type -> Type) -> Constraint+ + class (Functor t, Foldable t) => Traversable' t where+ traverse' :: Applicative f => (a -> f b) -> t a -> t (f b) |]+ ======>+ type Traverse'Sym0 :: forall (t :: Type -> Type)+ a+ f+ b. (~>) ((~>) a (f b)) ((~>) (t a) (t (f b)))+ data Traverse'Sym0 :: (~>) ((~>) a (f b)) ((~>) (t a) (t (f b)))+ where+ Traverse'Sym0KindInference :: SameKind (Apply Traverse'Sym0 arg) (Traverse'Sym1 arg) =>+ Traverse'Sym0 a0123456789876543210+ type instance Apply @((~>) a (f b)) @((~>) (t a) (t (f b))) Traverse'Sym0 a0123456789876543210 = Traverse'Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Traverse'Sym0 where+ suppressUnusedWarnings = snd ((,) Traverse'Sym0KindInference ())+ type Traverse'Sym1 :: forall (t :: Type -> Type)+ a+ f+ b. (~>) a (f b) -> (~>) (t a) (t (f b))+ data Traverse'Sym1 (a0123456789876543210 :: (~>) a (f b)) :: (~>) (t a) (t (f b))+ where+ Traverse'Sym1KindInference :: SameKind (Apply (Traverse'Sym1 a0123456789876543210) arg) (Traverse'Sym2 a0123456789876543210 arg) =>+ Traverse'Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(t a) @(t (f b)) (Traverse'Sym1 a0123456789876543210) a0123456789876543210 = Traverse' a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Traverse'Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Traverse'Sym1KindInference ())+ type Traverse'Sym2 :: forall (t :: Type -> Type)+ a+ f+ b. (~>) a (f b) -> t a -> t (f b)+ type family Traverse'Sym2 @(t :: Type+ -> Type) @a @f @b (a0123456789876543210 :: (~>) a (f b)) (a0123456789876543210 :: t a) :: t (f b) where+ Traverse'Sym2 a0123456789876543210 a0123456789876543210 = Traverse' a0123456789876543210 a0123456789876543210+ type PTraversable' :: (Type -> Type) -> Constraint+ class PTraversable' t where+ type family Traverse' (arg :: (~>) a (f b)) (arg :: t a) :: t (f b)
+ tests/compile-and-dump/Promote/T605.hs view
@@ -0,0 +1,11 @@+module T605 where++import Data.Kind+import Data.Singletons.Base.TH+import Prelude.Singletons++$(promoteOnly [d|+ type Traversable' :: (Type -> Type) -> Constraint+ class (Functor t, Foldable t) => Traversable' t where+ traverse' :: Applicative f => (a -> f b) -> t a -> t (f b)+ |])
+ tests/compile-and-dump/Promote/T613.golden view
@@ -0,0 +1,31 @@+Promote/T613.hs:(0,0)-(0,0): Splicing declarations+ promote+ [d| f :: forall k (a :: k). Proxy a -> Proxy a+ f x+ = y+ where+ y = x |]+ ======>+ f :: forall k (a :: k). Proxy a -> Proxy a+ f x+ = y+ where+ y = x+ type family Let0123456789876543210YSym0 k0123456789876543210 (a0123456789876543210 :: k0123456789876543210) (x0123456789876543210 :: Proxy a0123456789876543210) where+ Let0123456789876543210YSym0 k0123456789876543210 a0123456789876543210 x0123456789876543210 = Let0123456789876543210Y k0123456789876543210 a0123456789876543210 x0123456789876543210+ type family Let0123456789876543210Y k0123456789876543210 (a0123456789876543210 :: k0123456789876543210) (x0123456789876543210 :: Proxy a0123456789876543210) where+ Let0123456789876543210Y k a x = x+ type FSym0 :: forall k (a :: k). (~>) (Proxy a) (Proxy a)+ data FSym0 :: (~>) (Proxy a) (Proxy a)+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @(Proxy a) @(Proxy a) FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: forall k (a :: k). Proxy a -> Proxy a+ type family FSym1 @k @(a :: k) (a0123456789876543210 :: Proxy a) :: Proxy a where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type F :: forall k (a :: k). Proxy a -> Proxy a+ type family F @k @(a :: k) (a :: Proxy a) :: Proxy a where+ F @k @a (x :: Proxy a) = Let0123456789876543210YSym0 k a x
+ tests/compile-and-dump/Promote/T613.hs view
@@ -0,0 +1,12 @@+module T613 where++import Data.Proxy+import Data.Proxy.Singletons+import Data.Singletons.TH++$(promote [d|+ f :: forall k (a :: k). Proxy a -> Proxy a+ f x = y+ where+ y = x+ |])
tests/compile-and-dump/Singletons/AsPattern.golden view
@@ -1,405 +1,320 @@-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 BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) - data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) - where - BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0 a0123456789876543210 - type instance Apply BazSym0 a0123456789876543210 = BazSym1 a0123456789876543210 - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings = snd ((,) BazSym0KindInference ()) - type BazSym1 :: Nat -> (~>) Nat ((~>) Nat Baz) - data BazSym1 (a0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz) - where - BazSym1KindInference :: SameKind (Apply (BazSym1 a0123456789876543210) arg) (BazSym2 a0123456789876543210 arg) => - BazSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BazSym1 a0123456789876543210) a0123456789876543210 = BazSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BazSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BazSym1KindInference ()) - type BazSym2 :: Nat -> Nat -> (~>) Nat Baz - data BazSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: (~>) Nat Baz - where - BazSym2KindInference :: SameKind (Apply (BazSym2 a0123456789876543210 a0123456789876543210) arg) (BazSym3 a0123456789876543210 a0123456789876543210 arg) => - BazSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BazSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BazSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BazSym2KindInference ()) - type BazSym3 :: Nat -> Nat -> Nat -> Baz - type family BazSym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Baz where - BazSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 a0123456789876543210 - type family Let0123456789876543210PSym0 where - Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NilSym0 - data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym0KindInference :: SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym0KindInference ()) - type family Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 - type family Let0123456789876543210P wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) NilSym0 - data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym0KindInference :: SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym0KindInference ()) - data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym1KindInference :: 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 (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym1KindInference ()) - data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym2KindInference :: 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 (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym2KindInference ()) - type family Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 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) - data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym0KindInference :: SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym0KindInference ()) - data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym1KindInference :: 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 (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym1KindInference ()) - type family Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 - type family Let0123456789876543210PSym0 where - Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NothingSym0 - data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym0KindInference :: SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym0KindInference ()) - data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym1KindInference :: 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 (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym1KindInference ()) - data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym2KindInference :: 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 (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210PSym2KindInference ()) - type family Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 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) - data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210XSym0KindInference :: SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210XSym0KindInference ()) - type family Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 where - Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 - type family Let0123456789876543210X wild_0123456789876543210 where - Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 - type family Let0123456789876543210PSym0 where - Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NothingSym0 - type FooSym0 :: (~>) [Nat] [Nat] - data FooSym0 :: (~>) [Nat] [Nat] - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: [Nat] -> [Nat] - type family FooSym1 (a0123456789876543210 :: [Nat]) :: [Nat] where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type TupSym0 :: (~>) (Nat, Nat) (Nat, Nat) - data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat) - where - TupSym0KindInference :: SameKind (Apply TupSym0 arg) (TupSym1 arg) => - TupSym0 a0123456789876543210 - type instance Apply TupSym0 a0123456789876543210 = Tup a0123456789876543210 - instance SuppressUnusedWarnings TupSym0 where - suppressUnusedWarnings = snd ((,) TupSym0KindInference ()) - type TupSym1 :: (Nat, Nat) -> (Nat, Nat) - type family TupSym1 (a0123456789876543210 :: (Nat, Nat)) :: (Nat, - Nat) where - TupSym1 a0123456789876543210 = Tup a0123456789876543210 - type Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz) - data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz) - where - Baz_Sym0KindInference :: SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => - Baz_Sym0 a0123456789876543210 - type instance Apply Baz_Sym0 a0123456789876543210 = Baz_ a0123456789876543210 - instance SuppressUnusedWarnings Baz_Sym0 where - suppressUnusedWarnings = snd ((,) Baz_Sym0KindInference ()) - type Baz_Sym1 :: Maybe Baz -> Maybe Baz - type family Baz_Sym1 (a0123456789876543210 :: Maybe Baz) :: Maybe Baz where - Baz_Sym1 a0123456789876543210 = Baz_ a0123456789876543210 - type BarSym0 :: (~>) (Maybe Nat) (Maybe Nat) - data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat) - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: Maybe Nat -> Maybe Nat - type family BarSym1 (a0123456789876543210 :: Maybe Nat) :: Maybe Nat where - BarSym1 a0123456789876543210 = Bar a0123456789876543210 - type MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat) - data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat) - where - MaybePlusSym0KindInference :: SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => - MaybePlusSym0 a0123456789876543210 - type instance Apply MaybePlusSym0 a0123456789876543210 = MaybePlus a0123456789876543210 - instance SuppressUnusedWarnings MaybePlusSym0 where - suppressUnusedWarnings = snd ((,) MaybePlusSym0KindInference ()) - type MaybePlusSym1 :: Maybe Nat -> Maybe Nat - type family MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) :: Maybe Nat where - MaybePlusSym1 a0123456789876543210 = MaybePlus a0123456789876543210 - type Foo :: [Nat] -> [Nat] - 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 Tup :: (Nat, Nat) -> (Nat, Nat) - type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where - Tup '(wild_0123456789876543210, - wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 - type Baz_ :: Maybe Baz -> Maybe Baz - 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 Bar :: Maybe Nat -> Maybe Nat - type family Bar (a :: Maybe Nat) :: Maybe Nat where - Bar ('Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 - Bar 'Nothing = NothingSym0 - type MaybePlus :: Maybe Nat -> Maybe Nat - 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]) :: Type) - sTup :: - (forall (t :: (Nat, Nat)). - Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) :: Type) - sBaz_ :: - (forall (t :: Maybe Baz). - Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) :: Type) - sBar :: - (forall (t :: Maybe Nat). - Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) :: Type) - sMaybePlus :: - (forall (t :: Maybe Nat). - Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) :: Type) - 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 SBaz :: Baz -> Type - where - SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat). - (Sing n) -> (Sing n) -> (Sing n) -> SBaz (Baz n n n :: Baz) - type instance Sing @Baz = SBaz - 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 n, SingI n) => - SingI1 (Baz (n :: Nat) (n :: Nat)) where - liftSing = SBaz sing sing - instance SingI n => SingI2 (Baz (n :: Nat)) where - liftSing2 = SBaz sing - instance SingI (BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where - sing = singFun3 @BazSym0 SBaz - instance SingI d => - SingI (BazSym1 (d :: Nat) :: (~>) Nat ((~>) Nat Baz)) where - sing = singFun2 @(BazSym1 (d :: Nat)) (SBaz (sing @d)) - instance SingI1 (BazSym1 :: Nat -> (~>) Nat ((~>) Nat Baz)) where - liftSing (s :: Sing (d :: Nat)) - = singFun2 @(BazSym1 (d :: Nat)) (SBaz s) - 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 => - SingI1 (BazSym2 (d :: Nat) :: Nat -> (~>) Nat Baz) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(BazSym2 (d :: Nat) (d :: Nat)) (SBaz (sing @d) s) - instance SingI2 (BazSym2 :: Nat -> Nat -> (~>) Nat Baz) where - liftSing2 (s :: Sing (d :: Nat)) (s :: Sing (d :: Nat)) - = singFun1 @(BazSym2 (d :: Nat) (d :: Nat)) (SBaz s s) +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 BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))+ data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))+ where+ BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) =>+ BazSym0 a0123456789876543210+ type instance Apply @Nat @((~>) Nat ((~>) Nat Baz)) BazSym0 a0123456789876543210 = BazSym1 a0123456789876543210+ instance SuppressUnusedWarnings BazSym0 where+ suppressUnusedWarnings = snd ((,) BazSym0KindInference ())+ type BazSym1 :: Nat -> (~>) Nat ((~>) Nat Baz)+ data BazSym1 (a0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz)+ where+ BazSym1KindInference :: SameKind (Apply (BazSym1 a0123456789876543210) arg) (BazSym2 a0123456789876543210 arg) =>+ BazSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Baz) (BazSym1 a0123456789876543210) a0123456789876543210 = BazSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BazSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BazSym1KindInference ())+ type BazSym2 :: Nat -> Nat -> (~>) Nat Baz+ data BazSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: (~>) Nat Baz+ where+ BazSym2KindInference :: SameKind (Apply (BazSym2 a0123456789876543210 a0123456789876543210) arg) (BazSym3 a0123456789876543210 a0123456789876543210 arg) =>+ BazSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Baz (BazSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BazSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BazSym2KindInference ())+ type BazSym3 :: Nat -> Nat -> Nat -> Baz+ type family BazSym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Baz where+ BazSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 a0123456789876543210+ type family Let0123456789876543210PSym0 where+ Let0123456789876543210PSym0 = Let0123456789876543210P+ type family Let0123456789876543210P where+ Let0123456789876543210P = NilSym0+ type family Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210+ type family Let0123456789876543210P wild_01234567898765432100123456789876543210 where+ Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) NilSym0+ type family Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210+ type family Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210)+ type family Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210+ type family Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210+ type family Let0123456789876543210PSym0 where+ Let0123456789876543210PSym0 = Let0123456789876543210P+ type family Let0123456789876543210P where+ Let0123456789876543210P = NothingSym0+ type family Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210+ type family Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210)+ type family Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210+ type family Let0123456789876543210X wild_01234567898765432100123456789876543210 where+ Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210+ type family Let0123456789876543210PSym0 where+ Let0123456789876543210PSym0 = Let0123456789876543210P+ type family Let0123456789876543210P where+ Let0123456789876543210P = NothingSym0+ type FooSym0 :: (~>) [Nat] [Nat]+ data FooSym0 :: (~>) [Nat] [Nat]+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @[Nat] @[Nat] FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: [Nat] -> [Nat]+ type family FooSym1 (a0123456789876543210 :: [Nat]) :: [Nat] where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)+ data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)+ where+ TupSym0KindInference :: SameKind (Apply TupSym0 arg) (TupSym1 arg) =>+ TupSym0 a0123456789876543210+ type instance Apply @(Nat, Nat) @(Nat,+ Nat) TupSym0 a0123456789876543210 = Tup a0123456789876543210+ instance SuppressUnusedWarnings TupSym0 where+ suppressUnusedWarnings = snd ((,) TupSym0KindInference ())+ type TupSym1 :: (Nat, Nat) -> (Nat, Nat)+ type family TupSym1 (a0123456789876543210 :: (Nat, Nat)) :: (Nat,+ Nat) where+ TupSym1 a0123456789876543210 = Tup a0123456789876543210+ type Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)+ data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)+ where+ Baz_Sym0KindInference :: SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) =>+ Baz_Sym0 a0123456789876543210+ type instance Apply @(Maybe Baz) @(Maybe Baz) Baz_Sym0 a0123456789876543210 = Baz_ a0123456789876543210+ instance SuppressUnusedWarnings Baz_Sym0 where+ suppressUnusedWarnings = snd ((,) Baz_Sym0KindInference ())+ type Baz_Sym1 :: Maybe Baz -> Maybe Baz+ type family Baz_Sym1 (a0123456789876543210 :: Maybe Baz) :: Maybe Baz where+ Baz_Sym1 a0123456789876543210 = Baz_ a0123456789876543210+ type BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)+ data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @(Maybe Nat) @(Maybe Nat) BarSym0 a0123456789876543210 = Bar a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: Maybe Nat -> Maybe Nat+ type family BarSym1 (a0123456789876543210 :: Maybe Nat) :: Maybe Nat where+ BarSym1 a0123456789876543210 = Bar a0123456789876543210+ type MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)+ data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)+ where+ MaybePlusSym0KindInference :: SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) =>+ MaybePlusSym0 a0123456789876543210+ type instance Apply @(Maybe Nat) @(Maybe Nat) MaybePlusSym0 a0123456789876543210 = MaybePlus a0123456789876543210+ instance SuppressUnusedWarnings MaybePlusSym0 where+ suppressUnusedWarnings = snd ((,) MaybePlusSym0KindInference ())+ type MaybePlusSym1 :: Maybe Nat -> Maybe Nat+ type family MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) :: Maybe Nat where+ MaybePlusSym1 a0123456789876543210 = MaybePlus a0123456789876543210+ type Foo :: [Nat] -> [Nat]+ type family Foo (a :: [Nat]) :: [Nat] where+ Foo '[] = Let0123456789876543210PSym0+ Foo '[wild_0123456789876543210] = Let0123456789876543210PSym0 wild_0123456789876543210+ Foo ('(:) wild_0123456789876543210 ('(:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym0 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210+ type Tup :: (Nat, Nat) -> (Nat, Nat)+ type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where+ Tup '(wild_0123456789876543210,+ wild_0123456789876543210) = Let0123456789876543210PSym0 wild_0123456789876543210 wild_0123456789876543210+ type Baz_ :: Maybe Baz -> Maybe Baz+ type family Baz_ (a :: Maybe Baz) :: Maybe Baz where+ Baz_ 'Nothing = Let0123456789876543210PSym0+ Baz_ ('Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym0 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210+ type Bar :: Maybe Nat -> Maybe Nat+ type family Bar (a :: Maybe Nat) :: Maybe Nat where+ Bar ('Just wild_0123456789876543210) = Let0123456789876543210XSym0 wild_0123456789876543210+ Bar 'Nothing = NothingSym0+ type MaybePlus :: Maybe Nat -> Maybe Nat+ 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 (Foo t :: [Nat]) :: Type)+ sTup ::+ (forall (t :: (Nat, Nat)).+ Sing t -> Sing (Tup t :: (Nat, Nat)) :: Type)+ sBaz_ ::+ (forall (t :: Maybe Baz).+ Sing t -> Sing (Baz_ t :: Maybe Baz) :: Type)+ sBar ::+ (forall (t :: Maybe Nat).+ Sing t -> Sing (Bar t :: Maybe Nat) :: Type)+ sMaybePlus ::+ (forall (t :: Maybe Nat).+ Sing t -> Sing (MaybePlus t :: Maybe Nat) :: Type)+ sFoo SNil+ = let+ sP :: Sing @_ Let0123456789876543210P+ sP = SNil+ in sP+ sFoo+ (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210)+ SNil)+ = let+ sP :: Sing @_ (Let0123456789876543210P 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 @_ (Let0123456789876543210P 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 @_ (Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210)+ sP+ = applySing+ (applySing+ (singFun2 @Tuple2Sym0 STuple2) sWild_0123456789876543210)+ sWild_0123456789876543210+ in sP+ sBaz_ SNothing+ = let+ sP :: Sing @_ Let0123456789876543210P+ 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 @_ (Let0123456789876543210P 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 @_ (Let0123456789876543210X 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 @_ Let0123456789876543210P+ 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 SBaz :: Baz -> Type+ where+ SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat).+ (Sing n) -> (Sing n) -> (Sing n) -> SBaz (Baz n n n :: Baz)+ type instance Sing @Baz = SBaz+ 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))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing (SBaz c c c))+ (toSing b :: SomeSing Nat) (toSing b :: SomeSing Nat)+ (toSing b :: SomeSing Nat)+ instance (SingI n, SingI n, SingI n) =>+ SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where+ sing = SBaz sing sing sing+ instance (SingI n, SingI n) =>+ SingI1 (Baz (n :: Nat) (n :: Nat)) where+ liftSing = SBaz sing sing+ instance SingI n => SingI2 (Baz (n :: Nat)) where+ liftSing2 = SBaz sing+ instance SingI (BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where+ sing = singFun3 @BazSym0 SBaz+ instance SingI d =>+ SingI (BazSym1 (d :: Nat) :: (~>) Nat ((~>) Nat Baz)) where+ sing = singFun2 @(BazSym1 (d :: Nat)) (SBaz (sing @d))+ instance SingI1 (BazSym1 :: Nat -> (~>) Nat ((~>) Nat Baz)) where+ liftSing (s :: Sing (d :: Nat))+ = singFun2 @(BazSym1 (d :: Nat)) (SBaz s)+ 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 =>+ SingI1 (BazSym2 (d :: Nat) :: Nat -> (~>) Nat Baz) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(BazSym2 (d :: Nat) (d :: Nat)) (SBaz (sing @d) s)+ instance SingI2 (BazSym2 :: Nat -> Nat -> (~>) Nat Baz) where+ liftSing2 (s :: Sing (d :: Nat)) (s :: Sing (d :: Nat))+ = singFun1 @(BazSym2 (d :: Nat) (d :: Nat)) (SBaz s s)
tests/compile-and-dump/Singletons/AsPattern.hs view
@@ -1,30 +1,30 @@-module Singletons.AsPattern where - -import Data.List.Singletons -import Data.Maybe.Singletons -import Data.Singletons.Base.TH -import Singletons.Nat - -$(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 - |]) +module Singletons.AsPattern where++import Data.List.Singletons+import Data.Maybe.Singletons+import Data.Singletons.Base.TH+import Singletons.Nat++$(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.golden view
@@ -1,6 +1,6 @@- -Singletons/BadBoundedDeriving.hs:0:0: error: [GHC-39584] - Can't derive Bounded instance for Foo_0 a_1. - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... ++Singletons/BadBoundedDeriving.hs:0:0: error: [GHC-39584]+ Can't derive Bounded instance for Foo_0 a_1.+ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...
tests/compile-and-dump/Singletons/BadBoundedDeriving.hs view
@@ -1,7 +1,7 @@-module Singletons.BadBoundedDeriving where - -import Data.Singletons.TH - -$(singletons [d| - data Foo a = Foo | Bar a deriving (Bounded) - |]) +module Singletons.BadBoundedDeriving where++import Data.Singletons.TH++$(singletons [d|+ data Foo a = Foo | Bar a deriving (Bounded)+ |])
tests/compile-and-dump/Singletons/BadEnumDeriving.golden view
@@ -1,6 +1,6 @@- -Singletons/BadEnumDeriving.hs:0:0: error: [GHC-39584] - Can't derive Enum instance for Foo_0 a_1. - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... ++Singletons/BadEnumDeriving.hs:0:0: error: [GHC-39584]+ Can't derive Enum instance for Foo_0 a_1.+ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...
tests/compile-and-dump/Singletons/BadEnumDeriving.hs view
@@ -1,8 +1,8 @@-module Singletons.BadEnumDeriving where - -import Data.Singletons.TH - -$(singletons [d| - data Foo a = Foo a - deriving Enum - |]) +module Singletons.BadEnumDeriving where++import Data.Singletons.TH++$(singletons [d|+ data Foo a = Foo a+ deriving Enum+ |])
tests/compile-and-dump/Singletons/BoundedDeriving.golden view
@@ -1,291 +1,246 @@-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 family Foo1Sym0 :: Foo1 where - Foo1Sym0 = Foo1 - type ASym0 :: Foo2 - type family ASym0 :: Foo2 where - ASym0 = A - type BSym0 :: Foo2 - type family BSym0 :: Foo2 where - BSym0 = B - type CSym0 :: Foo2 - type family CSym0 :: Foo2 where - CSym0 = C - type DSym0 :: Foo2 - type family DSym0 :: Foo2 where - DSym0 = D - type ESym0 :: Foo2 - type family ESym0 :: Foo2 where - ESym0 = E - type Foo3Sym0 :: forall a. (~>) a (Foo3 a) - data Foo3Sym0 :: (~>) a (Foo3 a) - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: forall a. a -> Foo3 a - type family Foo3Sym1 (a0123456789876543210 :: a) :: Foo3 a where - Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210 - type Foo41Sym0 :: forall (a :: Type) - (b :: Type). Foo4 (a :: Type) (b :: Type) - type family Foo41Sym0 :: Foo4 (a :: Type) (b :: Type) where - Foo41Sym0 = Foo41 - type Foo42Sym0 :: forall (a :: Type) - (b :: Type). Foo4 (a :: Type) (b :: Type) - type family Foo42Sym0 :: Foo4 (a :: Type) (b :: Type) where - Foo42Sym0 = Foo42 - type PairSym0 :: (~>) Bool ((~>) Bool Pair) - data PairSym0 :: (~>) Bool ((~>) Bool Pair) - where - PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 a0123456789876543210 - type instance Apply PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd ((,) PairSym0KindInference ()) - type PairSym1 :: Bool -> (~>) Bool Pair - data PairSym1 (a0123456789876543210 :: Bool) :: (~>) Bool Pair - where - PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) => - PairSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) PairSym1KindInference ()) - type PairSym2 :: Bool -> Bool -> Pair - type family PairSym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Pair where - PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - type MinBound_0123456789876543210 :: Foo1 - type family MinBound_0123456789876543210 :: Foo1 where - MinBound_0123456789876543210 = Foo1Sym0 - type MinBound_0123456789876543210Sym0 :: Foo1 - type family MinBound_0123456789876543210Sym0 :: Foo1 where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: Foo1 - type family MaxBound_0123456789876543210 :: Foo1 where - MaxBound_0123456789876543210 = Foo1Sym0 - type MaxBound_0123456789876543210Sym0 :: Foo1 - type family MaxBound_0123456789876543210Sym0 :: Foo1 where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded Foo1 where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type MinBound_0123456789876543210 :: Foo2 - type family MinBound_0123456789876543210 :: Foo2 where - MinBound_0123456789876543210 = ASym0 - type MinBound_0123456789876543210Sym0 :: Foo2 - type family MinBound_0123456789876543210Sym0 :: Foo2 where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: Foo2 - type family MaxBound_0123456789876543210 :: Foo2 where - MaxBound_0123456789876543210 = ESym0 - type MaxBound_0123456789876543210Sym0 :: Foo2 - type family MaxBound_0123456789876543210Sym0 :: Foo2 where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded Foo2 where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type MinBound_0123456789876543210 :: Foo3 a - type family MinBound_0123456789876543210 :: Foo3 a where - MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0 - type MinBound_0123456789876543210Sym0 :: Foo3 a - type family MinBound_0123456789876543210Sym0 :: Foo3 a where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: Foo3 a - type family MaxBound_0123456789876543210 :: Foo3 a where - MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 :: Foo3 a - type family MaxBound_0123456789876543210Sym0 :: Foo3 a where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded (Foo3 a) where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type MinBound_0123456789876543210 :: Foo4 a b - type family MinBound_0123456789876543210 :: Foo4 a b where - MinBound_0123456789876543210 = Foo41Sym0 - type MinBound_0123456789876543210Sym0 :: Foo4 a b - type family MinBound_0123456789876543210Sym0 :: Foo4 a b where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: Foo4 a b - type family MaxBound_0123456789876543210 :: Foo4 a b where - MaxBound_0123456789876543210 = Foo42Sym0 - type MaxBound_0123456789876543210Sym0 :: Foo4 a b - type family MaxBound_0123456789876543210Sym0 :: Foo4 a b where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded (Foo4 a b) where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type MinBound_0123456789876543210 :: Pair - type family MinBound_0123456789876543210 :: Pair where - MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 - type MinBound_0123456789876543210Sym0 :: Pair - type family MinBound_0123456789876543210Sym0 :: Pair where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: Pair - type family MaxBound_0123456789876543210 :: Pair where - MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 - type MaxBound_0123456789876543210Sym0 :: Pair - type family MaxBound_0123456789876543210Sym0 :: Pair where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded Pair where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - data SFoo1 :: Foo1 -> Type where SFoo1 :: SFoo1 (Foo1 :: Foo1) - type instance Sing @Foo1 = SFoo1 - instance SingKind Foo1 where - type Demote Foo1 = Foo1 - fromSing SFoo1 = Foo1 - toSing Foo1 = SomeSing SFoo1 - data SFoo2 :: Foo2 -> Type - where - SA :: SFoo2 (A :: Foo2) - SB :: SFoo2 (B :: Foo2) - SC :: SFoo2 (C :: Foo2) - SD :: SFoo2 (D :: Foo2) - SE :: SFoo2 (E :: Foo2) - type instance Sing @Foo2 = SFoo2 - 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 SFoo3 :: forall a. Foo3 a -> Type - where - SFoo3 :: forall a (n :: a). (Sing n) -> SFoo3 (Foo3 n :: Foo3 a) - type instance Sing @(Foo3 a) = SFoo3 - 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 SFoo4 :: forall (a :: Type) (b :: Type). Foo4 a b -> Type - where - SFoo41 :: forall (a :: Type) (b :: Type). - SFoo4 (Foo41 :: Foo4 (a :: Type) (b :: Type)) - SFoo42 :: forall (a :: Type) (b :: Type). - SFoo4 (Foo42 :: Foo4 (a :: Type) (b :: Type)) - type instance Sing @(Foo4 a b) = SFoo4 - 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 SPair :: Pair -> Type - where - SPair :: forall (n :: Bool) (n :: Bool). - (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair) - type instance Sing @Pair = SPair - 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 SingI1 Foo3 where - liftSing = SFoo3 - instance SingI (Foo3Sym0 :: (~>) a (Foo3 a)) where - sing = singFun1 @Foo3Sym0 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 n => SingI1 (Pair (n :: Bool)) where - liftSing = SPair sing - instance SingI2 Pair where - liftSing2 = SPair - instance SingI (PairSym0 :: (~>) Bool ((~>) Bool Pair)) where - sing = singFun2 @PairSym0 SPair - instance SingI d => - SingI (PairSym1 (d :: Bool) :: (~>) Bool Pair) where - sing = singFun1 @(PairSym1 (d :: Bool)) (SPair (sing @d)) - instance SingI1 (PairSym1 :: Bool -> (~>) Bool Pair) where - liftSing (s :: Sing (d :: Bool)) - = singFun1 @(PairSym1 (d :: Bool)) (SPair s) +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 family Foo1Sym0 :: Foo1 where+ Foo1Sym0 = Foo1+ type ASym0 :: Foo2+ type family ASym0 :: Foo2 where+ ASym0 = A+ type BSym0 :: Foo2+ type family BSym0 :: Foo2 where+ BSym0 = B+ type CSym0 :: Foo2+ type family CSym0 :: Foo2 where+ CSym0 = C+ type DSym0 :: Foo2+ type family DSym0 :: Foo2 where+ DSym0 = D+ type ESym0 :: Foo2+ type family ESym0 :: Foo2 where+ ESym0 = E+ type Foo3Sym0 :: forall a. (~>) a (Foo3 a)+ data Foo3Sym0 :: (~>) a (Foo3 a)+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @a @(Foo3 a) Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: forall a. a -> Foo3 a+ type family Foo3Sym1 @a (a0123456789876543210 :: a) :: Foo3 a where+ Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210+ type Foo41Sym0 :: forall (a :: Type) (b :: Type). Foo4 a b+ type family Foo41Sym0 @(a :: Type) @(b :: Type) :: Foo4 a b where+ Foo41Sym0 = Foo41+ type Foo42Sym0 :: forall (a :: Type) (b :: Type). Foo4 a b+ type family Foo42Sym0 @(a :: Type) @(b :: Type) :: Foo4 a b where+ Foo42Sym0 = Foo42+ type PairSym0 :: (~>) Bool ((~>) Bool Pair)+ data PairSym0 :: (~>) Bool ((~>) Bool Pair)+ where+ PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) =>+ PairSym0 a0123456789876543210+ type instance Apply @Bool @((~>) Bool Pair) PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210+ instance SuppressUnusedWarnings PairSym0 where+ suppressUnusedWarnings = snd ((,) PairSym0KindInference ())+ type PairSym1 :: Bool -> (~>) Bool Pair+ data PairSym1 (a0123456789876543210 :: Bool) :: (~>) Bool Pair+ where+ PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) =>+ PairSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Pair (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) PairSym1KindInference ())+ type PairSym2 :: Bool -> Bool -> Pair+ type family PairSym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Pair where+ PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ type MinBound_0123456789876543210 :: Foo1+ type family MinBound_0123456789876543210 :: Foo1 where+ MinBound_0123456789876543210 = Foo1Sym0+ type MaxBound_0123456789876543210 :: Foo1+ type family MaxBound_0123456789876543210 :: Foo1 where+ MaxBound_0123456789876543210 = Foo1Sym0+ instance PBounded Foo1 where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type MinBound_0123456789876543210 :: Foo2+ type family MinBound_0123456789876543210 :: Foo2 where+ MinBound_0123456789876543210 = ASym0+ type MaxBound_0123456789876543210 :: Foo2+ type family MaxBound_0123456789876543210 :: Foo2 where+ MaxBound_0123456789876543210 = ESym0+ instance PBounded Foo2 where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type MinBound_0123456789876543210 :: forall a. Foo3 a+ type family MinBound_0123456789876543210 @a :: Foo3 a where+ MinBound_0123456789876543210 @a = Apply Foo3Sym0 MinBoundSym0+ type MaxBound_0123456789876543210 :: forall a. Foo3 a+ type family MaxBound_0123456789876543210 @a :: Foo3 a where+ MaxBound_0123456789876543210 @a = Apply Foo3Sym0 MaxBoundSym0+ instance PBounded (Foo3 a) where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type MinBound_0123456789876543210 :: forall a b. Foo4 a b+ type family MinBound_0123456789876543210 @a @b :: Foo4 a b where+ MinBound_0123456789876543210 @a @b = Foo41Sym0+ type MaxBound_0123456789876543210 :: forall a b. Foo4 a b+ type family MaxBound_0123456789876543210 @a @b :: Foo4 a b where+ MaxBound_0123456789876543210 @a @b = Foo42Sym0+ instance PBounded (Foo4 a b) where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type MinBound_0123456789876543210 :: Pair+ type family MinBound_0123456789876543210 :: Pair where+ MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0+ type MaxBound_0123456789876543210 :: Pair+ type family MaxBound_0123456789876543210 :: Pair where+ MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0+ instance PBounded Pair where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ data SFoo1 :: Foo1 -> Type where SFoo1 :: SFoo1 (Foo1 :: Foo1)+ type instance Sing @Foo1 = SFoo1+ instance SingKind Foo1 where+ type Demote Foo1 = Foo1+ fromSing SFoo1 = Foo1+ toSing Foo1 = SomeSing SFoo1+ data SFoo2 :: Foo2 -> Type+ where+ SA :: SFoo2 (A :: Foo2)+ SB :: SFoo2 (B :: Foo2)+ SC :: SFoo2 (C :: Foo2)+ SD :: SFoo2 (D :: Foo2)+ SE :: SFoo2 (E :: Foo2)+ type instance Sing @Foo2 = SFoo2+ 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 SFoo3 :: forall a. Foo3 a -> Type+ where+ SFoo3 :: forall a (n :: a). (Sing n) -> SFoo3 (Foo3 n :: Foo3 a)+ type instance Sing @(Foo3 a) = SFoo3+ 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))+ = (\cases (SomeSing c) -> SomeSing (SFoo3 c))+ (toSing b :: SomeSing a)+ data SFoo4 :: forall (a :: Type) (b :: Type). Foo4 a b -> Type+ where+ SFoo41 :: forall (a :: Type) (b :: Type). SFoo4 (Foo41 :: Foo4 a b)+ SFoo42 :: forall (a :: Type) (b :: Type). SFoo4 (Foo42 :: Foo4 a b)+ type instance Sing @(Foo4 a b) = SFoo4+ 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 SPair :: Pair -> Type+ where+ SPair :: forall (n :: Bool) (n :: Bool).+ (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair)+ type instance Sing @Pair = SPair+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SPair c c))+ (toSing b :: SomeSing Bool) (toSing b :: SomeSing Bool)+ instance SBounded Foo1 where+ sMinBound = SFoo1+ sMaxBound = SFoo1+ instance SBounded Foo2 where+ sMinBound = SA+ sMaxBound = SE+ instance SBounded a => SBounded (Foo3 a) where+ sMinBound = applySing (singFun1 @Foo3Sym0 SFoo3) sMinBound+ sMaxBound = applySing (singFun1 @Foo3Sym0 SFoo3) sMaxBound+ instance SBounded (Foo4 a b) where+ sMinBound = SFoo41+ sMaxBound = SFoo42+ instance SBounded Bool => SBounded Pair where+ 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 SingI1 Foo3 where+ liftSing = SFoo3+ instance SingI (Foo3Sym0 :: (~>) a (Foo3 a)) where+ sing = singFun1 @Foo3Sym0 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 n => SingI1 (Pair (n :: Bool)) where+ liftSing = SPair sing+ instance SingI2 Pair where+ liftSing2 = SPair+ instance SingI (PairSym0 :: (~>) Bool ((~>) Bool Pair)) where+ sing = singFun2 @PairSym0 SPair+ instance SingI d =>+ SingI (PairSym1 (d :: Bool) :: (~>) Bool Pair) where+ sing = singFun1 @(PairSym1 (d :: Bool)) (SPair (sing @d))+ instance SingI1 (PairSym1 :: Bool -> (~>) Bool Pair) where+ liftSing (s :: Sing (d :: Bool))+ = singFun1 @(PairSym1 (d :: Bool)) (SPair s)
tests/compile-and-dump/Singletons/BoundedDeriving.hs view
@@ -1,52 +1,52 @@-module Singletons.BoundedDeriving where - -import Data.Singletons.TH -import Data.Kind (Type) -import Prelude.Singletons - -$(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 +module Singletons.BoundedDeriving where++import Data.Singletons.TH+import Data.Kind (Type)+import Prelude.Singletons++$(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.golden view
@@ -1,56 +1,56 @@-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 FBoxSym0 :: forall a. (~>) a (Box a) - data FBoxSym0 :: (~>) a (Box a) - where - FBoxSym0KindInference :: SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => - FBoxSym0 a0123456789876543210 - type instance Apply FBoxSym0 a0123456789876543210 = FBox a0123456789876543210 - instance SuppressUnusedWarnings FBoxSym0 where - suppressUnusedWarnings = snd ((,) FBoxSym0KindInference ()) - type FBoxSym1 :: forall a. a -> Box a - type family FBoxSym1 (a0123456789876543210 :: a) :: Box a where - FBoxSym1 a0123456789876543210 = FBox a0123456789876543210 - type UnBoxSym0 :: (~>) (Box a) a - data UnBoxSym0 :: (~>) (Box a) a - where - UnBoxSym0KindInference :: SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => - UnBoxSym0 a0123456789876543210 - type instance Apply UnBoxSym0 a0123456789876543210 = UnBox a0123456789876543210 - instance SuppressUnusedWarnings UnBoxSym0 where - suppressUnusedWarnings = snd ((,) UnBoxSym0KindInference ()) - type UnBoxSym1 :: Box a -> a - type family UnBoxSym1 (a0123456789876543210 :: Box a) :: a where - UnBoxSym1 a0123456789876543210 = UnBox a0123456789876543210 - type UnBox :: Box a -> a - type family UnBox (a :: Box a) :: a where - UnBox (FBox a) = a - sUnBox :: - (forall (t :: Box a). - Sing t -> Sing (Apply UnBoxSym0 t :: a) :: Type) - sUnBox (SFBox (sA :: Sing a)) = sA - instance SingI (UnBoxSym0 :: (~>) (Box a) a) where - sing = singFun1 @UnBoxSym0 sUnBox - data SBox :: forall a. Box a -> Type - where - SFBox :: forall a (n :: a). (Sing n) -> SBox (FBox n :: Box a) - type instance Sing @(Box a) = SBox - 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 SingI1 FBox where - liftSing = SFBox - instance SingI (FBoxSym0 :: (~>) a (Box a)) where - sing = singFun1 @FBoxSym0 SFBox +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 FBoxSym0 :: forall a. (~>) a (Box a)+ data FBoxSym0 :: (~>) a (Box a)+ where+ FBoxSym0KindInference :: SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) =>+ FBoxSym0 a0123456789876543210+ type instance Apply @a @(Box a) FBoxSym0 a0123456789876543210 = FBox a0123456789876543210+ instance SuppressUnusedWarnings FBoxSym0 where+ suppressUnusedWarnings = snd ((,) FBoxSym0KindInference ())+ type FBoxSym1 :: forall a. a -> Box a+ type family FBoxSym1 @a (a0123456789876543210 :: a) :: Box a where+ FBoxSym1 a0123456789876543210 = FBox a0123456789876543210+ type UnBoxSym0 :: (~>) (Box a) a+ data UnBoxSym0 :: (~>) (Box a) a+ where+ UnBoxSym0KindInference :: SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) =>+ UnBoxSym0 a0123456789876543210+ type instance Apply @(Box a) @a UnBoxSym0 a0123456789876543210 = UnBox a0123456789876543210+ instance SuppressUnusedWarnings UnBoxSym0 where+ suppressUnusedWarnings = snd ((,) UnBoxSym0KindInference ())+ type UnBoxSym1 :: Box a -> a+ type family UnBoxSym1 @a (a0123456789876543210 :: Box a) :: a where+ UnBoxSym1 a0123456789876543210 = UnBox a0123456789876543210+ type UnBox :: Box a -> a+ type family UnBox @a (a :: Box a) :: a where+ UnBox (FBox a) = a+ sUnBox ::+ (forall (t :: Box a). Sing t -> Sing (UnBox t :: a) :: Type)+ sUnBox (SFBox (sA :: Sing a)) = sA+ instance SingI (UnBoxSym0 :: (~>) (Box a) a) where+ sing = singFun1 @UnBoxSym0 sUnBox+ data SBox :: forall a. Box a -> Type+ where+ SFBox :: forall a (n :: a). (Sing n) -> SBox (FBox n :: Box a)+ type instance Sing @(Box a) = SBox+ 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))+ = (\cases (SomeSing c) -> SomeSing (SFBox c))+ (toSing b :: SomeSing a)+ instance SingI n => SingI (FBox (n :: a)) where+ sing = SFBox sing+ instance SingI1 FBox where+ liftSing = SFBox+ instance SingI (FBoxSym0 :: (~>) a (Box a)) where+ sing = singFun1 @FBoxSym0 SFBox
tests/compile-and-dump/Singletons/BoxUnBox.hs view
@@ -1,9 +1,9 @@-module Singletons.BoxUnBox where - -import Data.Singletons.TH - -$(singletons [d| - data Box a = FBox a - unBox :: Box a -> a - unBox (FBox a) = a - |]) +module Singletons.BoxUnBox where++import Data.Singletons.TH++$(singletons [d|+ data Box a = FBox a+ unBox :: Box a -> a+ unBox (FBox a) = a+ |])
tests/compile-and-dump/Singletons/CaseExpressions.golden view
@@ -1,325 +1,289 @@-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 arg_0123456789876543210 y x t where - Case_0123456789876543210 arg_0123456789876543210 y x _ = x - type family Lambda_0123456789876543210 y x arg_0123456789876543210 where - Lambda_0123456789876543210 y x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 y x arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 y0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 y0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 y0123456789876543210 = Lambda_0123456789876543210Sym1 y0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 y0123456789876543210) arg) (Lambda_0123456789876543210Sym2 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 y0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 y) x) y - data Let0123456789876543210ZSym0 y0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 y0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - data Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 - where - Let0123456789876543210ZSym1KindInference :: SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => - Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 - type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym1KindInference ()) - type family Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 :: a0123456789876543210 where - Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 - type family Let0123456789876543210Z y x :: a where - Let0123456789876543210Z y x = y - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Let0123456789876543210ZSym2 y x - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 - 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 - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1 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 Foo5Sym0 :: (~>) a a - data Foo5Sym0 :: (~>) a a - where - Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0 a0123456789876543210 - type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ()) - type Foo5Sym1 :: a -> a - type family Foo5Sym1 (a0123456789876543210 :: a) :: a where - Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210 - type Foo4Sym0 :: forall a. (~>) a a - data Foo4Sym0 :: (~>) a a - where - Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0 a0123456789876543210 - type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ()) - type Foo4Sym1 :: forall a. a -> a - type family Foo4Sym1 (a0123456789876543210 :: a) :: a where - Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210 - type Foo3Sym0 :: (~>) a ((~>) b a) - data Foo3Sym0 :: (~>) a ((~>) b a) - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: a -> (~>) b a - data Foo3Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo3Sym1KindInference :: SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => - Foo3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo3Sym1KindInference ()) - type Foo3Sym2 :: a -> b -> a - type family Foo3Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo3Sym2 a0123456789876543210 a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 - type Foo2Sym0 :: (~>) a ((~>) (Maybe a) a) - data Foo2Sym0 :: (~>) a ((~>) (Maybe a) a) - where - Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0 a0123456789876543210 - type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ()) - type Foo2Sym1 :: a -> (~>) (Maybe a) a - data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a - where - Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => - Foo2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ()) - type Foo2Sym2 :: a -> Maybe a -> a - type family Foo2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where - Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - type Foo1Sym0 :: (~>) a ((~>) (Maybe a) a) - data Foo1Sym0 :: (~>) a ((~>) (Maybe a) a) - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: a -> (~>) (Maybe a) a - data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a - where - Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => - Foo1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ()) - type Foo1Sym2 :: a -> Maybe a -> a - type family Foo1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where - Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - type Foo5 :: a -> a - type family Foo5 (a :: a) :: a where - Foo5 x = Case_0123456789876543210 x x - type Foo4 :: forall a. a -> a - type family Foo4 (a :: a) :: a where - Foo4 x = Case_0123456789876543210 x x - type Foo3 :: a -> b -> a - type family Foo3 (a :: a) (a :: b) :: a where - Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) - type Foo2 :: a -> Maybe a -> a - type family Foo2 (a :: a) (a :: Maybe a) :: a where - Foo2 d _ = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) - type Foo1 :: a -> Maybe a -> a - type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Case_0123456789876543210 d x x - sFoo5 :: - (forall (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) :: Type) - sFoo4 :: forall a (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) - sFoo3 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) :: Type) - sFoo2 :: - (forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) :: Type) - sFoo1 :: - (forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) :: Type) - sFoo5 (sX :: Sing x) - = id - @(Sing (Case_0123456789876543210 x x)) - (case sX of - (sY :: Sing y) - -> applySing - (singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 y) x) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of - (_ :: Sing arg_0123456789876543210) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 y x arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sX))) - sY) - sFoo4 (sX :: Sing x) - = id - @(Sing (Case_0123456789876543210 x x)) - (case sX of - (sY :: Sing y) - -> let - sZ :: (Sing (Let0123456789876543210ZSym2 y x :: a) :: Type) - sZ = sY - in sZ) - 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 - id - @(Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b))) - (case sScrutinee_0123456789876543210 of - STuple2 (sP :: Sing p) _ -> sP) - sFoo2 (sD :: Sing d) _ - = let - sScrutinee_0123456789876543210 :: - Sing @_ (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) - sScrutinee_0123456789876543210 - = applySing (singFun1 @JustSym0 SJust) sD - in - id - @(Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d))) - (case sScrutinee_0123456789876543210 of SJust (sY :: Sing y) -> sY) - sFoo1 (sD :: Sing d) (sX :: Sing x) - = id - @(Sing (Case_0123456789876543210 d x x)) - (case sX of - SJust (sY :: Sing y) -> sY - SNothing -> sD) - 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 SingI1 (Foo3Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo3Sym1 (d :: a)) (sFoo3 s) - 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 SingI1 (Foo2Sym1 :: a -> (~>) (Maybe a) a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s) - 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)) - instance SingI1 (Foo1Sym1 :: a -> (~>) (Maybe a) a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s) +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 LamCases_0123456789876543210 y0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 y x _ = x+ data LamCases_0123456789876543210Sym0 y0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 y0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 y0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 y0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 y0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 y0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 y0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 y0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x y = Apply (LamCases_0123456789876543210Sym0 y x) y+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family Let0123456789876543210ZSym0 a0123456789876543210 y0123456789876543210 (x0123456789876543210 :: a0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210ZSym0 a0123456789876543210 y0123456789876543210 x0123456789876543210 = Let0123456789876543210Z a0123456789876543210 y0123456789876543210 x0123456789876543210+ type family Let0123456789876543210Z a0123456789876543210 y0123456789876543210 (x0123456789876543210 :: a0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210Z a y x = y+ type family LamCases_0123456789876543210 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a x y = Let0123456789876543210ZSym0 a y x+ data LamCases_0123456789876543210Sym0 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a b '(p, _) = p+ data LamCases_0123456789876543210Sym0 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (d0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 d ('Just y) = y+ data LamCases_0123456789876543210Sym0 (d0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 d0123456789876543210) arg) (LamCases_0123456789876543210Sym1 d0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 d0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 d0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 d0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (d0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 d0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 d x ('Just y) = y+ LamCases_0123456789876543210 d x 'Nothing = d+ data LamCases_0123456789876543210Sym0 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type Foo5Sym0 :: (~>) a a+ data Foo5Sym0 :: (~>) a a+ where+ Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>+ Foo5Sym0 a0123456789876543210+ type instance Apply @a @a Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210+ instance SuppressUnusedWarnings Foo5Sym0 where+ suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ())+ type Foo5Sym1 :: a -> a+ type family Foo5Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210+ type Foo4Sym0 :: forall a. (~>) a a+ data Foo4Sym0 :: (~>) a a+ where+ Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>+ Foo4Sym0 a0123456789876543210+ type instance Apply @a @a Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210+ instance SuppressUnusedWarnings Foo4Sym0 where+ suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ())+ type Foo4Sym1 :: forall a. a -> a+ type family Foo4Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210+ type Foo3Sym0 :: (~>) a ((~>) b a)+ data Foo3Sym0 :: (~>) a ((~>) b a)+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: a -> (~>) b a+ data Foo3Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo3Sym1KindInference :: SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) =>+ Foo3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo3Sym1KindInference ())+ type Foo3Sym2 :: a -> b -> a+ type family Foo3Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo3Sym2 a0123456789876543210 a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210+ type Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)+ data Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)+ where+ Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>+ Foo2Sym0 a0123456789876543210+ type instance Apply @a @((~>) (Maybe a) a) Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo2Sym0 where+ suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ())+ type Foo2Sym1 :: a -> (~>) (Maybe a) a+ data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a+ where+ Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>+ Foo2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @a (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ())+ type Foo2Sym2 :: a -> Maybe a -> a+ type family Foo2Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where+ Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ type Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)+ data Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @a @((~>) (Maybe a) a) Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: a -> (~>) (Maybe a) a+ data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a+ where+ Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>+ Foo1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @a (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ())+ type Foo1Sym2 :: a -> Maybe a -> a+ type family Foo1Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where+ Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ type Foo5 :: a -> a+ type family Foo5 @a (a :: a) :: a where+ Foo5 x = Apply (LamCases_0123456789876543210Sym0 x) x+ type Foo4 :: forall a. a -> a+ type family Foo4 @a (a :: a) :: a where+ Foo4 @a (x :: a) = Apply (LamCases_0123456789876543210Sym0 a x) x+ type Foo3 :: a -> b -> a+ type family Foo3 @a @b (a :: a) (a :: b) :: a where+ Foo3 a b = Apply (LamCases_0123456789876543210Sym0 a b) (Apply (Apply Tuple2Sym0 a) b)+ type Foo2 :: a -> Maybe a -> a+ type family Foo2 @a (a :: a) (a :: Maybe a) :: a where+ Foo2 d _ = Apply (LamCases_0123456789876543210Sym0 d) (Apply JustSym0 d)+ type Foo1 :: a -> Maybe a -> a+ type family Foo1 @a (a :: a) (a :: Maybe a) :: a where+ Foo1 d x = Apply (LamCases_0123456789876543210Sym0 d x) x+ sFoo5 :: (forall (t :: a). Sing t -> Sing (Foo5 t :: a) :: Type)+ sFoo4 :: forall a (t :: a). Sing t -> Sing (Foo4 t :: a)+ sFoo3 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo3 t t :: a) :: Type)+ sFoo2 ::+ (forall (t :: a) (t :: Maybe a).+ Sing t -> Sing t -> Sing (Foo2 t t :: a) :: Type)+ sFoo1 ::+ (forall (t :: a) (t :: Maybe a).+ Sing t -> Sing t -> Sing (Foo1 t t :: a) :: Type)+ sFoo5 (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases+ (sY :: Sing y)+ -> applySing+ (singFun1 @(LamCases_0123456789876543210Sym0 y x) (\cases _ -> sX))+ sY))+ sX+ sFoo4 (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a x)+ (\cases+ (sY :: Sing y)+ -> let+ sZ :: (Sing (Let0123456789876543210Z a y x :: a) :: Type)+ sZ = sY+ in sZ))+ sX+ sFoo3 (sA :: Sing a) (sB :: Sing b)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a b)+ (\cases (STuple2 (sP :: Sing p) _) -> sP))+ (applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sA) sB)+ sFoo2 (sD :: Sing d) _+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 d)+ (\cases (SJust (sY :: Sing y)) -> sY))+ (applySing (singFun1 @JustSym0 SJust) sD)+ sFoo1 (sD :: Sing d) (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 d x)+ (\cases+ (SJust (sY :: Sing y)) -> sY+ SNothing -> sD))+ sX+ 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 SingI1 (Foo3Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo3Sym1 (d :: a)) (sFoo3 s)+ 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 SingI1 (Foo2Sym1 :: a -> (~>) (Maybe a) a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s)+ 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))+ instance SingI1 (Foo1Sym1 :: a -> (~>) (Maybe a) a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s)
tests/compile-and-dump/Singletons/CaseExpressions.hs view
@@ -1,64 +1,64 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Singletons.CaseExpressions where - -import Data.Maybe.Singletons -import Data.Singletons.Base.TH - -$(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 +{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++module Singletons.CaseExpressions where++import Data.Maybe.Singletons+import Data.Singletons.Base.TH++$(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.golden view
@@ -1,616 +1,411 @@-Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| 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 - infix 4 <=> - (<=>) = mycompare - 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 :: Foo - type family ASym0 :: Foo where - ASym0 = A - type BSym0 :: Foo - type family BSym0 :: Foo where - BSym0 = B - type FSym0 :: Foo2 - type family FSym0 :: Foo2 where - FSym0 = F - type GSym0 :: Foo2 - type family GSym0 :: Foo2 where - GSym0 = G - type FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) - data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) - where - FooCompareSym0KindInference :: SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => - FooCompareSym0 a0123456789876543210 - type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210 - instance SuppressUnusedWarnings FooCompareSym0 where - suppressUnusedWarnings = snd ((,) FooCompareSym0KindInference ()) - type FooCompareSym1 :: Foo -> (~>) Foo Ordering - data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering - where - FooCompareSym1KindInference :: SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) => - FooCompareSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FooCompareSym1KindInference ()) - type FooCompareSym2 :: Foo -> Foo -> Ordering - type family FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Ordering where - FooCompareSym2 a0123456789876543210 a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210 - type ConstSym0 :: (~>) a ((~>) b a) - data ConstSym0 :: (~>) a ((~>) b a) - where - ConstSym0KindInference :: SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => - ConstSym0 a0123456789876543210 - type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210 - instance SuppressUnusedWarnings ConstSym0 where - suppressUnusedWarnings = snd ((,) ConstSym0KindInference ()) - type ConstSym1 :: a -> (~>) b a - data ConstSym1 (a0123456789876543210 :: a) :: (~>) b a - where - ConstSym1KindInference :: SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) => - ConstSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ConstSym1 a0123456789876543210) a0123456789876543210 = Const a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ConstSym1KindInference ()) - type ConstSym2 :: a -> b -> a - type family ConstSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - ConstSym2 a0123456789876543210 a0123456789876543210 = Const a0123456789876543210 a0123456789876543210 - type FooCompare :: Foo -> Foo -> Ordering - 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 Const :: a -> b -> a - type family Const (a :: a) (a :: b) :: a where - Const x _ = x - type MycompareSym0 :: forall a. (~>) a ((~>) a Ordering) - data MycompareSym0 :: (~>) a ((~>) a Ordering) - where - MycompareSym0KindInference :: SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => - MycompareSym0 a0123456789876543210 - type instance Apply MycompareSym0 a0123456789876543210 = MycompareSym1 a0123456789876543210 - instance SuppressUnusedWarnings MycompareSym0 where - suppressUnusedWarnings = snd ((,) MycompareSym0KindInference ()) - type MycompareSym1 :: forall a. a -> (~>) a Ordering - data MycompareSym1 (a0123456789876543210 :: a) :: (~>) a Ordering - where - MycompareSym1KindInference :: SameKind (Apply (MycompareSym1 a0123456789876543210) arg) (MycompareSym2 a0123456789876543210 arg) => - MycompareSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MycompareSym1 a0123456789876543210) a0123456789876543210 = Mycompare a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MycompareSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MycompareSym1KindInference ()) - type MycompareSym2 :: forall a. a -> a -> Ordering - type family MycompareSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where - MycompareSym2 a0123456789876543210 a0123456789876543210 = Mycompare a0123456789876543210 a0123456789876543210 - type (<=>@#@$) :: forall a. (~>) a ((~>) a Ordering) - data (<=>@#@$) :: (~>) a ((~>) a Ordering) - where - (:<=>@#@$###) :: SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => - (<=>@#@$) a0123456789876543210 - type instance Apply (<=>@#@$) a0123456789876543210 = (<=>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<=>@#@$) where - suppressUnusedWarnings = snd ((,) (:<=>@#@$###) ()) - infix 4 <=>@#@$ - type (<=>@#@$$) :: forall a. a -> (~>) a Ordering - data (<=>@#@$$) (a0123456789876543210 :: a) :: (~>) a Ordering - where - (:<=>@#@$$###) :: SameKind (Apply ((<=>@#@$$) a0123456789876543210) arg) ((<=>@#@$$$) a0123456789876543210 arg) => - (<=>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<=>@#@$$) a0123456789876543210) a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<=>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<=>@#@$$###) ()) - infix 4 <=>@#@$$ - type (<=>@#@$$$) :: forall a. a -> a -> Ordering - type family (<=>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where - (<=>@#@$$$) a0123456789876543210 a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210 - infix 4 <=>@#@$$$ - type TFHelper_0123456789876543210 :: a -> a -> Ordering - 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_0123456789876543210Sym0 :: (~>) a ((~>) a Ordering) - data TFHelper_0123456789876543210Sym0 :: (~>) a ((~>) a Ordering) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: a -> (~>) a Ordering - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) a Ordering - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: a -> a -> Ordering - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - class PMyOrd a where - type family Mycompare (arg :: a) (arg :: a) :: Ordering - type family (<=>) (arg :: a) (arg :: a) :: Ordering - type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Mycompare_0123456789876543210 :: Nat -> Nat -> Ordering - 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_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: Nat -> (~>) Nat Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: Nat -> Nat -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd Nat where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type Mycompare_0123456789876543210 :: () -> () -> Ordering - type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where - Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 - type Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: () -> (~>) () Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: ()) :: (~>) () Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: () -> () -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd () where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type Mycompare_0123456789876543210 :: Foo -> Foo -> Ordering - 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_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: Foo -> (~>) Foo Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: Foo -> Foo -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd Foo where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type TFHelper_0123456789876543210 :: Foo2 -> Foo2 -> Bool - 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_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Foo2 -> (~>) Foo2 Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Foo2 -> Foo2 -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Foo2 where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - sFooCompare :: - (forall (t :: Foo) (t :: Foo). - Sing t - -> Sing t - -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) :: Type) - sConst :: - (forall (t :: a) (t :: b). - Sing t - -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) :: Type) - 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 SingI1 (FooCompareSym1 :: Foo -> (~>) Foo Ordering) where - liftSing (s :: Sing (d :: Foo)) - = singFun1 @(FooCompareSym1 (d :: Foo)) (sFooCompare s) - 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)) - instance SingI1 (ConstSym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(ConstSym1 (d :: a)) (sConst s) - data SFoo :: Foo -> Type - where - SA :: SFoo (A :: Foo) - SB :: SFoo (B :: Foo) - type instance Sing @Foo = SFoo - instance SingKind Foo where - type Demote Foo = Foo - fromSing SA = A - fromSing SB = B - toSing A = SomeSing SA - toSing B = SomeSing SB - data SFoo2 :: Foo2 -> Type - where - SF :: SFoo2 (F :: Foo2) - SG :: SFoo2 (G :: Foo2) - type instance Sing @Foo2 = SFoo2 - 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) :: Type) - (%<=>) :: - (forall (t :: a) (t :: a). - Sing t - -> Sing t - -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) :: Type) - infix 4 %<=> - 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) :: Type) - (%<=>) - (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) :: Type) - 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) :: Type) - 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) :: Type) - 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 (t1 :: Foo2) (t2 :: Foo2). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Foo2 ((~>) Foo2 Bool) - -> Type) t1) t2) - (%==) 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 => - SingI1 (MycompareSym1 :: a -> (~>) a Ordering) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MycompareSym1 (d :: a)) (sMycompare s) - 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)) - instance SMyOrd a => - SingI1 ((<=>@#@$$) :: a -> (~>) a Ordering) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((<=>@#@$$) (d :: a)) ((%<=>) s) -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 Mycompare_0123456789876543210 :: Foo2 -> Foo2 -> Ordering - type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Mycompare_0123456789876543210 'F 'F = EQSym0 - Mycompare_0123456789876543210 'F _ = LTSym0 - Mycompare_0123456789876543210 _ _ = GTSym0 - type Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: Foo2 - -> (~>) Foo2 Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: Foo2 -> Foo2 -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd Foo2 where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Foo2 -> Foo2 -> Ordering - type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where - Compare_0123456789876543210 'F 'F = EQSym0 - Compare_0123456789876543210 'F _ = LTSym0 - Compare_0123456789876543210 _ _ = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Foo2 -> (~>) Foo2 Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Foo2 -> Foo2 -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 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 :: Nat' - type family Zero'Sym0 :: Nat' where - Zero'Sym0 = Zero' - type Succ'Sym0 :: (~>) Nat' Nat' - data Succ'Sym0 :: (~>) Nat' Nat' - where - Succ'Sym0KindInference :: SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => - Succ'Sym0 a0123456789876543210 - type instance Apply Succ'Sym0 a0123456789876543210 = Succ' a0123456789876543210 - instance SuppressUnusedWarnings Succ'Sym0 where - suppressUnusedWarnings = snd ((,) Succ'Sym0KindInference ()) - type Succ'Sym1 :: Nat' -> Nat' - type family Succ'Sym1 (a0123456789876543210 :: Nat') :: Nat' where - Succ'Sym1 a0123456789876543210 = Succ' a0123456789876543210 - type Mycompare_0123456789876543210 :: Nat' -> Nat' -> Ordering - 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_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: Nat' - -> (~>) Nat' Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat') :: (~>) Nat' Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: Nat' -> Nat' -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd Nat' where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - data SNat' :: Nat' -> Type - where - SZero' :: SNat' (Zero' :: Nat') - SSucc' :: forall (n :: Nat'). (Sing n) -> SNat' (Succ' n :: Nat') - type instance Sing @Nat' = SNat' - 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) - -> 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 SingI1 Succ' where - liftSing = SSucc' - instance SingI (Succ'Sym0 :: (~>) Nat' Nat') where - sing = singFun1 @Succ'Sym0 SSucc' +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| const :: a -> b -> a+ const x _ = x+ fooCompare :: Foo -> Foo -> Ordering+ fooCompare A A = EQ+ fooCompare A B = LT+ fooCompare B B = GT+ fooCompare B A = EQ+ + class MyOrd a where+ mycompare :: a -> a -> Ordering+ (<=>) :: a -> a -> Ordering+ (<=>) = mycompare+ infix 4 <=>+ data Foo = A | B+ data Foo2 = F | G+ + instance Eq Foo2 where+ F == F = True+ G == G = True+ F == G = False+ G == F = False+ instance MyOrd Foo where+ mycompare = fooCompare+ instance MyOrd () where+ mycompare _ = const EQ+ instance MyOrd Nat where+ Zero `mycompare` Zero = EQ+ Zero `mycompare` (Succ _) = LT+ (Succ _) `mycompare` Zero = GT+ (Succ n) `mycompare` (Succ m) = m `mycompare` n |]+ ======>+ const :: a -> b -> a+ const x _ = x+ class MyOrd a where+ mycompare :: a -> a -> Ordering+ (<=>) :: a -> a -> Ordering+ infix 4 <=>+ (<=>) = mycompare+ 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 :: Foo+ type family ASym0 :: Foo where+ ASym0 = A+ type BSym0 :: Foo+ type family BSym0 :: Foo where+ BSym0 = B+ type FSym0 :: Foo2+ type family FSym0 :: Foo2 where+ FSym0 = F+ type GSym0 :: Foo2+ type family GSym0 :: Foo2 where+ GSym0 = G+ type FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)+ data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)+ where+ FooCompareSym0KindInference :: SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) =>+ FooCompareSym0 a0123456789876543210+ type instance Apply @Foo @((~>) Foo Ordering) FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210+ instance SuppressUnusedWarnings FooCompareSym0 where+ suppressUnusedWarnings = snd ((,) FooCompareSym0KindInference ())+ type FooCompareSym1 :: Foo -> (~>) Foo Ordering+ data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering+ where+ FooCompareSym1KindInference :: SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) =>+ FooCompareSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Foo @Ordering (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooCompareSym1KindInference ())+ type FooCompareSym2 :: Foo -> Foo -> Ordering+ type family FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Ordering where+ FooCompareSym2 a0123456789876543210 a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210+ type ConstSym0 :: (~>) a ((~>) b a)+ data ConstSym0 :: (~>) a ((~>) b a)+ where+ ConstSym0KindInference :: SameKind (Apply ConstSym0 arg) (ConstSym1 arg) =>+ ConstSym0 a0123456789876543210+ type instance Apply @a @((~>) b a) ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210+ instance SuppressUnusedWarnings ConstSym0 where+ suppressUnusedWarnings = snd ((,) ConstSym0KindInference ())+ type ConstSym1 :: a -> (~>) b a+ data ConstSym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ ConstSym1KindInference :: SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) =>+ ConstSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (ConstSym1 a0123456789876543210) a0123456789876543210 = Const a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ConstSym1KindInference ())+ type ConstSym2 :: a -> b -> a+ type family ConstSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ ConstSym2 a0123456789876543210 a0123456789876543210 = Const a0123456789876543210 a0123456789876543210+ type FooCompare :: Foo -> Foo -> Ordering+ 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 Const :: a -> b -> a+ type family Const @a @b (a :: a) (a :: b) :: a where+ Const x _ = x+ type MycompareSym0 :: forall a. (~>) a ((~>) a Ordering)+ data MycompareSym0 :: (~>) a ((~>) a Ordering)+ where+ MycompareSym0KindInference :: SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) =>+ MycompareSym0 a0123456789876543210+ type instance Apply @a @((~>) a Ordering) MycompareSym0 a0123456789876543210 = MycompareSym1 a0123456789876543210+ instance SuppressUnusedWarnings MycompareSym0 where+ suppressUnusedWarnings = snd ((,) MycompareSym0KindInference ())+ type MycompareSym1 :: forall a. a -> (~>) a Ordering+ data MycompareSym1 (a0123456789876543210 :: a) :: (~>) a Ordering+ where+ MycompareSym1KindInference :: SameKind (Apply (MycompareSym1 a0123456789876543210) arg) (MycompareSym2 a0123456789876543210 arg) =>+ MycompareSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @Ordering (MycompareSym1 a0123456789876543210) a0123456789876543210 = Mycompare a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MycompareSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MycompareSym1KindInference ())+ type MycompareSym2 :: forall a. a -> a -> Ordering+ type family MycompareSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where+ MycompareSym2 a0123456789876543210 a0123456789876543210 = Mycompare a0123456789876543210 a0123456789876543210+ type (<=>@#@$) :: forall a. (~>) a ((~>) a Ordering)+ data (<=>@#@$) :: (~>) a ((~>) a Ordering)+ where+ (:<=>@#@$###) :: SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>+ (<=>@#@$) a0123456789876543210+ type instance Apply @a @((~>) a Ordering) (<=>@#@$) a0123456789876543210 = (<=>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<=>@#@$) where+ suppressUnusedWarnings = snd ((,) (:<=>@#@$###) ())+ infix 4 type <=>@#@$+ type (<=>@#@$$) :: forall a. a -> (~>) a Ordering+ data (<=>@#@$$) (a0123456789876543210 :: a) :: (~>) a Ordering+ where+ (:<=>@#@$$###) :: SameKind (Apply ((<=>@#@$$) a0123456789876543210) arg) ((<=>@#@$$$) a0123456789876543210 arg) =>+ (<=>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @Ordering ((<=>@#@$$) a0123456789876543210) a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<=>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<=>@#@$$###) ())+ infix 4 type <=>@#@$$+ type (<=>@#@$$$) :: forall a. a -> a -> Ordering+ type family (<=>@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where+ (<=>@#@$$$) a0123456789876543210 a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210+ infix 4 type <=>@#@$$$+ type TFHelper_0123456789876543210 :: forall a. a -> a -> Ordering+ type family TFHelper_0123456789876543210 @a (a :: a) (a :: a) :: Ordering where+ TFHelper_0123456789876543210 @a (a_0123456789876543210 :: a) (a_0123456789876543210 :: a) = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210+ class PMyOrd a where+ type family Mycompare (arg :: a) (arg :: a) :: Ordering+ type family (<=>) (arg :: a) (arg :: a) :: Ordering+ type (<=>) a a = TFHelper_0123456789876543210 a a+ type Mycompare_0123456789876543210 :: Nat -> Nat -> Ordering+ 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+ instance PMyOrd Nat where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ type Mycompare_0123456789876543210 :: () -> () -> Ordering+ type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where+ Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210+ instance PMyOrd () where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ type Mycompare_0123456789876543210 :: Foo -> Foo -> Ordering+ type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where+ Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210+ instance PMyOrd Foo where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ type TFHelper_0123456789876543210 :: Foo2 -> Foo2 -> Bool+ 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+ instance PEq Foo2 where+ type (==) a a = TFHelper_0123456789876543210 a a+ sFooCompare ::+ (forall (t :: Foo) (t :: Foo).+ Sing t -> Sing t -> Sing (FooCompare t t :: Ordering) :: Type)+ sConst ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Const t t :: a) :: Type)+ 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 SingI1 (FooCompareSym1 :: Foo -> (~>) Foo Ordering) where+ liftSing (s :: Sing (d :: Foo))+ = singFun1 @(FooCompareSym1 (d :: Foo)) (sFooCompare s)+ 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))+ instance SingI1 (ConstSym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(ConstSym1 (d :: a)) (sConst s)+ data SFoo :: Foo -> Type+ where+ SA :: SFoo (A :: Foo)+ SB :: SFoo (B :: Foo)+ type instance Sing @Foo = SFoo+ instance SingKind Foo where+ type Demote Foo = Foo+ fromSing SA = A+ fromSing SB = B+ toSing A = SomeSing SA+ toSing B = SomeSing SB+ data SFoo2 :: Foo2 -> Type+ where+ SF :: SFoo2 (F :: Foo2)+ SG :: SFoo2 (G :: Foo2)+ type instance Sing @Foo2 = SFoo2+ 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 (Mycompare t t :: Ordering) :: Type)+ (%<=>) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((<=>) t t :: Ordering) :: Type)+ infix 4 data %<=>+ default (%<=>) ::+ (forall (t :: a) (t :: a).+ (((<=>) t t :: Ordering) ~ TFHelper_0123456789876543210 t t) =>+ Sing t -> Sing t -> Sing ((<=>) t t :: Ordering) :: Type)+ (%<=>)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2 @MycompareSym0 sMycompare) sA_0123456789876543210)+ sA_0123456789876543210+ instance SMyOrd Nat where+ 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 _ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing (singFun2 @ConstSym0 sConst) SEQ) sA_0123456789876543210+ instance SMyOrd Foo where+ sMycompare+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2 @FooCompareSym0 sFooCompare) sA_0123456789876543210)+ sA_0123456789876543210+ instance SEq Foo2 where+ (%==) 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 =>+ SingI1 (MycompareSym1 :: a -> (~>) a Ordering) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MycompareSym1 (d :: a)) (sMycompare s)+ 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))+ instance SMyOrd a =>+ SingI1 ((<=>@#@$$) :: a -> (~>) a Ordering) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((<=>@#@$$) (d :: a)) ((%<=>) s)+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 Mycompare_0123456789876543210 :: Foo2 -> Foo2 -> Ordering+ type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where+ Mycompare_0123456789876543210 'F 'F = EQSym0+ Mycompare_0123456789876543210 'F _ = LTSym0+ Mycompare_0123456789876543210 _ _ = GTSym0+ instance PMyOrd Foo2 where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ type Compare_0123456789876543210 :: Foo2 -> Foo2 -> Ordering+ type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where+ Compare_0123456789876543210 'F 'F = EQSym0+ Compare_0123456789876543210 'F _ = LTSym0+ Compare_0123456789876543210 _ _ = GTSym0+ instance POrd Foo2 where+ type Compare a a = Compare_0123456789876543210 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 :: Nat'+ type family Zero'Sym0 :: Nat' where+ Zero'Sym0 = Zero'+ type Succ'Sym0 :: (~>) Nat' Nat'+ data Succ'Sym0 :: (~>) Nat' Nat'+ where+ Succ'Sym0KindInference :: SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) =>+ Succ'Sym0 a0123456789876543210+ type instance Apply @Nat' @Nat' Succ'Sym0 a0123456789876543210 = Succ' a0123456789876543210+ instance SuppressUnusedWarnings Succ'Sym0 where+ suppressUnusedWarnings = snd ((,) Succ'Sym0KindInference ())+ type Succ'Sym1 :: Nat' -> Nat'+ type family Succ'Sym1 (a0123456789876543210 :: Nat') :: Nat' where+ Succ'Sym1 a0123456789876543210 = Succ' a0123456789876543210+ type Mycompare_0123456789876543210 :: Nat' -> Nat' -> Ordering+ 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+ instance PMyOrd Nat' where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ data SNat' :: Nat' -> Type+ where+ SZero' :: SNat' (Zero' :: Nat')+ SSucc' :: forall (n :: Nat'). (Sing n) -> SNat' (Succ' n :: Nat')+ type instance Sing @Nat' = SNat'+ 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'))+ = (\cases (SomeSing c) -> SomeSing (SSucc' c))+ (toSing b :: SomeSing Nat')+ instance SMyOrd Nat' where+ 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 SingI1 Succ' where+ liftSing = SSucc'+ instance SingI (Succ'Sym0 :: (~>) Nat' Nat') where+ sing = singFun1 @Succ'Sym0 SSucc'
tests/compile-and-dump/Singletons/Classes.hs view
@@ -1,97 +1,97 @@-module Singletons.Classes where - -import Data.Eq.Singletons -import Data.Ord.Singletons -import Data.Singletons.Base.TH -import Language.Haskell.TH.Desugar -import Prelude hiding (const) -import Singletons.Nat - -$(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 +module Singletons.Classes where++import Data.Eq.Singletons+import Data.Ord.Singletons+import Data.Singletons.Base.TH+import Language.Haskell.TH.Desugar+import Prelude hiding (const)+import Singletons.Nat++$(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.golden view
@@ -1,94 +1,66 @@-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 :: NatFoo - type family ZeroFooSym0 :: NatFoo where - ZeroFooSym0 = ZeroFoo - type SuccFooSym0 :: (~>) NatFoo NatFoo - data SuccFooSym0 :: (~>) NatFoo NatFoo - where - SuccFooSym0KindInference :: SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => - SuccFooSym0 a0123456789876543210 - type instance Apply SuccFooSym0 a0123456789876543210 = SuccFoo a0123456789876543210 - instance SuppressUnusedWarnings SuccFooSym0 where - suppressUnusedWarnings = snd ((,) SuccFooSym0KindInference ()) - type SuccFooSym1 :: NatFoo -> NatFoo - type family SuccFooSym1 (a0123456789876543210 :: NatFoo) :: NatFoo where - SuccFooSym1 a0123456789876543210 = SuccFoo a0123456789876543210 - type Mycompare_0123456789876543210 :: NatFoo -> NatFoo -> Ordering - 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_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) - data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym0KindInference ()) - type Mycompare_0123456789876543210Sym1 :: NatFoo - -> (~>) NatFoo Ordering - data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: NatFoo) :: (~>) NatFoo Ordering - where - Mycompare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Mycompare_0123456789876543210Sym1KindInference ()) - type Mycompare_0123456789876543210Sym2 :: NatFoo - -> NatFoo -> Ordering - type family Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) :: Ordering where - Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PMyOrd NatFoo where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - data SNatFoo :: NatFoo -> Type - where - SZeroFoo :: SNatFoo (ZeroFoo :: NatFoo) - SSuccFoo :: forall (n :: NatFoo). - (Sing n) -> SNatFoo (SuccFoo n :: NatFoo) - type instance Sing @NatFoo = SNatFoo - 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) - -> 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 SingI1 SuccFoo where - liftSing = SSuccFoo - instance SingI (SuccFooSym0 :: (~>) NatFoo NatFoo) where - sing = singFun1 @SuccFooSym0 SSuccFoo +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 :: NatFoo+ type family ZeroFooSym0 :: NatFoo where+ ZeroFooSym0 = ZeroFoo+ type SuccFooSym0 :: (~>) NatFoo NatFoo+ data SuccFooSym0 :: (~>) NatFoo NatFoo+ where+ SuccFooSym0KindInference :: SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) =>+ SuccFooSym0 a0123456789876543210+ type instance Apply @NatFoo @NatFoo SuccFooSym0 a0123456789876543210 = SuccFoo a0123456789876543210+ instance SuppressUnusedWarnings SuccFooSym0 where+ suppressUnusedWarnings = snd ((,) SuccFooSym0KindInference ())+ type SuccFooSym1 :: NatFoo -> NatFoo+ type family SuccFooSym1 (a0123456789876543210 :: NatFoo) :: NatFoo where+ SuccFooSym1 a0123456789876543210 = SuccFoo a0123456789876543210+ type Mycompare_0123456789876543210 :: NatFoo -> NatFoo -> Ordering+ 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+ instance PMyOrd NatFoo where+ type Mycompare a a = Mycompare_0123456789876543210 a a+ data SNatFoo :: NatFoo -> Type+ where+ SZeroFoo :: SNatFoo (ZeroFoo :: NatFoo)+ SSuccFoo :: forall (n :: NatFoo).+ (Sing n) -> SNatFoo (SuccFoo n :: NatFoo)+ type instance Sing @NatFoo = SNatFoo+ 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))+ = (\cases (SomeSing c) -> SomeSing (SSuccFoo c))+ (toSing b :: SomeSing NatFoo)+ instance SMyOrd NatFoo where+ 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 SingI1 SuccFoo where+ liftSing = SSuccFoo+ instance SingI (SuccFooSym0 :: (~>) NatFoo NatFoo) where+ sing = singFun1 @SuccFooSym0 SSuccFoo
tests/compile-and-dump/Singletons/Classes2.hs view
@@ -1,21 +1,21 @@-module Singletons.Classes2 where - -import Data.Ord.Singletons (EQSym0, LTSym0, GTSym0, Sing(..)) -import Data.Singletons.Base.TH -import Language.Haskell.TH.Desugar -import Prelude hiding (const) -import Singletons.Classes -import Singletons.Nat - - -$(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 - |]) +module Singletons.Classes2 where++import Data.Ord.Singletons (EQSym0, LTSym0, GTSym0, Sing(..))+import Data.Singletons.Base.TH+import Language.Haskell.TH.Desugar+import Prelude hiding (const)+import Singletons.Classes+import Singletons.Nat+++$(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.golden view
@@ -1,53 +1,51 @@-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 ContainsSym0 :: (~>) a ((~>) [a] Bool) - data ContainsSym0 :: (~>) a ((~>) [a] Bool) - where - ContainsSym0KindInference :: SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => - ContainsSym0 a0123456789876543210 - type instance Apply ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210 - instance SuppressUnusedWarnings ContainsSym0 where - suppressUnusedWarnings = snd ((,) ContainsSym0KindInference ()) - type ContainsSym1 :: a -> (~>) [a] Bool - data ContainsSym1 (a0123456789876543210 :: a) :: (~>) [a] Bool - where - ContainsSym1KindInference :: SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) => - ContainsSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ContainsSym1KindInference ()) - type ContainsSym2 :: a -> [a] -> Bool - type family ContainsSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: [a]) :: Bool where - ContainsSym2 a0123456789876543210 a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210 - type Contains :: a -> [a] -> Bool - type family Contains (a :: a) (a :: [a]) :: Bool where - Contains _ '[] = FalseSym0 - Contains elt ('(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t) - sContains :: - (forall (t :: a) (t :: [a]). - SEq a => - Sing t - -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) :: Type) - 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)) - instance SEq a => SingI1 (ContainsSym1 :: a -> (~>) [a] Bool) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(ContainsSym1 (d :: a)) (sContains s) +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 ContainsSym0 :: (~>) a ((~>) [a] Bool)+ data ContainsSym0 :: (~>) a ((~>) [a] Bool)+ where+ ContainsSym0KindInference :: SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) =>+ ContainsSym0 a0123456789876543210+ type instance Apply @a @((~>) [a] Bool) ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210+ instance SuppressUnusedWarnings ContainsSym0 where+ suppressUnusedWarnings = snd ((,) ContainsSym0KindInference ())+ type ContainsSym1 :: a -> (~>) [a] Bool+ data ContainsSym1 (a0123456789876543210 :: a) :: (~>) [a] Bool+ where+ ContainsSym1KindInference :: SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) =>+ ContainsSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[a] @Bool (ContainsSym1 a0123456789876543210) a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ContainsSym1KindInference ())+ type ContainsSym2 :: a -> [a] -> Bool+ type family ContainsSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: [a]) :: Bool where+ ContainsSym2 a0123456789876543210 a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210+ type Contains :: a -> [a] -> Bool+ type family Contains @a (a :: a) (a :: [a]) :: Bool where+ Contains _ '[] = FalseSym0+ Contains elt ('(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t)+ sContains ::+ (forall (t :: a) (t :: [a]).+ SEq a => Sing t -> Sing t -> Sing (Contains t t :: Bool) :: Type)+ 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))+ instance SEq a => SingI1 (ContainsSym1 :: a -> (~>) [a] Bool) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(ContainsSym1 (d :: a)) (sContains s)
tests/compile-and-dump/Singletons/Contains.hs view
@@ -1,12 +1,12 @@-module Singletons.Contains where - -import Data.Singletons.TH -import Prelude.Singletons - --- polymorphic function with context - -$(singletons [d| - contains :: Eq a => a -> [a] -> Bool - contains _ [] = False - contains elt (h:t) = (elt == h) || (contains elt t) - |]) +module Singletons.Contains where++import Data.Singletons.TH+import Prelude.Singletons++-- 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.golden view
@@ -1,203 +1,163 @@-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 PairSym0 :: forall a b. (~>) a ((~>) b (Pair a b)) - data PairSym0 :: (~>) a ((~>) b (Pair a b)) - where - PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 a0123456789876543210 - type instance Apply PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd ((,) PairSym0KindInference ()) - type PairSym1 :: forall a b. a -> (~>) b (Pair a b) - data PairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b) - where - PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) => - PairSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) PairSym1KindInference ()) - type PairSym2 :: forall a b. a -> b -> Pair a b - type family PairSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where - PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - type family AListSym0 where - AListSym0 = AList - type family TupleSym0 where - TupleSym0 = Tuple - type family ComplexSym0 where - ComplexSym0 = Complex - type family PrSym0 where - PrSym0 = Pr - type family AList where - AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) NilSym0)) - 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) NilSym0) - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Pair a b -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (Pair a b) ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (Pair a b) ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Pair a b -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Pair a b) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Pair a b -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Pair a b) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 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 SPair :: forall a b. Pair a b -> Type - where - SPair :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair a b) - type instance Sing @(Pair a b) = SPair - 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.Num.Natural.Natural) - (t2 :: Pair a b) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - -> 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 (SPair (z :: Pair a b)) - instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where - sing = SPair sing sing - instance SingI n => SingI1 (Pair (n :: a)) where - liftSing = SPair sing - instance SingI2 Pair where - liftSing2 = SPair - instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where - sing = singFun2 @PairSym0 SPair - instance SingI d => - SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where - sing = singFun1 @(PairSym1 (d :: a)) (SPair (sing @d)) - instance SingI1 (PairSym1 :: a -> (~>) b (Pair a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(PairSym1 (d :: a)) (SPair s) +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 PairSym0 :: forall a b. (~>) a ((~>) b (Pair a b))+ data PairSym0 :: (~>) a ((~>) b (Pair a b))+ where+ PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) =>+ PairSym0 a0123456789876543210+ type instance Apply @a @((~>) b (Pair a b)) PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210+ instance SuppressUnusedWarnings PairSym0 where+ suppressUnusedWarnings = snd ((,) PairSym0KindInference ())+ type PairSym1 :: forall a b. a -> (~>) b (Pair a b)+ data PairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b)+ where+ PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) =>+ PairSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(Pair a b) (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) PairSym1KindInference ())+ type PairSym2 :: forall a b. a -> b -> Pair a b+ type family PairSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where+ PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ type family AListSym0 where+ AListSym0 = AList+ type family TupleSym0 where+ TupleSym0 = Tuple+ type family ComplexSym0 where+ ComplexSym0 = Complex+ type family PrSym0 where+ PrSym0 = Pr+ type family AList where+ AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) NilSym0))+ 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) NilSym0)+ type ShowsPrec_0123456789876543210 :: forall a+ b. GHC.Internal.Bignum.Natural.Natural+ -> Pair a b -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 @a @b (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Pair a b) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 @a @b (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (Pair arg_0123456789876543210 arg_0123456789876543210 :: Pair a b) (a_0123456789876543210 :: Symbol) = 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+ instance PShow (Pair a b) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ sAList :: Sing @_ AList+ sTuple :: Sing @_ Tuple+ sComplex :: Sing @_ Complex+ sPr :: Sing @_ Pr+ 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 SPair :: forall a b. Pair a b -> Type+ where+ SPair :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair a b)+ type instance Sing @(Pair a b) = SPair+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SPair c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ instance (SShow a, SShow b) => SShow (Pair a b) where+ 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 (SPair (z :: Pair a b))+ instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where+ sing = SPair sing sing+ instance SingI n => SingI1 (Pair (n :: a)) where+ liftSing = SPair sing+ instance SingI2 Pair where+ liftSing2 = SPair+ instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where+ sing = singFun2 @PairSym0 SPair+ instance SingI d =>+ SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where+ sing = singFun1 @(PairSym1 (d :: a)) (SPair (sing @d))+ instance SingI1 (PairSym1 :: a -> (~>) b (Pair a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(PairSym1 (d :: a)) (SPair s)
tests/compile-and-dump/Singletons/DataValues.hs view
@@ -1,19 +1,19 @@-module Singletons.DataValues where - -import Data.Singletons.TH -import Prelude.Singletons -import Singletons.Nat -import Text.Show.Singletons - -$(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)] - - |]) +module Singletons.DataValues where++import Data.Singletons.TH+import Prelude.Singletons+import Singletons.Nat+import Text.Show.Singletons++$(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.golden view
@@ -1,10 +1,10 @@-Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations - singletons [d| data Empty |] - ======> - data Empty - data SEmpty :: Empty -> Type - type instance Sing @Empty = SEmpty - instance SingKind Empty where - type Demote Empty = Empty - fromSing x = case x of {} - toSing x = SomeSing (case x of {}) +Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations+ singletons [d| data Empty |]+ ======>+ data Empty+ data SEmpty :: Empty -> Type+ type instance Sing @Empty = SEmpty+ instance SingKind Empty where+ type Demote Empty = Empty+ fromSing x = (\case) x+ toSing x = SomeSing ((\case) x)
tests/compile-and-dump/Singletons/Empty.hs view
@@ -1,7 +1,7 @@-module Singletons.Empty where - -import Data.Singletons.TH - -$(singletons [d| - data Empty - |]) +module Singletons.Empty where++import Data.Singletons.TH++$(singletons [d|+ data Empty+ |])
tests/compile-and-dump/Singletons/EmptyShowDeriving.golden view
@@ -1,73 +1,46 @@-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 ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Foo -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Foo -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Foo -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Foo where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data SFoo :: Foo -> Type - type instance Sing @Foo = SFoo - 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.Num.Natural.Natural) - (t2 :: Foo) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - -> Type) t1) t2) t3) - sShowsPrec - _ - (sV_0123456789876543210 :: Sing v_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (id - @(Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210)) - (case sV_0123456789876543210 of {})) - sA_0123456789876543210 - deriving instance Show (SFoo (z :: Foo)) +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 LamCases_0123456789876543210 (v_01234567898765432100123456789876543210 :: Foo) (a_01234567898765432100123456789876543210 :: GHC.Internal.Types.Symbol) a_0123456789876543210 where+ data LamCases_0123456789876543210Sym0 (v_01234567898765432100123456789876543210 :: Foo) (a_01234567898765432100123456789876543210 :: GHC.Internal.Types.Symbol) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (v_01234567898765432100123456789876543210 :: Foo) (a_01234567898765432100123456789876543210 :: GHC.Internal.Types.Symbol) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Foo+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Foo) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.Types.Symbol where+ ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 v_0123456789876543210 a_0123456789876543210) v_0123456789876543210) a_0123456789876543210+ instance PShow Foo where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data SFoo :: Foo -> Type+ type instance Sing @Foo = SFoo+ instance SingKind Foo where+ type Demote Foo = Foo+ fromSing x = (\case) x+ toSing x = SomeSing ((\case) x)+ instance SShow Foo where+ sShowsPrec+ _+ (sV_0123456789876543210 :: Sing v_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 v_0123456789876543210 a_0123456789876543210)+ (\case))+ sV_0123456789876543210)+ sA_0123456789876543210+ deriving instance Show (SFoo (z :: Foo))
tests/compile-and-dump/Singletons/EmptyShowDeriving.hs view
@@ -1,7 +1,7 @@-module Singletons.EmptyShowDeriving where - -import Data.Singletons.Base.TH - -$(singletons [d| data Foo - deriving instance Show Foo - |]) +module Singletons.EmptyShowDeriving where++import Data.Singletons.Base.TH++$(singletons [d| data Foo+ deriving instance Show Foo+ |])
tests/compile-and-dump/Singletons/EnumDeriving.golden view
@@ -1,223 +1,214 @@-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 :: Foo - type family BarSym0 :: Foo where - BarSym0 = Bar - type BazSym0 :: Foo - type family BazSym0 :: Foo where - BazSym0 = Baz - type BumSym0 :: Foo - type family BumSym0 :: Foo where - BumSym0 = Bum - type Q1Sym0 :: Quux - type family Q1Sym0 :: Quux where - Q1Sym0 = Q1 - type Q2Sym0 :: Quux - type family Q2Sym0 :: Quux where - Q2Sym0 = Q2 - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = BumSym0 - Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = BazSym0 - Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 2)) - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = BarSym0 - Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) - type ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural -> Foo - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: Foo where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Foo - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Foo - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> Foo - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: Foo where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: Foo -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210 Bar = FromInteger 0 - FromEnum_0123456789876543210 Baz = FromInteger 1 - FromEnum_0123456789876543210 Bum = FromInteger 2 - type FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: Foo - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance PEnum Foo where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - data SFoo :: Foo -> Type - where - SBar :: SFoo (Bar :: Foo) - SBaz :: SFoo (Baz :: Foo) - SBum :: SFoo (Bum :: Foo) - type instance Sing @Foo = SFoo - 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 SQuux :: Quux -> Type - where - SQ1 :: SQuux (Q1 :: Quux) - SQ2 :: SQuux (Q2 :: Quux) - type instance Sing @Quux = SQuux - 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.Num.Natural.Natural). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.ToEnumSym0 :: TyFun GHC.Num.Natural.Natural Foo - -> Type) t) - sFromEnum :: - forall (t :: Foo). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.FromEnumSym0 :: TyFun Foo GHC.Num.Natural.Natural - -> Type) t) - sToEnum (sN :: Sing n) - = id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SBar - SFalse - -> id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SBaz - SFalse - -> id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 2)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 2)) - of - STrue -> SBum - SFalse -> sError (sing :: Sing "toEnum: bad argument")))) - sFromEnum SBar = sFromInteger (sing :: Sing 0) - sFromEnum SBaz = sFromInteger (sing :: Sing 1) - sFromEnum SBum = sFromInteger (sing :: Sing 2) - instance SingI Bar where - sing = SBar - instance SingI Baz where - sing = SBaz - instance SingI Bum where - sing = SBum - instance SingI Q1 where - sing = SQ1 - instance SingI Q2 where - sing = SQ2 -Singletons/EnumDeriving.hs:0:0:: Splicing declarations - singEnumInstance ''Quux - ======> - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = Q2Sym0 - Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = Q1Sym0 - Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) - type ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural -> Quux - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: Quux where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Quux - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Quux - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> Quux - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: Quux where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: Quux - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210 'Q1 = FromInteger 0 - FromEnum_0123456789876543210 'Q2 = FromInteger 1 - type FromEnum_0123456789876543210Sym0 :: (~>) Quux GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) Quux GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: Quux - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 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.Num.Natural.Natural). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.ToEnumSym0 :: TyFun GHC.Num.Natural.Natural Quux - -> Type) t) - sFromEnum :: - forall (t :: Quux). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.FromEnumSym0 :: TyFun Quux GHC.Num.Natural.Natural - -> Type) t) - sToEnum (sN :: Sing n) - = id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SQ1 - SFalse - -> id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SQ2 - SFalse -> sError (sing :: Sing "toEnum: bad argument"))) - sFromEnum SQ1 = sFromInteger (sing :: Sing 0) - sFromEnum SQ2 = sFromInteger (sing :: Sing 1) +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 :: Foo+ type family BarSym0 :: Foo where+ BarSym0 = Bar+ type BazSym0 :: Foo+ type family BazSym0 :: Foo where+ BazSym0 = Baz+ type BumSym0 :: Foo+ type family BumSym0 :: Foo where+ BumSym0 = Bum+ type Q1Sym0 :: Quux+ type family Q1Sym0 :: Quux where+ Q1Sym0 = Q1+ type Q2Sym0 :: Quux+ type family Q2Sym0 :: Quux where+ Q2Sym0 = Q2+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = BumSym0+ LamCases_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = BazSym0+ LamCases_0123456789876543210 n 'False = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 2))+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = BarSym0+ LamCases_0123456789876543210 n 'False = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 1))+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Foo+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: Foo where+ ToEnum_0123456789876543210 n = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 0))+ type FromEnum_0123456789876543210 :: Foo+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Internal.Bignum.Natural.Natural where+ FromEnum_0123456789876543210 Bar = FromInteger 0+ FromEnum_0123456789876543210 Baz = FromInteger 1+ FromEnum_0123456789876543210 Bum = FromInteger 2+ instance PEnum Foo where+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ data SFoo :: Foo -> Type+ where+ SBar :: SFoo (Bar :: Foo)+ SBaz :: SFoo (Baz :: Foo)+ SBum :: SFoo (Bum :: Foo)+ type instance Sing @Foo = SFoo+ 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 SQuux :: Quux -> Type+ where+ SQ1 :: SQuux (Q1 :: Quux)+ SQ2 :: SQuux (Q2 :: Quux)+ type instance Sing @Quux = SQuux+ 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 (sN :: Sing n)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SBar+ SFalse+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SBaz+ SFalse+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SBum+ SFalse+ -> applySing+ (singFun1 @ErrorSym0 sError)+ (sing :: Sing "toEnum: bad argument")))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 2)))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 1)))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 0)))+ sFromEnum SBar = sFromInteger (sing :: Sing 0)+ sFromEnum SBaz = sFromInteger (sing :: Sing 1)+ sFromEnum SBum = sFromInteger (sing :: Sing 2)+ instance SingI Bar where+ sing = SBar+ instance SingI Baz where+ sing = SBaz+ instance SingI Bum where+ sing = SBum+ instance SingI Q1 where+ sing = SQ1+ instance SingI Q2 where+ sing = SQ2+Singletons/EnumDeriving.hs:0:0:: Splicing declarations+ singEnumInstance ''Quux+ ======>+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = Q2Sym0+ LamCases_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = Q1Sym0+ LamCases_0123456789876543210 n 'False = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 1))+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Quux+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: Quux where+ ToEnum_0123456789876543210 n = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 0))+ type FromEnum_0123456789876543210 :: Quux+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Internal.Bignum.Natural.Natural where+ FromEnum_0123456789876543210 'Q1 = FromInteger 0+ FromEnum_0123456789876543210 'Q2 = FromInteger 1+ instance PEnum Quux where+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ instance SEnum Quux where+ sToEnum (sN :: Sing n)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SQ1+ SFalse+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SQ2+ SFalse+ -> applySing+ (singFun1 @ErrorSym0 sError)+ (sing :: Sing "toEnum: bad argument")))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 1)))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 0)))+ sFromEnum SQ1 = sFromInteger (sing :: Sing 0)+ sFromEnum SQ2 = sFromInteger (sing :: Sing 1)
tests/compile-and-dump/Singletons/EnumDeriving.hs view
@@ -1,11 +1,11 @@-module Singletons.EnumDeriving where - -import Data.Singletons.Base.TH - -$(singletons [d| - data Foo = Bar | Baz | Bum - deriving Enum - data Quux = Q1 | Q2 - |]) - -$(singEnumInstance ''Quux) +module Singletons.EnumDeriving where++import Data.Singletons.Base.TH++$(singletons [d|+ data Foo = Bar | Baz | Bum+ deriving Enum+ data Quux = Q1 | Q2+ |])++$(singEnumInstance ''Quux)
tests/compile-and-dump/Singletons/EqInstances.golden view
@@ -1,88 +1,36 @@-Singletons/EqInstances.hs:0:0:: Splicing declarations - singEqInstances [''Foo, ''Empty] - ======> - type TFHelper_0123456789876543210 :: Foo -> Foo -> Bool - type family TFHelper_0123456789876543210 (a :: Foo) (a :: Foo) :: Bool where - TFHelper_0123456789876543210 'FLeaf 'FLeaf = TrueSym0 - TFHelper_0123456789876543210 'FLeaf ('(:+:) _ _) = FalseSym0 - TFHelper_0123456789876543210 ('(:+:) _ _) 'FLeaf = FalseSym0 - TFHelper_0123456789876543210 ('(:+:) a_0123456789876543210 a_0123456789876543210) ('(:+:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210) - type TFHelper_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Foo -> (~>) Foo Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Foo -> Foo -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Foo where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - instance SEq Foo => SEq Foo where - (%==) :: - forall (t1 :: Foo) (t2 :: Foo). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Foo ((~>) Foo Bool) - -> Type) t1) t2) - (%==) SFLeaf SFLeaf = STrue - (%==) SFLeaf ((:%+:) _ _) = SFalse - (%==) ((:%+:) _ _) SFLeaf = SFalse - (%==) - ((:%+:) (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - ((:%+:) (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210) - type TFHelper_0123456789876543210 :: Empty -> Empty -> Bool - type family TFHelper_0123456789876543210 (a :: Empty) (a :: Empty) :: Bool where - TFHelper_0123456789876543210 _ _ = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Empty -> (~>) Empty Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Empty -> Empty -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Empty where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - instance SEq Empty where - (%==) :: - forall (t1 :: Empty) (t2 :: Empty). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Empty ((~>) Empty Bool) - -> Type) t1) t2) - (%==) _ _ = STrue +Singletons/EqInstances.hs:0:0:: Splicing declarations+ singEqInstances [''Foo, ''Empty]+ ======>+ type TFHelper_0123456789876543210 :: Foo -> Foo -> Bool+ type family TFHelper_0123456789876543210 (a :: Foo) (a :: Foo) :: Bool where+ TFHelper_0123456789876543210 'FLeaf 'FLeaf = TrueSym0+ TFHelper_0123456789876543210 'FLeaf ('(:+:) _ _) = FalseSym0+ TFHelper_0123456789876543210 ('(:+:) _ _) 'FLeaf = FalseSym0+ TFHelper_0123456789876543210 ('(:+:) a_0123456789876543210 a_0123456789876543210) ('(:+:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)+ instance PEq Foo where+ type (==) a a = TFHelper_0123456789876543210 a a+ instance SEq Foo => SEq Foo where+ (%==) SFLeaf SFLeaf = STrue+ (%==) SFLeaf ((:%+:) _ _) = SFalse+ (%==) ((:%+:) _ _) SFLeaf = SFalse+ (%==)+ ((:%+:) (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210))+ ((:%+:) (sB_0123456789876543210 :: Sing b_0123456789876543210)+ (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)+ type TFHelper_0123456789876543210 :: Empty -> Empty -> Bool+ type family TFHelper_0123456789876543210 (a :: Empty) (a :: Empty) :: Bool where+ TFHelper_0123456789876543210 _ _ = TrueSym0+ instance PEq Empty where+ type (==) a a = TFHelper_0123456789876543210 a a+ instance SEq Empty where+ (%==) _ _ = STrue
tests/compile-and-dump/Singletons/EqInstances.hs view
@@ -1,8 +1,8 @@-module Singletons.EqInstances where - -import Data.Bool.Singletons -import Data.Singletons.Base.TH -import Singletons.Empty -import Singletons.Operators - -$(singEqInstances [''Foo, ''Empty]) +module Singletons.EqInstances where++import Data.Bool.Singletons+import Data.Singletons.Base.TH+import Singletons.Empty+import Singletons.Operators++$(singEqInstances [''Foo, ''Empty])
tests/compile-and-dump/Singletons/Error.golden view
@@ -1,30 +1,31 @@-Singletons/Error.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| head :: [a] -> a - head (a : _) = a - head [] = error "head: empty list" |] - ======> - head :: [a] -> a - head (a : _) = a - head [] = error "head: empty list" - type HeadSym0 :: (~>) [a] a - data HeadSym0 :: (~>) [a] a - where - HeadSym0KindInference :: SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => - HeadSym0 a0123456789876543210 - type instance Apply HeadSym0 a0123456789876543210 = Head a0123456789876543210 - instance SuppressUnusedWarnings HeadSym0 where - suppressUnusedWarnings = snd ((,) HeadSym0KindInference ()) - type HeadSym1 :: [a] -> a - type family HeadSym1 (a0123456789876543210 :: [a]) :: a where - HeadSym1 a0123456789876543210 = Head a0123456789876543210 - type Head :: [a] -> a - type family Head (a :: [a]) :: a where - Head ('(:) a _) = a - Head '[] = Apply ErrorSym0 "head: empty list" - sHead :: - (forall (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) :: Type) - sHead (SCons (sA :: Sing a) _) = sA - sHead SNil = sError (sing :: Sing "head: empty list") - instance SingI (HeadSym0 :: (~>) [a] a) where - sing = singFun1 @HeadSym0 sHead +Singletons/Error.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| head :: [a] -> a+ head (a : _) = a+ head [] = error "head: empty list" |]+ ======>+ head :: [a] -> a+ head (a : _) = a+ head [] = error "head: empty list"+ type HeadSym0 :: (~>) [a] a+ data HeadSym0 :: (~>) [a] a+ where+ HeadSym0KindInference :: SameKind (Apply HeadSym0 arg) (HeadSym1 arg) =>+ HeadSym0 a0123456789876543210+ type instance Apply @[a] @a HeadSym0 a0123456789876543210 = Head a0123456789876543210+ instance SuppressUnusedWarnings HeadSym0 where+ suppressUnusedWarnings = snd ((,) HeadSym0KindInference ())+ type HeadSym1 :: [a] -> a+ type family HeadSym1 @a (a0123456789876543210 :: [a]) :: a where+ HeadSym1 a0123456789876543210 = Head a0123456789876543210+ type Head :: [a] -> a+ type family Head @a (a :: [a]) :: a where+ Head ('(:) a _) = a+ Head '[] = Apply ErrorSym0 "head: empty list"+ sHead :: (forall (t :: [a]). Sing t -> Sing (Head t :: a) :: Type)+ sHead (SCons (sA :: Sing a) _) = sA+ sHead SNil+ = applySing+ (singFun1 @ErrorSym0 sError) (sing :: Sing "head: empty list")+ instance SingI (HeadSym0 :: (~>) [a] a) where+ sing = singFun1 @HeadSym0 sHead
tests/compile-and-dump/Singletons/Error.hs view
@@ -1,11 +1,11 @@-module Singletons.Error where - -import Data.Singletons -import Data.Singletons.TH -import Prelude.Singletons hiding (Head, HeadSym0, HeadSym1, sHead) - -$(singletons [d| - head :: [a] -> a - head (a : _) = a - head [] = error "head: empty list" - |]) +module Singletons.Error where++import Data.Singletons+import Data.Singletons.TH+import Prelude.Singletons hiding (Head, HeadSym0, HeadSym1, sHead)++$(singletons [d|+ head :: [a] -> a+ head (a : _) = a+ head [] = error "head: empty list"+ |])
tests/compile-and-dump/Singletons/Fixity.golden view
@@ -1,96 +1,93 @@-Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| 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 (====@#@$) :: (~>) a ((~>) a a) - data (====@#@$) :: (~>) a ((~>) a a) - where - (:====@#@$###) :: SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) => - (====@#@$) a0123456789876543210 - type instance Apply (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (====@#@$) where - suppressUnusedWarnings = snd ((,) (:====@#@$###) ()) - infix 4 ====@#@$ - type (====@#@$$) :: a -> (~>) a a - data (====@#@$$) (a0123456789876543210 :: a) :: (~>) a a - where - (:====@#@$$###) :: SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) => - (====@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:====@#@$$###) ()) - infix 4 ====@#@$$ - type (====@#@$$$) :: a -> a -> a - type family (====@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where - (====@#@$$$) a0123456789876543210 a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210 - infix 4 ====@#@$$$ - type (====) :: a -> a -> a - type family (====) (a :: a) (a :: a) :: a where - (====) a _ = a - type (<=>@#@$) :: forall a. (~>) a ((~>) a Ordering) - data (<=>@#@$) :: (~>) a ((~>) a Ordering) - where - (:<=>@#@$###) :: SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => - (<=>@#@$) a0123456789876543210 - type instance Apply (<=>@#@$) a0123456789876543210 = (<=>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<=>@#@$) where - suppressUnusedWarnings = snd ((,) (:<=>@#@$###) ()) - infix 4 <=>@#@$ - type (<=>@#@$$) :: forall a. a -> (~>) a Ordering - data (<=>@#@$$) (a0123456789876543210 :: a) :: (~>) a Ordering - where - (:<=>@#@$$###) :: SameKind (Apply ((<=>@#@$$) a0123456789876543210) arg) ((<=>@#@$$$) a0123456789876543210 arg) => - (<=>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<=>@#@$$) a0123456789876543210) a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<=>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<=>@#@$$###) ()) - infix 4 <=>@#@$$ - type (<=>@#@$$$) :: forall a. a -> a -> Ordering - type family (<=>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where - (<=>@#@$$$) a0123456789876543210 a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210 - infix 4 <=>@#@$$$ - class PMyOrd a where - type family (<=>) (arg :: a) (arg :: a) :: Ordering - infix 4 %==== - (%====) :: - (forall (t :: a) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a) :: Type) - (%====) (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)) - instance SingI1 ((====@#@$$) :: a -> (~>) a a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((====@#@$$) (d :: a)) ((%====) s) - class SMyOrd a where - (%<=>) :: - (forall (t :: a) (t :: a). - Sing t - -> Sing t - -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) :: Type) - infix 4 %<=> - 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)) - instance SMyOrd a => - SingI1 ((<=>@#@$$) :: a -> (~>) a Ordering) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((<=>@#@$$) (d :: a)) ((%<=>) s) +Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| 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 (====@#@$) :: (~>) a ((~>) a a)+ data (====@#@$) :: (~>) a ((~>) a a)+ where+ (:====@#@$###) :: SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) =>+ (====@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (====@#@$) where+ suppressUnusedWarnings = snd ((,) (:====@#@$###) ())+ infix 4 type ====@#@$+ type (====@#@$$) :: a -> (~>) a a+ data (====@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:====@#@$$###) :: SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) =>+ (====@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:====@#@$$###) ())+ infix 4 type ====@#@$$+ type (====@#@$$$) :: a -> a -> a+ type family (====@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (====@#@$$$) a0123456789876543210 a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210+ infix 4 type ====@#@$$$+ type (====) :: a -> a -> a+ type family (====) @a (a :: a) (a :: a) :: a where+ (====) a _ = a+ type (<=>@#@$) :: forall a. (~>) a ((~>) a Ordering)+ data (<=>@#@$) :: (~>) a ((~>) a Ordering)+ where+ (:<=>@#@$###) :: SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>+ (<=>@#@$) a0123456789876543210+ type instance Apply @a @((~>) a Ordering) (<=>@#@$) a0123456789876543210 = (<=>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<=>@#@$) where+ suppressUnusedWarnings = snd ((,) (:<=>@#@$###) ())+ infix 4 type <=>@#@$+ type (<=>@#@$$) :: forall a. a -> (~>) a Ordering+ data (<=>@#@$$) (a0123456789876543210 :: a) :: (~>) a Ordering+ where+ (:<=>@#@$$###) :: SameKind (Apply ((<=>@#@$$) a0123456789876543210) arg) ((<=>@#@$$$) a0123456789876543210 arg) =>+ (<=>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @Ordering ((<=>@#@$$) a0123456789876543210) a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<=>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<=>@#@$$###) ())+ infix 4 type <=>@#@$$+ type (<=>@#@$$$) :: forall a. a -> a -> Ordering+ type family (<=>@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ordering where+ (<=>@#@$$$) a0123456789876543210 a0123456789876543210 = (<=>) a0123456789876543210 a0123456789876543210+ infix 4 type <=>@#@$$$+ class PMyOrd a where+ type family (<=>) (arg :: a) (arg :: a) :: Ordering+ infix 4 data %====+ (%====) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((====) t t :: a) :: Type)+ (%====) (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))+ instance SingI1 ((====@#@$$) :: a -> (~>) a a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((====@#@$$) (d :: a)) ((%====) s)+ class SMyOrd a where+ (%<=>) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((<=>) t t :: Ordering) :: Type)+ infix 4 data %<=>+ 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))+ instance SMyOrd a =>+ SingI1 ((<=>@#@$$) :: a -> (~>) a Ordering) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((<=>@#@$$) (d :: a)) ((%<=>) s)
tests/compile-and-dump/Singletons/Fixity.hs view
@@ -1,16 +1,16 @@-module Singletons.Fixity where - -import Data.Singletons -import Data.Singletons.TH -import Language.Haskell.TH.Desugar -import Prelude.Singletons - -$(singletons [d| - class MyOrd a where - (<=>) :: a -> a -> Ordering - infix 4 <=> - - (====) :: a -> a -> a - a ==== _ = a - infix 4 ==== - |]) +module Singletons.Fixity where++import Data.Singletons+import Data.Singletons.TH+import Language.Haskell.TH.Desugar+import Prelude.Singletons++$(singletons [d|+ class MyOrd a where+ (<=>) :: a -> a -> Ordering+ infix 4 <=>++ (====) :: a -> a -> a+ a ==== _ = a+ infix 4 ====+ |])
tests/compile-and-dump/Singletons/FunDeps.golden view
@@ -1,106 +1,74 @@-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 Natural 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 Natural where - meth = not - l2r False = 0 - l2r True = 1 - t1 = meth True - type family T1Sym0 where - T1Sym0 = T1 - type family T1 where - T1 = Apply MethSym0 TrueSym0 - type MethSym0 :: forall a. (~>) a a - data MethSym0 :: (~>) a a - where - MethSym0KindInference :: SameKind (Apply MethSym0 arg) (MethSym1 arg) => - MethSym0 a0123456789876543210 - type instance Apply MethSym0 a0123456789876543210 = Meth a0123456789876543210 - instance SuppressUnusedWarnings MethSym0 where - suppressUnusedWarnings = snd ((,) MethSym0KindInference ()) - type MethSym1 :: forall a. a -> a - type family MethSym1 (a0123456789876543210 :: a) :: a where - MethSym1 a0123456789876543210 = Meth a0123456789876543210 - type L2rSym0 :: forall a b. (~>) a b - data L2rSym0 :: (~>) a b - where - L2rSym0KindInference :: SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => - L2rSym0 a0123456789876543210 - type instance Apply L2rSym0 a0123456789876543210 = L2r a0123456789876543210 - instance SuppressUnusedWarnings L2rSym0 where - suppressUnusedWarnings = snd ((,) L2rSym0KindInference ()) - type L2rSym1 :: forall a b. a -> b - type family L2rSym1 (a0123456789876543210 :: a) :: b where - L2rSym1 a0123456789876543210 = L2r a0123456789876543210 - class PFD a b | a -> b where - type family Meth (arg :: a) :: a - type family L2r (arg :: a) :: b - type Meth_0123456789876543210 :: Bool -> Bool - type family Meth_0123456789876543210 (a :: Bool) :: Bool where - Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym0 :: (~>) Bool Bool - data Meth_0123456789876543210Sym0 :: (~>) Bool Bool - where - Meth_0123456789876543210Sym0KindInference :: SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => - Meth_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Meth_0123456789876543210Sym0KindInference ()) - type Meth_0123456789876543210Sym1 :: Bool -> Bool - type family Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) :: Bool where - Meth_0123456789876543210Sym1 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 - type L2r_0123456789876543210 :: Bool -> Natural - type family L2r_0123456789876543210 (a :: Bool) :: Natural where - L2r_0123456789876543210 'False = FromInteger 0 - L2r_0123456789876543210 'True = FromInteger 1 - type L2r_0123456789876543210Sym0 :: (~>) Bool Natural - data L2r_0123456789876543210Sym0 :: (~>) Bool Natural - where - L2r_0123456789876543210Sym0KindInference :: SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => - L2r_0123456789876543210Sym0 a0123456789876543210 - type instance Apply L2r_0123456789876543210Sym0 a0123456789876543210 = L2r_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) L2r_0123456789876543210Sym0KindInference ()) - type L2r_0123456789876543210Sym1 :: Bool -> Natural - type family L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) :: Natural where - L2r_0123456789876543210Sym1 a0123456789876543210 = L2r_0123456789876543210 a0123456789876543210 - instance PFD Bool Natural 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) :: Type) - sL2r :: - (forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) :: Type) - instance SFD Bool Natural where - sMeth :: - (forall (t :: Bool). - Sing t -> Sing (Apply MethSym0 t :: Bool) :: Type) - sL2r :: - (forall (t :: Bool). - Sing t -> Sing (Apply L2rSym0 t :: Natural) :: Type) - 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 +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 Natural 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 Natural where+ meth = not+ l2r False = 0+ l2r True = 1+ t1 = meth True+ type family T1Sym0 where+ T1Sym0 = T1+ type family T1 where+ T1 = Apply MethSym0 TrueSym0+ type MethSym0 :: forall a. (~>) a a+ data MethSym0 :: (~>) a a+ where+ MethSym0KindInference :: SameKind (Apply MethSym0 arg) (MethSym1 arg) =>+ MethSym0 a0123456789876543210+ type instance Apply @a @a MethSym0 a0123456789876543210 = Meth a0123456789876543210+ instance SuppressUnusedWarnings MethSym0 where+ suppressUnusedWarnings = snd ((,) MethSym0KindInference ())+ type MethSym1 :: forall a. a -> a+ type family MethSym1 @a (a0123456789876543210 :: a) :: a where+ MethSym1 a0123456789876543210 = Meth a0123456789876543210+ type L2rSym0 :: forall a b. (~>) a b+ data L2rSym0 :: (~>) a b+ where+ L2rSym0KindInference :: SameKind (Apply L2rSym0 arg) (L2rSym1 arg) =>+ L2rSym0 a0123456789876543210+ type instance Apply @a @b L2rSym0 a0123456789876543210 = L2r a0123456789876543210+ instance SuppressUnusedWarnings L2rSym0 where+ suppressUnusedWarnings = snd ((,) L2rSym0KindInference ())+ type L2rSym1 :: forall a b. a -> b+ type family L2rSym1 @a @b (a0123456789876543210 :: a) :: b where+ L2rSym1 a0123456789876543210 = L2r a0123456789876543210+ class PFD a b | a -> b where+ type family Meth (arg :: a) :: a+ type family L2r (arg :: a) :: b+ type Meth_0123456789876543210 :: Bool -> Bool+ type family Meth_0123456789876543210 (a :: Bool) :: Bool where+ Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210+ type L2r_0123456789876543210 :: Bool -> Natural+ type family L2r_0123456789876543210 (a :: Bool) :: Natural where+ L2r_0123456789876543210 'False = FromInteger 0+ L2r_0123456789876543210 'True = FromInteger 1+ instance PFD Bool Natural where+ type Meth a = Meth_0123456789876543210 a+ type L2r a = L2r_0123456789876543210 a+ sT1 :: Sing @_ T1+ sT1 = applySing (singFun1 @MethSym0 sMeth) STrue+ class SFD a b | a -> b where+ sMeth :: (forall (t :: a). Sing t -> Sing (Meth t :: a) :: Type)+ sL2r :: (forall (t :: a). Sing t -> Sing (L2r t :: b) :: Type)+ instance SFD Bool Natural where+ 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 view
@@ -1,21 +1,21 @@-{-# LANGUAGE FunctionalDependencies #-} - -module Singletons.FunDeps where - -import Data.Singletons.TH -import GHC.TypeLits.Singletons -import Prelude.Singletons - -$( singletons [d| - class FD a b | a -> b where - meth :: a -> a - l2r :: a -> b - - instance FD Bool Natural where - meth = not - l2r False = 0 - l2r True = 1 - - t1 = meth True --- t2 = l2r False -- This fails because no FDs in type families - |]) +{-# LANGUAGE FunctionalDependencies #-}++module Singletons.FunDeps where++import Data.Singletons.TH+import GHC.TypeLits.Singletons+import Prelude.Singletons++$( singletons [d|+ class FD a b | a -> b where+ meth :: a -> a+ l2r :: a -> b++ instance FD Bool Natural 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.golden view
@@ -1,1385 +1,681 @@-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 MkT1Sym0 :: forall x - a. (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) - data MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) - where - MkT1Sym0KindInference :: SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => - MkT1Sym0 a0123456789876543210 - type instance Apply MkT1Sym0 a0123456789876543210 = MkT1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings MkT1Sym0 where - suppressUnusedWarnings = snd ((,) MkT1Sym0KindInference ()) - type MkT1Sym1 :: forall x a. x - -> (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) - data MkT1Sym1 (a0123456789876543210 :: x) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) - where - MkT1Sym1KindInference :: SameKind (Apply (MkT1Sym1 a0123456789876543210) arg) (MkT1Sym2 a0123456789876543210 arg) => - MkT1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkT1Sym1 a0123456789876543210) a0123456789876543210 = MkT1Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkT1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkT1Sym1KindInference ()) - type MkT1Sym2 :: forall x a. x - -> a -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)) - data MkT1Sym2 (a0123456789876543210 :: x) (a0123456789876543210 :: a) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)) - where - MkT1Sym2KindInference :: SameKind (Apply (MkT1Sym2 a0123456789876543210 a0123456789876543210) arg) (MkT1Sym3 a0123456789876543210 a0123456789876543210 arg) => - MkT1Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (MkT1Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkT1Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkT1Sym2KindInference ()) - type MkT1Sym3 :: forall x a. x - -> a -> Maybe a -> (~>) (Maybe (Maybe a)) (T x a) - data MkT1Sym3 (a0123456789876543210 :: x) (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: (~>) (Maybe (Maybe a)) (T x a) - where - MkT1Sym3KindInference :: SameKind (Apply (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (MkT1Sym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MkT1 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkT1Sym3KindInference ()) - type MkT1Sym4 :: forall x a. x - -> a -> Maybe a -> Maybe (Maybe a) -> T x a - type family MkT1Sym4 (a0123456789876543210 :: x) (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: Maybe (Maybe a)) :: T x a where - MkT1Sym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = MkT1 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type MkT2Sym0 :: forall x a. (~>) (Maybe x) (T x a) - data MkT2Sym0 :: (~>) (Maybe x) (T x a) - where - MkT2Sym0KindInference :: SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) => - MkT2Sym0 a0123456789876543210 - type instance Apply MkT2Sym0 a0123456789876543210 = MkT2 a0123456789876543210 - instance SuppressUnusedWarnings MkT2Sym0 where - suppressUnusedWarnings = snd ((,) MkT2Sym0KindInference ()) - type MkT2Sym1 :: forall x a. Maybe x -> T x a - type family MkT2Sym1 (a0123456789876543210 :: Maybe x) :: T x a where - MkT2Sym1 a0123456789876543210 = MkT2 a0123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - type family Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type Fmap_0123456789876543210 :: (~>) a b -> T x a -> T x b - 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_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) (T x a) (T x b)) - data Fmap_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) (T x a) (T x b)) - where - Fmap_0123456789876543210Sym0KindInference :: SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => - Fmap_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Fmap_0123456789876543210Sym0KindInference ()) - type Fmap_0123456789876543210Sym1 :: (~>) a b - -> (~>) (T x a) (T x b) - data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a b) :: (~>) (T x a) (T x b) - where - Fmap_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Fmap_0123456789876543210Sym1KindInference ()) - type Fmap_0123456789876543210Sym2 :: (~>) a b -> T x a -> T x b - type family Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: T x a) :: T x b where - Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 - type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - type family Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210 - data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - type family Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type TFHelper_0123456789876543210 :: a -> T x b -> T x a - 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_0123456789876543210Sym0 :: (~>) a ((~>) (T x b) (T x a)) - data TFHelper_0123456789876543210Sym0 :: (~>) a ((~>) (T x b) (T x a)) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: a -> (~>) (T x b) (T x a) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) (T x b) (T x a) - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: a -> T x b -> T x a - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: T x b) :: T x a where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 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 n_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - type family Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n_01234567898765432100123456789876543210 - type FoldMap_0123456789876543210 :: (~>) a m -> T x a -> m - 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_0123456789876543210Sym0 :: (~>) ((~>) a m) ((~>) (T x a) m) - data FoldMap_0123456789876543210Sym0 :: (~>) ((~>) a m) ((~>) (T x a) m) - where - FoldMap_0123456789876543210Sym0KindInference :: SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => - FoldMap_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FoldMap_0123456789876543210Sym0KindInference ()) - type FoldMap_0123456789876543210Sym1 :: (~>) a m -> (~>) (T x a) m - data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a m) :: (~>) (T x a) m - where - FoldMap_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) FoldMap_0123456789876543210Sym1KindInference ()) - type FoldMap_0123456789876543210Sym2 :: (~>) a m -> T x a -> m - type family FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a m) (a0123456789876543210 :: T x a) :: m where - FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym6KindInference :: 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 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym6KindInference ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym7KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym7KindInference ()) - type family Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 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 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym6KindInference :: 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 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym6KindInference ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym7KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym7KindInference ()) - type family Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 where - Lambda_0123456789876543210 n1_0123456789876543210 n2_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 - data Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - data Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym6KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym6KindInference ()) - data Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym7KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym7KindInference ()) - data Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym8KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym8KindInference ()) - data Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym9KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym9KindInference ()) - type family Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 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 n1_0123456789876543210) n2_0123456789876543210) _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym5KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym5KindInference ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym6KindInference :: 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 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym6KindInference ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym7KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym7KindInference ()) - type family Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: 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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - type family Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type Foldr_0123456789876543210 :: (~>) a ((~>) b b) - -> b -> T x a -> b - 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_0123456789876543210Sym0 :: (~>) ((~>) a ((~>) b b)) ((~>) b ((~>) (T x a) b)) - data Foldr_0123456789876543210Sym0 :: (~>) ((~>) a ((~>) b b)) ((~>) b ((~>) (T x a) b)) - where - Foldr_0123456789876543210Sym0KindInference :: SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) => - Foldr_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Foldr_0123456789876543210Sym0KindInference ()) - type Foldr_0123456789876543210Sym1 :: (~>) a ((~>) b b) - -> (~>) b ((~>) (T x a) b) - data Foldr_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a ((~>) b b)) :: (~>) b ((~>) (T x a) b) - where - Foldr_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Foldr_0123456789876543210Sym1KindInference ()) - type Foldr_0123456789876543210Sym2 :: (~>) a ((~>) b b) - -> b -> (~>) (T x a) b - data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a ((~>) b b)) (a0123456789876543210 :: b) :: (~>) (T x a) b - where - Foldr_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Foldr_0123456789876543210Sym2KindInference ()) - type Foldr_0123456789876543210Sym3 :: (~>) a ((~>) b b) - -> b -> T x a -> b - type family Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a ((~>) b b)) (a0123456789876543210 :: b) (a0123456789876543210 :: T x a) :: b where - Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 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 Traverse_0123456789876543210 :: (~>) a (f b) - -> T x a -> f (T x b) - 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_0123456789876543210Sym0 :: (~>) ((~>) a (f b)) ((~>) (T x a) (f (T x b))) - data Traverse_0123456789876543210Sym0 :: (~>) ((~>) a (f b)) ((~>) (T x a) (f (T x b))) - where - Traverse_0123456789876543210Sym0KindInference :: SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => - Traverse_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Traverse_0123456789876543210Sym0KindInference ()) - type Traverse_0123456789876543210Sym1 :: (~>) a (f b) - -> (~>) (T x a) (f (T x b)) - data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a (f b)) :: (~>) (T x a) (f (T x b)) - where - Traverse_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Traverse_0123456789876543210Sym1KindInference ()) - type Traverse_0123456789876543210Sym2 :: (~>) a (f b) - -> T x a -> f (T x b) - type family Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a (f b)) (a0123456789876543210 :: T x a) :: f (T x b) where - Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 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 Fmap_0123456789876543210 :: (~>) a b -> Empty a -> Empty b - 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_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) (Empty a) (Empty b)) - data Fmap_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) (Empty a) (Empty b)) - where - Fmap_0123456789876543210Sym0KindInference :: SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => - Fmap_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Fmap_0123456789876543210Sym0KindInference ()) - type Fmap_0123456789876543210Sym1 :: (~>) a b - -> (~>) (Empty a) (Empty b) - data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Empty a) (Empty b) - where - Fmap_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Fmap_0123456789876543210Sym1KindInference ()) - type Fmap_0123456789876543210Sym2 :: (~>) a b -> Empty a -> Empty b - type family Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Empty a) :: Empty b where - Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 - type family Case_0123456789876543210 v_0123456789876543210 t where - type TFHelper_0123456789876543210 :: a -> Empty b -> Empty a - type family TFHelper_0123456789876543210 (a :: a) (a :: Empty b) :: Empty a where - TFHelper_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) a ((~>) (Empty b) (Empty a)) - data TFHelper_0123456789876543210Sym0 :: (~>) a ((~>) (Empty b) (Empty a)) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: a - -> (~>) (Empty b) (Empty a) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) (Empty b) (Empty a) - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: a -> Empty b -> Empty a - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Empty b) :: Empty a where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 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 FoldMap_0123456789876543210 :: (~>) a m -> Empty a -> m - type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: Empty a) :: m where - FoldMap_0123456789876543210 _ _ = MemptySym0 - type FoldMap_0123456789876543210Sym0 :: (~>) ((~>) a m) ((~>) (Empty a) m) - data FoldMap_0123456789876543210Sym0 :: (~>) ((~>) a m) ((~>) (Empty a) m) - where - FoldMap_0123456789876543210Sym0KindInference :: SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => - FoldMap_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FoldMap_0123456789876543210Sym0KindInference ()) - type FoldMap_0123456789876543210Sym1 :: (~>) a m - -> (~>) (Empty a) m - data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a m) :: (~>) (Empty a) m - where - FoldMap_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) FoldMap_0123456789876543210Sym1KindInference ()) - type FoldMap_0123456789876543210Sym2 :: (~>) a m -> Empty a -> m - type family FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a m) (a0123456789876543210 :: Empty a) :: m where - FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PFoldable Empty where - type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a - type family Case_0123456789876543210 v_0123456789876543210 t where - type Traverse_0123456789876543210 :: (~>) a (f b) - -> Empty a -> f (Empty b) - 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_0123456789876543210Sym0 :: (~>) ((~>) a (f b)) ((~>) (Empty a) (f (Empty b))) - data Traverse_0123456789876543210Sym0 :: (~>) ((~>) a (f b)) ((~>) (Empty a) (f (Empty b))) - where - Traverse_0123456789876543210Sym0KindInference :: SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => - Traverse_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Traverse_0123456789876543210Sym0KindInference ()) - type Traverse_0123456789876543210Sym1 :: (~>) a (f b) - -> (~>) (Empty a) (f (Empty b)) - data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a (f b)) :: (~>) (Empty a) (f (Empty b)) - where - Traverse_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Traverse_0123456789876543210Sym1KindInference ()) - type Traverse_0123456789876543210Sym2 :: (~>) a (f b) - -> Empty a -> f (Empty b) - type family Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a (f b)) (a0123456789876543210 :: Empty a) :: f (Empty b) where - Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PTraversable Empty where - type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a - data ST :: forall x a. T x a -> Type - where - SMkT1 :: forall x - a - (n :: x) - (n :: a) - (n :: Maybe a) - (n :: Maybe (Maybe a)). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - ST (MkT1 n n n n :: T x a) - SMkT2 :: forall x a (n :: Maybe x). - (Sing n) -> ST (MkT2 n :: T x a) - type instance Sing @(T x a) = ST - 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 SEmpty :: forall (a :: Type). Empty a -> Type - type instance Sing @(Empty a) = SEmpty - 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 (a :: Type) - (m :: 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 n1_0123456789876543210) n2_0123456789876543210) _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))) - 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 (a :: Type) - (f :: Type -> 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) - = id - @(Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)) - (case sV_0123456789876543210 of {}) - (%<$) _ (sV_0123456789876543210 :: Sing v_0123456789876543210) - = id - @(Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)) - (case sV_0123456789876543210 of {}) - instance SFoldable Empty where - sFoldMap :: - forall (a :: Type) - (m :: 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 (a :: Type) - (f :: Type -> 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) - (id - @(Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)) - (case sV_0123456789876543210 of {})) - 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 n, SingI n, SingI n) => - SingI1 (MkT1 (n :: x) (n :: a) (n :: Maybe a)) where - liftSing = SMkT1 sing sing sing - instance (SingI n, SingI n) => - SingI2 (MkT1 (n :: x) (n :: a)) where - liftSing2 = SMkT1 sing sing - instance SingI (MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where - sing = singFun4 @MkT1Sym0 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 SingI1 (MkT1Sym1 :: x - -> (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where - liftSing (s :: Sing (d :: x)) - = singFun3 @(MkT1Sym1 (d :: x)) (SMkT1 s) - 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 => - SingI1 (MkT1Sym2 (d :: x) :: a - -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where - liftSing (s :: Sing (d :: a)) - = singFun2 @(MkT1Sym2 (d :: x) (d :: a)) (SMkT1 (sing @d) s) - instance SingI2 (MkT1Sym2 :: x - -> a -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where - liftSing2 (s :: Sing (d :: x)) (s :: Sing (d :: a)) - = singFun2 @(MkT1Sym2 (d :: x) (d :: a)) (SMkT1 s s) - 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) => - SingI1 (MkT1Sym3 (d :: x) (d :: a) :: Maybe a - -> (~>) (Maybe (Maybe a)) (T x a)) where - liftSing (s :: Sing (d :: Maybe a)) - = singFun1 - @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a)) - (SMkT1 (sing @d) (sing @d) s) - instance SingI d => - SingI2 (MkT1Sym3 (d :: x) :: a - -> Maybe a -> (~>) (Maybe (Maybe a)) (T x a)) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: Maybe a)) - = singFun1 - @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a)) (SMkT1 (sing @d) s s) - instance SingI n => SingI (MkT2 (n :: Maybe x)) where - sing = SMkT2 sing - instance SingI1 MkT2 where - liftSing = SMkT2 - instance SingI (MkT2Sym0 :: (~>) (Maybe x) (T x a)) where - sing = singFun1 @MkT2Sym0 SMkT2 +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 MkT1Sym0 :: forall x+ a. (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))+ data MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))+ where+ MkT1Sym0KindInference :: SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) =>+ MkT1Sym0 a0123456789876543210+ type instance Apply @x @((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) MkT1Sym0 a0123456789876543210 = MkT1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkT1Sym0 where+ suppressUnusedWarnings = snd ((,) MkT1Sym0KindInference ())+ type MkT1Sym1 :: forall x a. x+ -> (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))+ data MkT1Sym1 (a0123456789876543210 :: x) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))+ where+ MkT1Sym1KindInference :: SameKind (Apply (MkT1Sym1 a0123456789876543210) arg) (MkT1Sym2 a0123456789876543210 arg) =>+ MkT1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) (MkT1Sym1 a0123456789876543210) a0123456789876543210 = MkT1Sym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkT1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkT1Sym1KindInference ())+ type MkT1Sym2 :: forall x a. x+ -> a -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))+ data MkT1Sym2 (a0123456789876543210 :: x) (a0123456789876543210 :: a) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))+ where+ MkT1Sym2KindInference :: SameKind (Apply (MkT1Sym2 a0123456789876543210 a0123456789876543210) arg) (MkT1Sym3 a0123456789876543210 a0123456789876543210 arg) =>+ MkT1Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @((~>) (Maybe (Maybe a)) (T x a)) (MkT1Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkT1Sym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkT1Sym2KindInference ())+ type MkT1Sym3 :: forall x a. x+ -> a -> Maybe a -> (~>) (Maybe (Maybe a)) (T x a)+ data MkT1Sym3 (a0123456789876543210 :: x) (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: (~>) (Maybe (Maybe a)) (T x a)+ where+ MkT1Sym3KindInference :: SameKind (Apply (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (MkT1Sym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe (Maybe a)) @(T x a) (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MkT1 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkT1Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkT1Sym3KindInference ())+ type MkT1Sym4 :: forall x a. x+ -> a -> Maybe a -> Maybe (Maybe a) -> T x a+ type family MkT1Sym4 @x @a (a0123456789876543210 :: x) (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: Maybe (Maybe a)) :: T x a where+ MkT1Sym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = MkT1 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type MkT2Sym0 :: forall x a. (~>) (Maybe x) (T x a)+ data MkT2Sym0 :: (~>) (Maybe x) (T x a)+ where+ MkT2Sym0KindInference :: SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) =>+ MkT2Sym0 a0123456789876543210+ type instance Apply @(Maybe x) @(T x a) MkT2Sym0 a0123456789876543210 = MkT2 a0123456789876543210+ instance SuppressUnusedWarnings MkT2Sym0 where+ suppressUnusedWarnings = snd ((,) MkT2Sym0KindInference ())+ type MkT2Sym1 :: forall x a. Maybe x -> T x a+ type family MkT2Sym1 @x @a (a0123456789876543210 :: Maybe x) :: T x a where+ MkT2Sym1 a0123456789876543210 = MkT2 a0123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type Fmap_0123456789876543210 :: forall x a b. (~>) a b+ -> T x a -> T x b+ type family Fmap_0123456789876543210 @x @a @b (a :: (~>) a b) (a :: T x a) :: T x b where+ Fmap_0123456789876543210 @x @a @b (_f_0123456789876543210 :: (~>) a b) (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: T x a) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (LamCases_0123456789876543210Sym0 x _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 @x @a @b (_f_0123456789876543210 :: (~>) a b) (MkT2 a_0123456789876543210 :: T x a) = Apply MkT2Sym0 (Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210) a_0123456789876543210)+ type family LamCases_0123456789876543210 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 _ = _z_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_z_01234567898765432100123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type TFHelper_0123456789876543210 :: forall x a b. a+ -> T x b -> T x a+ type family TFHelper_0123456789876543210 @x @a @b (a :: a) (a :: T x b) :: T x a where+ TFHelper_0123456789876543210 @x @a @b (_z_0123456789876543210 :: a) (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: T x b) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (LamCases_0123456789876543210Sym0 x _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210)) (Apply (LamCases_0123456789876543210Sym0 x _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 @x @a @b (_z_0123456789876543210 :: a) (MkT2 a_0123456789876543210 :: T x b) = Apply MkT2Sym0 (Apply (LamCases_0123456789876543210Sym0 x _z_0123456789876543210 a_0123456789876543210) a_0123456789876543210)+ instance PFunctor (T x) where+ type Fmap a a = Fmap_0123456789876543210 a a+ type (<$) a a = TFHelper_0123456789876543210 a a+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 _ = MemptySym0+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 a_0123456789876543210 _ = MemptySym0+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type FoldMap_0123456789876543210 :: forall x a m. (~>) a m+ -> T x a -> m+ type family FoldMap_0123456789876543210 @x @a @m (a :: (~>) a m) (a :: T x a) :: m where+ FoldMap_0123456789876543210 @x @a @m (_f_0123456789876543210 :: (~>) a m) (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: T x a) = Apply (Apply MappendSym0 (Apply (LamCases_0123456789876543210Sym0 x _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 @x @a @m (_f_0123456789876543210 :: (~>) a m) (MkT2 a_0123456789876543210 :: T x a) = Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210) a_0123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 _ n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _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+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x n1_0123456789876543210 n2_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+ data LamCases_0123456789876543210Sym0 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (LamCases_0123456789876543210Sym0 x n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 _ n_0123456789876543210 = n_0123456789876543210+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 x0123456789876543210 (_f_01234567898765432100123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (_z_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type Foldr_0123456789876543210 :: forall x a b. (~>) a ((~>) b b)+ -> b -> T x a -> b+ type family Foldr_0123456789876543210 @x @a @b (a :: (~>) a ((~>) b b)) (a :: b) (a :: T x a) :: b where+ Foldr_0123456789876543210 @x @a @b (_f_0123456789876543210 :: (~>) a ((~>) b b)) (_z_0123456789876543210 :: b) (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: T x a) = Apply (Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) (Apply (Apply _f_0123456789876543210 a_0123456789876543210) (Apply (Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) (Apply (Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210)))+ Foldr_0123456789876543210 @x @a @b (_f_0123456789876543210 :: (~>) a ((~>) b b)) (_z_0123456789876543210 :: b) (MkT2 a_0123456789876543210 :: T x a) = Apply (Apply (LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210+ instance PFoldable (T x) where+ type FoldMap a a = FoldMap_0123456789876543210 a a+ type Foldr a a a = Foldr_0123456789876543210 a a a+ type Traverse_0123456789876543210 :: forall x a f b. (~>) a (f b)+ -> T x a -> f (T x b)+ type family Traverse_0123456789876543210 @x @a @f @b (a :: (~>) a (f b)) (a :: T x a) :: f (T x b) where+ Traverse_0123456789876543210 @x @a @f @b (_f_0123456789876543210 :: (~>) a (f b)) (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: T x a) = 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 @x @a @f @b (_f_0123456789876543210 :: (~>) a (f b)) (MkT2 a_0123456789876543210 :: T x a) = Apply (Apply FmapSym0 MkT2Sym0) (Apply PureSym0 a_0123456789876543210)+ instance PTraversable (T x) where+ type Traverse a a = Traverse_0123456789876543210 a a+ type family LamCases_0123456789876543210 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_0123456789876543210 where+ data LamCases_0123456789876543210Sym0 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type Fmap_0123456789876543210 :: forall a b. (~>) a b+ -> Empty a -> Empty b+ type family Fmap_0123456789876543210 @a @b (a :: (~>) a b) (a :: Empty a) :: Empty b where+ Fmap_0123456789876543210 @a @b _ v_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 v_0123456789876543210) v_0123456789876543210+ type family LamCases_0123456789876543210 (v_01234567898765432100123456789876543210 :: Empty b0123456789876543210) a_0123456789876543210 where+ data LamCases_0123456789876543210Sym0 (v_01234567898765432100123456789876543210 :: Empty b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (v_01234567898765432100123456789876543210 :: Empty b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type TFHelper_0123456789876543210 :: forall a b. a+ -> Empty b -> Empty a+ type family TFHelper_0123456789876543210 @a @b (a :: a) (a :: Empty b) :: Empty a where+ TFHelper_0123456789876543210 @a @b _ v_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 v_0123456789876543210) v_0123456789876543210+ instance PFunctor Empty where+ type Fmap a a = Fmap_0123456789876543210 a a+ type (<$) a a = TFHelper_0123456789876543210 a a+ type FoldMap_0123456789876543210 :: forall a m. (~>) a m+ -> Empty a -> m+ type family FoldMap_0123456789876543210 @a @m (a :: (~>) a m) (a :: Empty a) :: m where+ FoldMap_0123456789876543210 @a @m _ _ = MemptySym0+ instance PFoldable Empty where+ type FoldMap a a = FoldMap_0123456789876543210 a a+ type family LamCases_0123456789876543210 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_0123456789876543210 where+ data LamCases_0123456789876543210Sym0 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 v_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (v_01234567898765432100123456789876543210 :: Empty a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 v_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type Traverse_0123456789876543210 :: forall a f b. (~>) a (f b)+ -> Empty a -> f (Empty b)+ type family Traverse_0123456789876543210 @a @f @b (a :: (~>) a (f b)) (a :: Empty a) :: f (Empty b) where+ Traverse_0123456789876543210 @a @f @b _ v_0123456789876543210 = Apply PureSym0 (Apply (LamCases_0123456789876543210Sym0 v_0123456789876543210) v_0123456789876543210)+ instance PTraversable Empty where+ type Traverse a a = Traverse_0123456789876543210 a a+ data ST :: forall x a. T x a -> Type+ where+ SMkT1 :: forall x+ a+ (n :: x)+ (n :: a)+ (n :: Maybe a)+ (n :: Maybe (Maybe a)).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ ST (MkT1 n n n n :: T x a)+ SMkT2 :: forall x a (n :: Maybe x).+ (Sing n) -> ST (MkT2 n :: T x a)+ type instance Sing @(T x a) = ST+ 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))))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SMkT1 c c c c))+ (toSing b :: SomeSing x) (toSing b :: SomeSing a)+ (toSing b :: SomeSing (Maybe a))+ (toSing b :: SomeSing (Maybe (Maybe a)))+ toSing (MkT2 (b :: Demote (Maybe x)))+ = (\cases (SomeSing c) -> SomeSing (SMkT2 c))+ (toSing b :: SomeSing (Maybe x))+ data SEmpty :: forall (a :: Type). Empty a -> Type+ type instance Sing @(Empty a) = SEmpty+ instance SingKind a => SingKind (Empty a) where+ type Demote (Empty a) = Empty (Demote a)+ fromSing x = (\case) x+ toSing x = SomeSing ((\case) x)+ instance SFunctor (T x) where+ 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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN_0123456789876543210 :: 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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN_0123456789876543210 :: 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+ @(LamCases_0123456789876543210Sym0 x _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN_0123456789876543210 :: Sing n_0123456789876543210)+ -> sN_0123456789876543210))+ sA_0123456789876543210))+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases _ -> _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+ @(LamCases_0123456789876543210Sym0 x _z_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN_0123456789876543210 :: Sing n_0123456789876543210)+ -> sN_0123456789876543210))+ sA_0123456789876543210)+ instance SFoldable (T x) where+ 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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases _ -> 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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 a_0123456789876543210)+ (\cases _ -> 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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ _ (sN_0123456789876543210 :: Sing n_0123456789876543210)+ -> sN_0123456789876543210))+ sA_0123456789876543210)+ (applySing+ (applySing _sf_0123456789876543210 sA_0123456789876543210)+ (applySing+ (applySing+ (singFun2+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN1_0123456789876543210 :: Sing n1_0123456789876543210)+ (sN2_0123456789876543210 :: Sing n2_0123456789876543210)+ -> applySing+ (applySing+ (applySing+ (singFun3 @FoldrSym0 sFoldr) _sf_0123456789876543210)+ sN2_0123456789876543210)+ sN1_0123456789876543210))+ sA_0123456789876543210)+ (applySing+ (applySing+ (singFun2+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN1_0123456789876543210 :: Sing n1_0123456789876543210)+ (sN2_0123456789876543210 :: Sing n2_0123456789876543210)+ -> applySing+ (applySing+ (applySing+ (singFun3 @FoldrSym0 sFoldr)+ (singFun2+ @(LamCases_0123456789876543210Sym0 x n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN1_0123456789876543210 :: Sing n1_0123456789876543210)+ (sN2_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+ @(LamCases_0123456789876543210Sym0 x _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210)+ (\cases+ _ (sN_0123456789876543210 :: Sing n_0123456789876543210)+ -> sN_0123456789876543210))+ sA_0123456789876543210)+ _sz_0123456789876543210+ instance STraversable (T x) where+ 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 _ (sV_0123456789876543210 :: Sing v_0123456789876543210)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 v_0123456789876543210) (\case))+ sV_0123456789876543210+ (%<$) _ (sV_0123456789876543210 :: Sing v_0123456789876543210)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 v_0123456789876543210) (\case))+ sV_0123456789876543210+ instance SFoldable Empty where+ sFoldMap _ _ = sMempty+ instance STraversable Empty where+ sTraverse _ (sV_0123456789876543210 :: Sing v_0123456789876543210)+ = applySing+ (singFun1 @PureSym0 sPure)+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 v_0123456789876543210) (\case))+ sV_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 n, SingI n, SingI n) =>+ SingI1 (MkT1 (n :: x) (n :: a) (n :: Maybe a)) where+ liftSing = SMkT1 sing sing sing+ instance (SingI n, SingI n) =>+ SingI2 (MkT1 (n :: x) (n :: a)) where+ liftSing2 = SMkT1 sing sing+ instance SingI (MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where+ sing = singFun4 @MkT1Sym0 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 SingI1 (MkT1Sym1 :: x+ -> (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where+ liftSing (s :: Sing (d :: x))+ = singFun3 @(MkT1Sym1 (d :: x)) (SMkT1 s)+ 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 =>+ SingI1 (MkT1Sym2 (d :: x) :: a+ -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where+ liftSing (s :: Sing (d :: a))+ = singFun2 @(MkT1Sym2 (d :: x) (d :: a)) (SMkT1 (sing @d) s)+ instance SingI2 (MkT1Sym2 :: x+ -> a -> (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where+ liftSing2 (s :: Sing (d :: x)) (s :: Sing (d :: a))+ = singFun2 @(MkT1Sym2 (d :: x) (d :: a)) (SMkT1 s s)+ 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) =>+ SingI1 (MkT1Sym3 (d :: x) (d :: a) :: Maybe a+ -> (~>) (Maybe (Maybe a)) (T x a)) where+ liftSing (s :: Sing (d :: Maybe a))+ = singFun1+ @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a))+ (SMkT1 (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (MkT1Sym3 (d :: x) :: a+ -> Maybe a -> (~>) (Maybe (Maybe a)) (T x a)) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: Maybe a))+ = singFun1+ @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a)) (SMkT1 (sing @d) s s)+ instance SingI n => SingI (MkT2 (n :: Maybe x)) where+ sing = SMkT2 sing+ instance SingI1 MkT2 where+ liftSing = SMkT2+ instance SingI (MkT2Sym0 :: (~>) (Maybe x) (T x a)) where+ sing = singFun1 @MkT2Sym0 SMkT2
tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs view
@@ -1,16 +1,16 @@--- 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.Base.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) - |]) +-- 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.Base.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.golden view
@@ -1,514 +1,495 @@-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 LeftSym0 :: forall a b. (~>) a (Either a b) - data LeftSym0 :: (~>) a (Either a b) - where - LeftSym0KindInference :: SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => - LeftSym0 a0123456789876543210 - type instance Apply LeftSym0 a0123456789876543210 = Left a0123456789876543210 - instance SuppressUnusedWarnings LeftSym0 where - suppressUnusedWarnings = snd ((,) LeftSym0KindInference ()) - type LeftSym1 :: forall a b. a -> Either a b - type family LeftSym1 (a0123456789876543210 :: a) :: Either a b where - LeftSym1 a0123456789876543210 = Left a0123456789876543210 - type RightSym0 :: forall a b. (~>) b (Either a b) - data RightSym0 :: (~>) b (Either a b) - where - RightSym0KindInference :: SameKind (Apply RightSym0 arg) (RightSym1 arg) => - RightSym0 a0123456789876543210 - type instance Apply RightSym0 a0123456789876543210 = Right a0123456789876543210 - instance SuppressUnusedWarnings RightSym0 where - suppressUnusedWarnings = snd ((,) RightSym0KindInference ()) - type RightSym1 :: forall a b. b -> Either a b - type family RightSym1 (a0123456789876543210 :: b) :: Either a b where - RightSym1 a0123456789876543210 = Right a0123456789876543210 - 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 n b where - Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) n0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 where - Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n0123456789876543210 b0123456789876543210 - type family Case_0123456789876543210 n b ns bs t where - Case_0123456789876543210 n b ns bs 'True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 n b ns bs 'False = n - type family Lambda_0123456789876543210 ns bs n b where - Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 n b ns bs b - data Lambda_0123456789876543210Sym0 ns0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 ns0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 ns0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) n0123456789876543210 = Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 n0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 where - Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 = Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 n0123456789876543210 b0123456789876543210 - type EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - where - EtadSym0KindInference :: SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => - EtadSym0 a0123456789876543210 - type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 - instance SuppressUnusedWarnings EtadSym0 where - suppressUnusedWarnings = snd ((,) EtadSym0KindInference ()) - type EtadSym1 :: [Nat] -> (~>) [Bool] [Nat] - data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] - where - EtadSym1KindInference :: SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => - EtadSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) EtadSym1KindInference ()) - type EtadSym2 :: [Nat] -> [Bool] -> [Nat] - type family EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) :: [Nat] where - EtadSym2 a0123456789876543210 a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 - type SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - where - SplungeSym0KindInference :: SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => - SplungeSym0 a0123456789876543210 - type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210 - instance SuppressUnusedWarnings SplungeSym0 where - suppressUnusedWarnings = snd ((,) SplungeSym0KindInference ()) - type SplungeSym1 :: [Nat] -> (~>) [Bool] [Nat] - data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] - where - SplungeSym1KindInference :: SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => - SplungeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) SplungeSym1KindInference ()) - type SplungeSym2 :: [Nat] -> [Bool] -> [Nat] - type family SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) :: [Nat] where - SplungeSym2 a0123456789876543210 a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210 - type FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b)) - data FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b)) - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: (~>) ((~>) a b) ((~>) a b) - -> (~>) ((~>) a b) ((~>) a b) - data FooSym1 (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) :: (~>) ((~>) a b) ((~>) a b) - where - FooSym1KindInference :: SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => - FooSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FooSym1KindInference ()) - type FooSym2 :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> (~>) a b - data FooSym2 (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) (a0123456789876543210 :: (~>) a b) :: (~>) a b - where - FooSym2KindInference :: 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 (FooSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FooSym2KindInference ()) - type FooSym3 :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> a -> b - type family FooSym3 (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: a) :: b where - FooSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 - type ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c])) - data ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c])) - where - ZipWithSym0KindInference :: SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => - ZipWithSym0 a0123456789876543210 - type instance Apply ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210 - instance SuppressUnusedWarnings ZipWithSym0 where - suppressUnusedWarnings = snd ((,) ZipWithSym0KindInference ()) - type ZipWithSym1 :: (~>) a ((~>) b c) -> (~>) [a] ((~>) [b] [c]) - data ZipWithSym1 (a0123456789876543210 :: (~>) a ((~>) b c)) :: (~>) [a] ((~>) [b] [c]) - where - ZipWithSym1KindInference :: SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) => - ZipWithSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ZipWithSym1KindInference ()) - type ZipWithSym2 :: (~>) a ((~>) b c) -> [a] -> (~>) [b] [c] - data ZipWithSym2 (a0123456789876543210 :: (~>) a ((~>) b c)) (a0123456789876543210 :: [a]) :: (~>) [b] [c] - where - ZipWithSym2KindInference :: 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 (ZipWithSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ZipWithSym2KindInference ()) - type ZipWithSym3 :: (~>) a ((~>) b c) -> [a] -> [b] -> [c] - type family ZipWithSym3 (a0123456789876543210 :: (~>) a ((~>) b c)) (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [c] where - ZipWithSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 - type LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b)) - data LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b)) - where - LiftMaybeSym0KindInference :: SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => - LiftMaybeSym0 a0123456789876543210 - type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210 - instance SuppressUnusedWarnings LiftMaybeSym0 where - suppressUnusedWarnings = snd ((,) LiftMaybeSym0KindInference ()) - type LiftMaybeSym1 :: (~>) a b -> (~>) (Maybe a) (Maybe b) - data LiftMaybeSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Maybe a) (Maybe b) - where - LiftMaybeSym1KindInference :: SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => - LiftMaybeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) LiftMaybeSym1KindInference ()) - type LiftMaybeSym2 :: (~>) a b -> Maybe a -> Maybe b - type family LiftMaybeSym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Maybe a) :: Maybe b where - LiftMaybeSym2 a0123456789876543210 a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 - type MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b]) - data MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b]) - where - MapSym0KindInference :: SameKind (Apply MapSym0 arg) (MapSym1 arg) => - MapSym0 a0123456789876543210 - type instance Apply MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210 - instance SuppressUnusedWarnings MapSym0 where - suppressUnusedWarnings = snd ((,) MapSym0KindInference ()) - type MapSym1 :: (~>) a b -> (~>) [a] [b] - data MapSym1 (a0123456789876543210 :: (~>) a b) :: (~>) [a] [b] - where - MapSym1KindInference :: SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) => - MapSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = Map a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MapSym1KindInference ()) - type MapSym2 :: (~>) a b -> [a] -> [b] - type family MapSym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: [a]) :: [b] where - MapSym2 a0123456789876543210 a0123456789876543210 = Map a0123456789876543210 a0123456789876543210 - type Etad :: [Nat] -> [Bool] -> [Nat] - 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 Splunge :: [Nat] -> [Bool] -> [Nat] - 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 Foo :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> a -> b - 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 ZipWith :: (~>) a ((~>) b c) -> [a] -> [b] -> [c] - 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 _ '[] '[] = NilSym0 - ZipWith _ ('(:) _ _) '[] = NilSym0 - ZipWith _ '[] ('(:) _ _) = NilSym0 - type LiftMaybe :: (~>) a b -> Maybe a -> Maybe b - 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 Map :: (~>) a b -> [a] -> [b] - type family Map (a :: (~>) a b) (a :: [a]) :: [b] where - Map _ '[] = NilSym0 - Map f ('(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) - sEtad :: - (forall (t :: [Nat]) (t :: [Bool]). - Sing t - -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) :: Type) - sSplunge :: - (forall (t :: [Nat]) (t :: [Bool]). - Sing t - -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) :: Type) - sFoo :: - (forall (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) :: Type) - sZipWith :: - (forall (t :: (~>) a ((~>) b c)) (t :: [a]) (t :: [b]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) :: Type) - sLiftMaybe :: - (forall (t :: (~>) a b) (t :: Maybe a). - Sing t - -> Sing t - -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) :: Type) - sMap :: - (forall (t :: (~>) a b) (t :: [a]). - Sing t - -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) :: Type) - 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) - -> id - @(Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b)) - (case sB of - STrue - -> applySing - (singFun1 @SuccSym0 SSucc) - (applySing (singFun1 @SuccSym0 SSucc) sN) - SFalse -> sN)))) - sA_0123456789876543210) - sA_0123456789876543210 - 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) - -> id - @(Sing (Case_0123456789876543210 n b ns bs b)) - (case sB of - STrue - -> applySing - (singFun1 @SuccSym0 SSucc) - (applySing (singFun1 @SuccSym0 SSucc) sN) - SFalse -> sN)))) - sNs) - sBs - 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 - 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 (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 SingI1 (EtadSym1 :: [Nat] -> (~>) [Bool] [Nat]) where - liftSing (s :: Sing (d :: [Nat])) - = singFun1 @(EtadSym1 (d :: [Nat])) (sEtad s) - 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 SingI1 (SplungeSym1 :: [Nat] -> (~>) [Bool] [Nat]) where - liftSing (s :: Sing (d :: [Nat])) - = singFun1 @(SplungeSym1 (d :: [Nat])) (sSplunge s) - 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 SingI1 (FooSym1 :: (~>) ((~>) a b) ((~>) a b) - -> (~>) ((~>) a b) ((~>) a b)) where - liftSing (s :: Sing (d :: (~>) ((~>) a b) ((~>) a b))) - = singFun2 @(FooSym1 (d :: (~>) ((~>) a b) ((~>) a b))) (sFoo s) - 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 d => - SingI1 (FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) :: (~>) a b - -> (~>) a b) where - liftSing (s :: Sing (d :: (~>) a b)) - = singFun1 - @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b)) - (sFoo (sing @d) s) - instance SingI2 (FooSym2 :: (~>) ((~>) a b) ((~>) a b) - -> (~>) a b -> (~>) a b) where - liftSing2 - (s :: Sing (d :: (~>) ((~>) a b) ((~>) a b))) - (s :: Sing (d :: (~>) a b)) - = singFun1 - @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b)) - (sFoo s s) - 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 SingI1 (ZipWithSym1 :: (~>) a ((~>) b c) - -> (~>) [a] ((~>) [b] [c])) where - liftSing (s :: Sing (d :: (~>) a ((~>) b c))) - = singFun2 @(ZipWithSym1 (d :: (~>) a ((~>) b c))) (sZipWith s) - 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 d => - SingI1 (ZipWithSym2 (d :: (~>) a ((~>) b c)) :: [a] - -> (~>) [b] [c]) where - liftSing (s :: Sing (d :: [a])) - = singFun1 - @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a])) - (sZipWith (sing @d) s) - instance SingI2 (ZipWithSym2 :: (~>) a ((~>) b c) - -> [a] -> (~>) [b] [c]) where - liftSing2 - (s :: Sing (d :: (~>) a ((~>) b c))) - (s :: Sing (d :: [a])) - = singFun1 - @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a])) (sZipWith s s) - 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 SingI1 (LiftMaybeSym1 :: (~>) a b - -> (~>) (Maybe a) (Maybe b)) where - liftSing (s :: Sing (d :: (~>) a b)) - = singFun1 @(LiftMaybeSym1 (d :: (~>) a b)) (sLiftMaybe s) - 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)) - instance SingI1 (MapSym1 :: (~>) a b -> (~>) [a] [b]) where - liftSing (s :: Sing (d :: (~>) a b)) - = singFun1 @(MapSym1 (d :: (~>) a b)) (sMap s) - data SEither :: forall a b. Either a b -> Type - where - SLeft :: forall a b (n :: a). - (Sing n) -> SEither (Left n :: Either a b) - SRight :: forall a b (n :: b). - (Sing n) -> SEither (Right n :: Either a b) - type instance Sing @(Either a b) = SEither - 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 SingI1 Left where - liftSing = SLeft - instance SingI (LeftSym0 :: (~>) a (Either a b)) where - sing = singFun1 @LeftSym0 SLeft - instance SingI n => SingI (Right (n :: b)) where - sing = SRight sing - instance SingI1 Right where - liftSing = SRight - instance SingI (RightSym0 :: (~>) b (Either a b)) where - sing = singFun1 @RightSym0 SRight +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 LeftSym0 :: forall a b. (~>) a (Either a b)+ data LeftSym0 :: (~>) a (Either a b)+ where+ LeftSym0KindInference :: SameKind (Apply LeftSym0 arg) (LeftSym1 arg) =>+ LeftSym0 a0123456789876543210+ type instance Apply @a @(Either a b) LeftSym0 a0123456789876543210 = Left a0123456789876543210+ instance SuppressUnusedWarnings LeftSym0 where+ suppressUnusedWarnings = snd ((,) LeftSym0KindInference ())+ type LeftSym1 :: forall a b. a -> Either a b+ type family LeftSym1 @a @b (a0123456789876543210 :: a) :: Either a b where+ LeftSym1 a0123456789876543210 = Left a0123456789876543210+ type RightSym0 :: forall a b. (~>) b (Either a b)+ data RightSym0 :: (~>) b (Either a b)+ where+ RightSym0KindInference :: SameKind (Apply RightSym0 arg) (RightSym1 arg) =>+ RightSym0 a0123456789876543210+ type instance Apply @b @(Either a b) RightSym0 a0123456789876543210 = Right a0123456789876543210+ instance SuppressUnusedWarnings RightSym0 where+ suppressUnusedWarnings = snd ((,) RightSym0KindInference ())+ type RightSym1 :: forall a b. b -> Either a b+ type family RightSym1 @a @b (a0123456789876543210 :: b) :: Either a b where+ RightSym1 a0123456789876543210 = Right a0123456789876543210+ type family LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_0123456789876543210 where+ LamCases_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'True = Apply SuccSym0 (Apply SuccSym0 n)+ LamCases_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'False = n+ data LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Apply (LamCases_0123456789876543210Sym0 n b a_0123456789876543210 a_0123456789876543210) b+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 (a_01234567898765432100123456789876543210 :: [Nat]) (a_01234567898765432100123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_0123456789876543210 where+ LamCases_0123456789876543210 n b ns bs 'True = Apply SuccSym0 (Apply SuccSym0 n)+ LamCases_0123456789876543210 n b ns bs 'False = n+ data LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 b0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ns bs n b = Apply (LamCases_0123456789876543210Sym0 n b ns bs) b+ data LamCases_0123456789876543210Sym0 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 ns0123456789876543210 bs0123456789876543210) arg) (LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 ns0123456789876543210 bs0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 ns0123456789876543210 bs0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 (ns0123456789876543210 :: [Nat]) (bs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 ns0123456789876543210 bs0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])+ data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])+ where+ EtadSym0KindInference :: SameKind (Apply EtadSym0 arg) (EtadSym1 arg) =>+ EtadSym0 a0123456789876543210+ type instance Apply @[Nat] @((~>) [Bool] [Nat]) EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210+ instance SuppressUnusedWarnings EtadSym0 where+ suppressUnusedWarnings = snd ((,) EtadSym0KindInference ())+ type EtadSym1 :: [Nat] -> (~>) [Bool] [Nat]+ data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat]+ where+ EtadSym1KindInference :: SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) =>+ EtadSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[Bool] @[Nat] (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) EtadSym1KindInference ())+ type EtadSym2 :: [Nat] -> [Bool] -> [Nat]+ type family EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) :: [Nat] where+ EtadSym2 a0123456789876543210 a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210+ type SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])+ data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])+ where+ SplungeSym0KindInference :: SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) =>+ SplungeSym0 a0123456789876543210+ type instance Apply @[Nat] @((~>) [Bool] [Nat]) SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210+ instance SuppressUnusedWarnings SplungeSym0 where+ suppressUnusedWarnings = snd ((,) SplungeSym0KindInference ())+ type SplungeSym1 :: [Nat] -> (~>) [Bool] [Nat]+ data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat]+ where+ SplungeSym1KindInference :: SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) =>+ SplungeSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[Bool] @[Nat] (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) SplungeSym1KindInference ())+ type SplungeSym2 :: [Nat] -> [Bool] -> [Nat]+ type family SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) :: [Nat] where+ SplungeSym2 a0123456789876543210 a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210+ type FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))+ data FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @((~>) ((~>) a b) ((~>) a b)) @((~>) ((~>) a b) ((~>) a b)) FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: (~>) ((~>) a b) ((~>) a b)+ -> (~>) ((~>) a b) ((~>) a b)+ data FooSym1 (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) :: (~>) ((~>) a b) ((~>) a b)+ where+ FooSym1KindInference :: SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) =>+ FooSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @((~>) a b) @((~>) a b) (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooSym1KindInference ())+ type FooSym2 :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> (~>) a b+ data FooSym2 (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) (a0123456789876543210 :: (~>) a b) :: (~>) a b+ where+ FooSym2KindInference :: SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) =>+ FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @a @b (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooSym2KindInference ())+ type FooSym3 :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> a -> b+ type family FooSym3 @a @b (a0123456789876543210 :: (~>) ((~>) a b) ((~>) a b)) (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: a) :: b where+ FooSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210+ type ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c]))+ data ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c]))+ where+ ZipWithSym0KindInference :: SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) =>+ ZipWithSym0 a0123456789876543210+ type instance Apply @((~>) a ((~>) b c)) @((~>) [a] ((~>) [b] [c])) ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210+ instance SuppressUnusedWarnings ZipWithSym0 where+ suppressUnusedWarnings = snd ((,) ZipWithSym0KindInference ())+ type ZipWithSym1 :: (~>) a ((~>) b c) -> (~>) [a] ((~>) [b] [c])+ data ZipWithSym1 (a0123456789876543210 :: (~>) a ((~>) b c)) :: (~>) [a] ((~>) [b] [c])+ where+ ZipWithSym1KindInference :: SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) =>+ ZipWithSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[a] @((~>) [b] [c]) (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ZipWithSym1KindInference ())+ type ZipWithSym2 :: (~>) a ((~>) b c) -> [a] -> (~>) [b] [c]+ data ZipWithSym2 (a0123456789876543210 :: (~>) a ((~>) b c)) (a0123456789876543210 :: [a]) :: (~>) [b] [c]+ where+ ZipWithSym2KindInference :: SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) =>+ ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @[b] @[c] (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ZipWithSym2KindInference ())+ type ZipWithSym3 :: (~>) a ((~>) b c) -> [a] -> [b] -> [c]+ type family ZipWithSym3 @a @b @c (a0123456789876543210 :: (~>) a ((~>) b c)) (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [c] where+ ZipWithSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210+ type LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))+ data LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))+ where+ LiftMaybeSym0KindInference :: SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>+ LiftMaybeSym0 a0123456789876543210+ type instance Apply @((~>) a b) @((~>) (Maybe a) (Maybe b)) LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210+ instance SuppressUnusedWarnings LiftMaybeSym0 where+ suppressUnusedWarnings = snd ((,) LiftMaybeSym0KindInference ())+ type LiftMaybeSym1 :: (~>) a b -> (~>) (Maybe a) (Maybe b)+ data LiftMaybeSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Maybe a) (Maybe b)+ where+ LiftMaybeSym1KindInference :: SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) =>+ LiftMaybeSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @(Maybe b) (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) LiftMaybeSym1KindInference ())+ type LiftMaybeSym2 :: (~>) a b -> Maybe a -> Maybe b+ type family LiftMaybeSym2 @a @b (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Maybe a) :: Maybe b where+ LiftMaybeSym2 a0123456789876543210 a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210+ type MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b])+ data MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b])+ where+ MapSym0KindInference :: SameKind (Apply MapSym0 arg) (MapSym1 arg) =>+ MapSym0 a0123456789876543210+ type instance Apply @((~>) a b) @((~>) [a] [b]) MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210+ instance SuppressUnusedWarnings MapSym0 where+ suppressUnusedWarnings = snd ((,) MapSym0KindInference ())+ type MapSym1 :: (~>) a b -> (~>) [a] [b]+ data MapSym1 (a0123456789876543210 :: (~>) a b) :: (~>) [a] [b]+ where+ MapSym1KindInference :: SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) =>+ MapSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[a] @[b] (MapSym1 a0123456789876543210) a0123456789876543210 = Map a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MapSym1KindInference ())+ type MapSym2 :: (~>) a b -> [a] -> [b]+ type family MapSym2 @a @b (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: [a]) :: [b] where+ MapSym2 a0123456789876543210 a0123456789876543210 = Map a0123456789876543210 a0123456789876543210+ type Etad :: [Nat] -> [Bool] -> [Nat]+ type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where+ Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (LamCases_0123456789876543210Sym0 a_0123456789876543210 a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210+ type Splunge :: [Nat] -> [Bool] -> [Nat]+ type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where+ Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (LamCases_0123456789876543210Sym0 ns bs)) ns) bs+ type Foo :: (~>) ((~>) a b) ((~>) a b) -> (~>) a b -> a -> b+ type family Foo @a @b (a :: (~>) ((~>) a b) ((~>) a b)) (a :: (~>) a b) (a :: a) :: b where+ Foo f g a = Apply (Apply f g) a+ type ZipWith :: (~>) a ((~>) b c) -> [a] -> [b] -> [c]+ type family ZipWith @a @b @c (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 _ '[] '[] = NilSym0+ ZipWith _ ('(:) _ _) '[] = NilSym0+ ZipWith _ '[] ('(:) _ _) = NilSym0+ type LiftMaybe :: (~>) a b -> Maybe a -> Maybe b+ type family LiftMaybe @a @b (a :: (~>) a b) (a :: Maybe a) :: Maybe b where+ LiftMaybe f ('Just x) = Apply JustSym0 (Apply f x)+ LiftMaybe _ 'Nothing = NothingSym0+ type Map :: (~>) a b -> [a] -> [b]+ type family Map @a @b (a :: (~>) a b) (a :: [a]) :: [b] where+ Map _ '[] = NilSym0+ Map f ('(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t)+ sEtad ::+ (forall (t :: [Nat]) (t :: [Bool]).+ Sing t -> Sing t -> Sing (Etad t t :: [Nat]) :: Type)+ sSplunge ::+ (forall (t :: [Nat]) (t :: [Bool]).+ Sing t -> Sing t -> Sing (Splunge t t :: [Nat]) :: Type)+ sFoo ::+ (forall (t :: (~>) ((~>) a b) ((~>) a b)) (t :: (~>) a b) (t :: a).+ Sing t -> Sing t -> Sing t -> Sing (Foo t t t :: b) :: Type)+ sZipWith ::+ (forall (t :: (~>) a ((~>) b c)) (t :: [a]) (t :: [b]).+ Sing t -> Sing t -> Sing t -> Sing (ZipWith t t t :: [c]) :: Type)+ sLiftMaybe ::+ (forall (t :: (~>) a b) (t :: Maybe a).+ Sing t -> Sing t -> Sing (LiftMaybe t t :: Maybe b) :: Type)+ sMap ::+ (forall (t :: (~>) a b) (t :: [a]).+ Sing t -> Sing t -> Sing (Map t t :: [b]) :: Type)+ sEtad+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (applySing+ (singFun3 @ZipWithSym0 sZipWith)+ (singFun2+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210 a_0123456789876543210)+ (\cases+ (sN :: Sing n) (sB :: Sing b)+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n b a_0123456789876543210 a_0123456789876543210)+ (\cases+ STrue+ -> applySing+ (singFun1 @SuccSym0 SSucc)+ (applySing (singFun1 @SuccSym0 SSucc) sN)+ SFalse -> sN))+ sB)))+ sA_0123456789876543210)+ sA_0123456789876543210+ sSplunge (sNs :: Sing ns) (sBs :: Sing bs)+ = applySing+ (applySing+ (applySing+ (singFun3 @ZipWithSym0 sZipWith)+ (singFun2+ @(LamCases_0123456789876543210Sym0 ns bs)+ (\cases+ (sN :: Sing n) (sB :: Sing b)+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n b ns bs)+ (\cases+ STrue+ -> applySing+ (singFun1 @SuccSym0 SSucc)+ (applySing (singFun1 @SuccSym0 SSucc) sN)+ SFalse -> sN))+ sB)))+ sNs)+ sBs+ 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+ 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 (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 SingI1 (EtadSym1 :: [Nat] -> (~>) [Bool] [Nat]) where+ liftSing (s :: Sing (d :: [Nat]))+ = singFun1 @(EtadSym1 (d :: [Nat])) (sEtad s)+ 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 SingI1 (SplungeSym1 :: [Nat] -> (~>) [Bool] [Nat]) where+ liftSing (s :: Sing (d :: [Nat]))+ = singFun1 @(SplungeSym1 (d :: [Nat])) (sSplunge s)+ 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 SingI1 (FooSym1 :: (~>) ((~>) a b) ((~>) a b)+ -> (~>) ((~>) a b) ((~>) a b)) where+ liftSing (s :: Sing (d :: (~>) ((~>) a b) ((~>) a b)))+ = singFun2 @(FooSym1 (d :: (~>) ((~>) a b) ((~>) a b))) (sFoo s)+ 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 d =>+ SingI1 (FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) :: (~>) a b+ -> (~>) a b) where+ liftSing (s :: Sing (d :: (~>) a b))+ = singFun1+ @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b))+ (sFoo (sing @d) s)+ instance SingI2 (FooSym2 :: (~>) ((~>) a b) ((~>) a b)+ -> (~>) a b -> (~>) a b) where+ liftSing2+ (s :: Sing (d :: (~>) ((~>) a b) ((~>) a b)))+ (s :: Sing (d :: (~>) a b))+ = singFun1+ @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b))+ (sFoo s s)+ 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 SingI1 (ZipWithSym1 :: (~>) a ((~>) b c)+ -> (~>) [a] ((~>) [b] [c])) where+ liftSing (s :: Sing (d :: (~>) a ((~>) b c)))+ = singFun2 @(ZipWithSym1 (d :: (~>) a ((~>) b c))) (sZipWith s)+ 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 d =>+ SingI1 (ZipWithSym2 (d :: (~>) a ((~>) b c)) :: [a]+ -> (~>) [b] [c]) where+ liftSing (s :: Sing (d :: [a]))+ = singFun1+ @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]))+ (sZipWith (sing @d) s)+ instance SingI2 (ZipWithSym2 :: (~>) a ((~>) b c)+ -> [a] -> (~>) [b] [c]) where+ liftSing2+ (s :: Sing (d :: (~>) a ((~>) b c)))+ (s :: Sing (d :: [a]))+ = singFun1+ @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a])) (sZipWith s s)+ 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 SingI1 (LiftMaybeSym1 :: (~>) a b+ -> (~>) (Maybe a) (Maybe b)) where+ liftSing (s :: Sing (d :: (~>) a b))+ = singFun1 @(LiftMaybeSym1 (d :: (~>) a b)) (sLiftMaybe s)+ 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))+ instance SingI1 (MapSym1 :: (~>) a b -> (~>) [a] [b]) where+ liftSing (s :: Sing (d :: (~>) a b))+ = singFun1 @(MapSym1 (d :: (~>) a b)) (sMap s)+ data SEither :: forall a b. Either a b -> Type+ where+ SLeft :: forall a b (n :: a).+ (Sing n) -> SEither (Left n :: Either a b)+ SRight :: forall a b (n :: b).+ (Sing n) -> SEither (Right n :: Either a b)+ type instance Sing @(Either a b) = SEither+ 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))+ = (\cases (SomeSing c) -> SomeSing (SLeft c))+ (toSing b :: SomeSing a)+ toSing (Right (b :: Demote b))+ = (\cases (SomeSing c) -> SomeSing (SRight c))+ (toSing b :: SomeSing b)+ instance SingI n => SingI (Left (n :: a)) where+ sing = SLeft sing+ instance SingI1 Left where+ liftSing = SLeft+ instance SingI (LeftSym0 :: (~>) a (Either a b)) where+ sing = singFun1 @LeftSym0 SLeft+ instance SingI n => SingI (Right (n :: b)) where+ sing = SRight sing+ instance SingI1 Right where+ liftSing = SRight+ instance SingI (RightSym0 :: (~>) b (Either a b)) where+ sing = singFun1 @RightSym0 SRight
tests/compile-and-dump/Singletons/HigherOrder.hs view
@@ -1,55 +1,55 @@-module Singletons.HigherOrder where - -import Data.List.Singletons hiding ( - sMap, Map, MapSym0, MapSym1, MapSym2, - ZipWith, sZipWith, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3 ) -import Data.Maybe.Singletons -import Data.Singletons.Base.TH -import Prelude hiding (Either(..)) -import Singletons.Nat - -$(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 +module Singletons.HigherOrder where++import Data.List.Singletons hiding (+ sMap, Map, MapSym0, MapSym1, MapSym2,+ ZipWith, sZipWith, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3 )+import Data.Maybe.Singletons+import Data.Singletons.Base.TH+import Prelude hiding (Either(..))+import Singletons.Nat++$(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.golden view
@@ -1,250 +1,189 @@-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 x_0123456789876543210 a b t where - Case_0123456789876543210 x_0123456789876543210 a b '(p, _) = p - type family Lambda_0123456789876543210 a b x_0123456789876543210 where - Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 a b x_0123456789876543210 - data Lambda_0123456789876543210Sym0 a0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x_01234567898765432100123456789876543210 - type family Case_0123456789876543210 x_0123456789876543210 d t where - Case_0123456789876543210 x_0123456789876543210 d ('Just y) = y - Case_0123456789876543210 x_0123456789876543210 d 'Nothing = d - type family Lambda_0123456789876543210 d x_0123456789876543210 where - Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x_0123456789876543210 - data Lambda_0123456789876543210Sym0 d0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 d0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 d0123456789876543210 x_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 d0123456789876543210 x_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 x_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 d0123456789876543210 x_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2 d0123456789876543210 x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 x_01234567898765432100123456789876543210 - type family Case_0123456789876543210 x_0123456789876543210 d x t where - Case_0123456789876543210 x_0123456789876543210 d x ('Just y) = y - Case_0123456789876543210 x_0123456789876543210 d x 'Nothing = d - type family Lambda_0123456789876543210 d x x_0123456789876543210 where - Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x x_0123456789876543210 - data Lambda_0123456789876543210Sym0 d0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 d0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 d0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 x_01234567898765432100123456789876543210 - type Foo3Sym0 :: (~>) a ((~>) b a) - data Foo3Sym0 :: (~>) a ((~>) b a) - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: a -> (~>) b a - data Foo3Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo3Sym1KindInference :: SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => - Foo3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo3Sym1KindInference ()) - type Foo3Sym2 :: a -> b -> a - type family Foo3Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo3Sym2 a0123456789876543210 a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 - type Foo2Sym0 :: (~>) a ((~>) (Maybe a) a) - data Foo2Sym0 :: (~>) a ((~>) (Maybe a) a) - where - Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0 a0123456789876543210 - type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ()) - type Foo2Sym1 :: a -> (~>) (Maybe a) a - data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a - where - Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => - Foo2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ()) - type Foo2Sym2 :: a -> Maybe a -> a - type family Foo2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where - Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - type Foo1Sym0 :: (~>) a ((~>) (Maybe a) a) - data Foo1Sym0 :: (~>) a ((~>) (Maybe a) a) - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: a -> (~>) (Maybe a) a - data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a - where - Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => - Foo1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ()) - type Foo1Sym2 :: a -> Maybe a -> a - type family Foo1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where - Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - type Foo3 :: a -> b -> a - 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 Foo2 :: a -> Maybe a -> a - type family Foo2 (a :: a) (a :: Maybe a) :: a where - Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) - type Foo1 :: a -> Maybe a -> a - type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x - sFoo3 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) :: Type) - sFoo2 :: - (forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) :: Type) - sFoo1 :: - (forall (t :: a) (t :: Maybe a). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) :: Type) - sFoo3 (sA :: Sing a) (sB :: Sing b) - = applySing - (singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 a) b) - (\ sX_0123456789876543210 - -> case sX_0123456789876543210 of - (_ :: Sing x_0123456789876543210) - -> id - @(Sing (Case_0123456789876543210 x_0123456789876543210 a b x_0123456789876543210)) - (case sX_0123456789876543210 of STuple2 (sP :: Sing p) _ -> sP))) - (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) - -> id - @(Sing (Case_0123456789876543210 x_0123456789876543210 d x_0123456789876543210)) - (case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD))) - (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) - -> id - @(Sing (Case_0123456789876543210 x_0123456789876543210 d x x_0123456789876543210)) - (case sX_0123456789876543210 of - SJust (sY :: Sing y) -> sY - SNothing -> sD))) - 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 SingI1 (Foo3Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo3Sym1 (d :: a)) (sFoo3 s) - 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 SingI1 (Foo2Sym1 :: a -> (~>) (Maybe a) a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s) - 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)) - instance SingI1 (Foo1Sym1 :: a -> (~>) (Maybe a) a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s) +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 LamCases_0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a b '(p, _) = p+ data LamCases_0123456789876543210Sym0 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (d0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 d ('Just y) = y+ LamCases_0123456789876543210 d 'Nothing = d+ data LamCases_0123456789876543210Sym0 (d0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 d0123456789876543210) arg) (LamCases_0123456789876543210Sym1 d0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 d0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 d0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 d0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (d0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 d0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 d x ('Just y) = y+ LamCases_0123456789876543210 d x 'Nothing = d+ data LamCases_0123456789876543210Sym0 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 d0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (d0123456789876543210 :: a0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 d0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type Foo3Sym0 :: (~>) a ((~>) b a)+ data Foo3Sym0 :: (~>) a ((~>) b a)+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: a -> (~>) b a+ data Foo3Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo3Sym1KindInference :: SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) =>+ Foo3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo3Sym1KindInference ())+ type Foo3Sym2 :: a -> b -> a+ type family Foo3Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo3Sym2 a0123456789876543210 a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210+ type Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)+ data Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)+ where+ Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>+ Foo2Sym0 a0123456789876543210+ type instance Apply @a @((~>) (Maybe a) a) Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo2Sym0 where+ suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ())+ type Foo2Sym1 :: a -> (~>) (Maybe a) a+ data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a+ where+ Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>+ Foo2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @a (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ())+ type Foo2Sym2 :: a -> Maybe a -> a+ type family Foo2Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where+ Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ type Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)+ data Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @a @((~>) (Maybe a) a) Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: a -> (~>) (Maybe a) a+ data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe a) a+ where+ Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>+ Foo1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe a) @a (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ())+ type Foo1Sym2 :: a -> Maybe a -> a+ type family Foo1Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe a) :: a where+ Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ type Foo3 :: a -> b -> a+ type family Foo3 @a @b (a :: a) (a :: b) :: a where+ Foo3 a b = Apply (LamCases_0123456789876543210Sym0 a b) (Apply (Apply Tuple2Sym0 a) b)+ type Foo2 :: a -> Maybe a -> a+ type family Foo2 @a (a :: a) (a :: Maybe a) :: a where+ Foo2 d _ = Apply (LamCases_0123456789876543210Sym0 d) (Apply JustSym0 d)+ type Foo1 :: a -> Maybe a -> a+ type family Foo1 @a (a :: a) (a :: Maybe a) :: a where+ Foo1 d x = Apply (LamCases_0123456789876543210Sym0 d x) x+ sFoo3 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo3 t t :: a) :: Type)+ sFoo2 ::+ (forall (t :: a) (t :: Maybe a).+ Sing t -> Sing t -> Sing (Foo2 t t :: a) :: Type)+ sFoo1 ::+ (forall (t :: a) (t :: Maybe a).+ Sing t -> Sing t -> Sing (Foo1 t t :: a) :: Type)+ sFoo3 (sA :: Sing a) (sB :: Sing b)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a b)+ (\cases (STuple2 (sP :: Sing p) _) -> sP))+ (applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sA) sB)+ sFoo2 (sD :: Sing d) _+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 d)+ (\cases+ (SJust (sY :: Sing y)) -> sY+ SNothing -> sD))+ (applySing (singFun1 @JustSym0 SJust) sD)+ sFoo1 (sD :: Sing d) (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 d x)+ (\cases+ (SJust (sY :: Sing y)) -> sY+ SNothing -> sD))+ 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 SingI1 (Foo3Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo3Sym1 (d :: a)) (sFoo3 s)+ 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 SingI1 (Foo2Sym1 :: a -> (~>) (Maybe a) a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s)+ 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))+ instance SingI1 (Foo1Sym1 :: a -> (~>) (Maybe a) a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s)
tests/compile-and-dump/Singletons/LambdaCase.hs view
@@ -1,38 +1,38 @@-module Singletons.LambdaCase where - -import Data.Singletons.TH -import Prelude.Singletons - -$(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 +module Singletons.LambdaCase where++import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,787 +1,566 @@-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 FooSym0 :: forall a b. (~>) a ((~>) b (Foo a b)) - data FooSym0 :: (~>) a ((~>) b (Foo a b)) - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: forall a b. a -> (~>) b (Foo a b) - data FooSym1 (a0123456789876543210 :: a) :: (~>) b (Foo a b) - where - FooSym1KindInference :: SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => - FooSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FooSym1KindInference ()) - type FooSym2 :: forall a b. a -> b -> Foo a b - type family FooSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Foo a b where - FooSym2 a0123456789876543210 a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 x t where - Case_0123456789876543210 arg_0123456789876543210 x (Foo a _) = a - type family Lambda_0123456789876543210 x arg_0123456789876543210 where - Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 x0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2 x0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 x y t where - Case_0123456789876543210 arg_0123456789876543210 x y '(_, b) = b - type family Lambda_0123456789876543210 x y arg_0123456789876543210 where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 x a b t where - Case_0123456789876543210 arg_0123456789876543210 x a b _ = x - type family Lambda_0123456789876543210 x a b arg_0123456789876543210 where - Lambda_0123456789876543210 x a b arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x a b arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 a b x where - Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a) b - data Lambda_0123456789876543210Sym0 a0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 - type family Lambda_0123456789876543210 x y x where - Lambda_0123456789876543210 x y x = x - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 x0123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z t where - Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z '(_, - _) = x - type family Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 where - Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - type family Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 x y where - Lambda_0123456789876543210 x y = y - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 x y t where - Case_0123456789876543210 arg_0123456789876543210 x y _ = x - type family Lambda_0123456789876543210 x y arg_0123456789876543210 where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 t where - Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 _ = x - type family Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 where - Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y where - Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 y0123456789876543210 - type Foo8Sym0 :: (~>) (Foo a b) a - data Foo8Sym0 :: (~>) (Foo a b) a - where - Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => - Foo8Sym0 a0123456789876543210 - type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 - instance SuppressUnusedWarnings Foo8Sym0 where - suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ()) - type Foo8Sym1 :: Foo a b -> a - type family Foo8Sym1 (a0123456789876543210 :: Foo a b) :: a where - Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210 - type Foo7Sym0 :: (~>) a ((~>) b b) - data Foo7Sym0 :: (~>) a ((~>) b b) - where - Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0 a0123456789876543210 - type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ()) - type Foo7Sym1 :: a -> (~>) b b - data Foo7Sym1 (a0123456789876543210 :: a) :: (~>) b b - where - Foo7Sym1KindInference :: SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => - Foo7Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo7Sym1KindInference ()) - type Foo7Sym2 :: a -> b -> b - type family Foo7Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - Foo7Sym2 a0123456789876543210 a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 - type Foo6Sym0 :: (~>) a ((~>) b a) - data Foo6Sym0 :: (~>) a ((~>) b a) - where - Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => - Foo6Sym0 a0123456789876543210 - type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo6Sym0 where - suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ()) - type Foo6Sym1 :: a -> (~>) b a - data Foo6Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo6Sym1KindInference :: SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => - Foo6Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo6Sym1KindInference ()) - type Foo6Sym2 :: a -> b -> a - type family Foo6Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo6Sym2 a0123456789876543210 a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210 - type Foo5Sym0 :: (~>) a ((~>) b b) - data Foo5Sym0 :: (~>) a ((~>) b b) - where - Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0 a0123456789876543210 - type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ()) - type Foo5Sym1 :: a -> (~>) b b - data Foo5Sym1 (a0123456789876543210 :: a) :: (~>) b b - where - Foo5Sym1KindInference :: SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => - Foo5Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo5Sym1KindInference ()) - type Foo5Sym2 :: a -> b -> b - type family Foo5Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - Foo5Sym2 a0123456789876543210 a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210 - type Foo4Sym0 :: (~>) a ((~>) b ((~>) c a)) - data Foo4Sym0 :: (~>) a ((~>) b ((~>) c a)) - where - Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0 a0123456789876543210 - type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ()) - type Foo4Sym1 :: a -> (~>) b ((~>) c a) - data Foo4Sym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c a) - where - Foo4Sym1KindInference :: SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) => - Foo4Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo4Sym1KindInference ()) - type Foo4Sym2 :: a -> b -> (~>) c a - data Foo4Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c a - where - Foo4Sym2KindInference :: 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 (Foo4Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo4Sym2KindInference ()) - type Foo4Sym3 :: a -> b -> c -> a - type family Foo4Sym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: a where - Foo4Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type Foo3Sym0 :: (~>) a a - data Foo3Sym0 :: (~>) a a - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: a -> a - type family Foo3Sym1 (a0123456789876543210 :: a) :: a where - Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210 - type Foo2Sym0 :: (~>) a ((~>) b a) - data Foo2Sym0 :: (~>) a ((~>) b a) - where - Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0 a0123456789876543210 - type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ()) - type Foo2Sym1 :: a -> (~>) b a - data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => - Foo2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ()) - type Foo2Sym2 :: a -> b -> a - type family Foo2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 - type Foo1Sym0 :: (~>) a ((~>) b a) - data Foo1Sym0 :: (~>) a ((~>) b a) - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: a -> (~>) b a - data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => - Foo1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ()) - type Foo1Sym2 :: a -> b -> a - type family Foo1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 - type Foo0Sym0 :: (~>) a ((~>) b a) - data Foo0Sym0 :: (~>) a ((~>) b a) - where - Foo0Sym0KindInference :: SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => - Foo0Sym0 a0123456789876543210 - type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo0Sym0 where - suppressUnusedWarnings = snd ((,) Foo0Sym0KindInference ()) - type Foo0Sym1 :: a -> (~>) b a - data Foo0Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo0Sym1KindInference :: SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) => - Foo0Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo0Sym1KindInference ()) - type Foo0Sym2 :: a -> b -> a - type family Foo0Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo0Sym2 a0123456789876543210 a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210 - type Foo8 :: Foo a b -> a - type family Foo8 (a :: Foo a b) :: a where - Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x - type Foo7 :: a -> b -> b - 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 Foo6 :: a -> b -> a - type family Foo6 (a :: a) (a :: b) :: a where - Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b - type Foo5 :: a -> b -> b - type family Foo5 (a :: a) (a :: b) :: b where - Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type Foo4 :: a -> b -> c -> a - 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 Foo3 :: a -> a - type family Foo3 (a :: a) :: a where - Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x - type Foo2 :: a -> b -> a - type family Foo2 (a :: a) (a :: b) :: a where - Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type Foo1 :: a -> b -> a - type family Foo1 (a :: a) (a :: b) :: a where - Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 - type Foo0 :: a -> b -> a - type family Foo0 (a :: a) (a :: b) :: a where - Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 - sFoo8 :: - (forall (t :: Foo a b). - Sing t -> Sing (Apply Foo8Sym0 t :: a) :: Type) - sFoo7 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) :: Type) - sFoo6 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) :: Type) - sFoo5 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) :: Type) - sFoo4 :: - (forall (t :: a) (t :: b) (t :: c). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) :: Type) - sFoo3 :: - (forall (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) :: Type) - sFoo2 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) :: Type) - sFoo1 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) :: Type) - sFoo0 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) :: Type) - sFoo8 (sX :: Sing x) - = applySing - (singFun1 - @(Apply Lambda_0123456789876543210Sym0 x) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of - (_ :: Sing arg_0123456789876543210) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210)) - (case sArg_0123456789876543210 of SFoo (sA :: Sing a) _ -> sA))) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210)) - (case sArg_0123456789876543210 of STuple2 _ (sB :: Sing b) -> sB))) - (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 x) a) b) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of - (_ :: Sing arg_0123456789876543210) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x a b arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sX)))) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210))) - (case - applySing - (applySing - (singFun2 @Tuple2Sym0 STuple2) sArg_0123456789876543210) - sArg_0123456789876543210 - of - STuple2 _ _ -> sX))) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sX))) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sX))) - 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 SingI1 (Foo7Sym1 :: a -> (~>) b b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo7Sym1 (d :: a)) (sFoo7 s) - 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 SingI1 (Foo6Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo6Sym1 (d :: a)) (sFoo6 s) - 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 SingI1 (Foo5Sym1 :: a -> (~>) b b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo5Sym1 (d :: a)) (sFoo5 s) - 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 SingI1 (Foo4Sym1 :: a -> (~>) b ((~>) c a)) where - liftSing (s :: Sing (d :: a)) - = singFun2 @(Foo4Sym1 (d :: a)) (sFoo4 s) - 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 d => - SingI1 (Foo4Sym2 (d :: a) :: b -> (~>) c a) where - liftSing (s :: Sing (d :: b)) - = singFun1 @(Foo4Sym2 (d :: a) (d :: b)) (sFoo4 (sing @d) s) - instance SingI2 (Foo4Sym2 :: a -> b -> (~>) c a) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun1 @(Foo4Sym2 (d :: a) (d :: b)) (sFoo4 s s) - 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 SingI1 (Foo2Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s) - 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 SingI1 (Foo1Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s) - 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)) - instance SingI1 (Foo0Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo0Sym1 (d :: a)) (sFoo0 s) - data SFoo :: forall a b. Foo a b -> Type - where - SFoo :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> SFoo (Foo n n :: Foo a b) - type instance Sing @(Foo a b) = SFoo - 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 n => SingI1 (Foo (n :: a)) where - liftSing = SFoo sing - instance SingI2 Foo where - liftSing2 = SFoo - instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where - sing = singFun2 @FooSym0 SFoo - instance SingI d => - SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where - sing = singFun1 @(FooSym1 (d :: a)) (SFoo (sing @d)) - instance SingI1 (FooSym1 :: a -> (~>) b (Foo a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(FooSym1 (d :: a)) (SFoo s) +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 FooSym0 :: forall a b. (~>) a ((~>) b (Foo a b))+ data FooSym0 :: (~>) a ((~>) b (Foo a b))+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @a @((~>) b (Foo a b)) FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: forall a b. a -> (~>) b (Foo a b)+ data FooSym1 (a0123456789876543210 :: a) :: (~>) b (Foo a b)+ where+ FooSym1KindInference :: SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) =>+ FooSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(Foo a b) (FooSym1 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooSym1KindInference ())+ type FooSym2 :: forall a b. a -> b -> Foo a b+ type family FooSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Foo a b where+ FooSym2 a0123456789876543210 a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x (Foo a _) = a+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x y '(_, b) = b+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x a b _ = x+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 a0123456789876543210 b0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a b x = LamCases_0123456789876543210Sym0 x a b+ data LamCases_0123456789876543210Sym0 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) (b0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x y x = x+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) (z0123456789876543210 :: c0123456789876543210) a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x y z _ _ = x+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) (z0123456789876543210 :: c0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 z0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 z0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) (z0123456789876543210 :: c0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) (z0123456789876543210 :: c0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x y = y+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x y _ = x+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x a_0123456789876543210 _ = x+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ data LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym1KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym1KindInference ())+ type family LamCases_0123456789876543210Sym2 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type Foo8Sym0 :: (~>) (Foo a b) a+ data Foo8Sym0 :: (~>) (Foo a b) a+ where+ Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>+ Foo8Sym0 a0123456789876543210+ type instance Apply @(Foo a b) @a Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210+ instance SuppressUnusedWarnings Foo8Sym0 where+ suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ())+ type Foo8Sym1 :: Foo a b -> a+ type family Foo8Sym1 @a @b (a0123456789876543210 :: Foo a b) :: a where+ Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210+ type Foo7Sym0 :: (~>) a ((~>) b b)+ data Foo7Sym0 :: (~>) a ((~>) b b)+ where+ Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>+ Foo7Sym0 a0123456789876543210+ type instance Apply @a @((~>) b b) Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo7Sym0 where+ suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ())+ type Foo7Sym1 :: a -> (~>) b b+ data Foo7Sym1 (a0123456789876543210 :: a) :: (~>) b b+ where+ Foo7Sym1KindInference :: SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) =>+ Foo7Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @b (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo7Sym1KindInference ())+ type Foo7Sym2 :: a -> b -> b+ type family Foo7Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where+ Foo7Sym2 a0123456789876543210 a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210+ type Foo6Sym0 :: (~>) a ((~>) b a)+ data Foo6Sym0 :: (~>) a ((~>) b a)+ where+ Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>+ Foo6Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo6Sym0 where+ suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ())+ type Foo6Sym1 :: a -> (~>) b a+ data Foo6Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo6Sym1KindInference :: SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) =>+ Foo6Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo6Sym1KindInference ())+ type Foo6Sym2 :: a -> b -> a+ type family Foo6Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo6Sym2 a0123456789876543210 a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210+ type Foo5Sym0 :: (~>) a ((~>) b b)+ data Foo5Sym0 :: (~>) a ((~>) b b)+ where+ Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>+ Foo5Sym0 a0123456789876543210+ type instance Apply @a @((~>) b b) Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo5Sym0 where+ suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ())+ type Foo5Sym1 :: a -> (~>) b b+ data Foo5Sym1 (a0123456789876543210 :: a) :: (~>) b b+ where+ Foo5Sym1KindInference :: SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) =>+ Foo5Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @b (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo5Sym1KindInference ())+ type Foo5Sym2 :: a -> b -> b+ type family Foo5Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where+ Foo5Sym2 a0123456789876543210 a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210+ type Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))+ data Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))+ where+ Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>+ Foo4Sym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c a)) Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo4Sym0 where+ suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ())+ type Foo4Sym1 :: a -> (~>) b ((~>) c a)+ data Foo4Sym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c a)+ where+ Foo4Sym1KindInference :: SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) =>+ Foo4Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c a) (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo4Sym1KindInference ())+ type Foo4Sym2 :: a -> b -> (~>) c a+ data Foo4Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c a+ where+ Foo4Sym2KindInference :: SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) =>+ Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @a (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo4Sym2KindInference ())+ type Foo4Sym3 :: a -> b -> c -> a+ type family Foo4Sym3 @a @b @c (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: a where+ Foo4Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type Foo3Sym0 :: (~>) a a+ data Foo3Sym0 :: (~>) a a+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @a @a Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: a -> a+ type family Foo3Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210+ type Foo2Sym0 :: (~>) a ((~>) b a)+ data Foo2Sym0 :: (~>) a ((~>) b a)+ where+ Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>+ Foo2Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo2Sym0 where+ suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ())+ type Foo2Sym1 :: a -> (~>) b a+ data Foo2Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo2Sym1KindInference :: SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) =>+ Foo2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo2Sym1KindInference ())+ type Foo2Sym2 :: a -> b -> a+ type family Foo2Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo2Sym2 a0123456789876543210 a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210+ type Foo1Sym0 :: (~>) a ((~>) b a)+ data Foo1Sym0 :: (~>) a ((~>) b a)+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: a -> (~>) b a+ data Foo1Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo1Sym1KindInference :: SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) =>+ Foo1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo1Sym1KindInference ())+ type Foo1Sym2 :: a -> b -> a+ type family Foo1Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo1Sym2 a0123456789876543210 a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210+ type Foo0Sym0 :: (~>) a ((~>) b a)+ data Foo0Sym0 :: (~>) a ((~>) b a)+ where+ Foo0Sym0KindInference :: SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) =>+ Foo0Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo0Sym0 where+ suppressUnusedWarnings = snd ((,) Foo0Sym0KindInference ())+ type Foo0Sym1 :: a -> (~>) b a+ data Foo0Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo0Sym1KindInference :: SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) =>+ Foo0Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo0Sym1KindInference ())+ type Foo0Sym2 :: a -> b -> a+ type family Foo0Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo0Sym2 a0123456789876543210 a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210+ type Foo8 :: Foo a b -> a+ type family Foo8 @a @b (a :: Foo a b) :: a where+ Foo8 x = Apply (LamCases_0123456789876543210Sym0 x) x+ type Foo7 :: a -> b -> b+ type family Foo7 @a @b (a :: a) (a :: b) :: b where+ Foo7 x y = Apply (LamCases_0123456789876543210Sym0 x y) (Apply (Apply Tuple2Sym0 x) y)+ type Foo6 :: a -> b -> a+ type family Foo6 @a @b (a :: a) (a :: b) :: a where+ Foo6 a b = Apply (Apply (LamCases_0123456789876543210Sym0 a b) a) b+ type Foo5 :: a -> b -> b+ type family Foo5 @a @b (a :: a) (a :: b) :: b where+ Foo5 x y = Apply (LamCases_0123456789876543210Sym0 x y) y+ type Foo4 :: a -> b -> c -> a+ type family Foo4 @a @b @c (a :: a) (a :: b) (a :: c) :: a where+ Foo4 x y z = Apply (Apply (LamCases_0123456789876543210Sym0 x y z) y) z+ type Foo3 :: a -> a+ type family Foo3 @a (a :: a) :: a where+ Foo3 x = Apply (LamCases_0123456789876543210Sym0 x) x+ type Foo2 :: a -> b -> a+ type family Foo2 @a @b (a :: a) (a :: b) :: a where+ Foo2 x y = Apply (LamCases_0123456789876543210Sym0 x y) y+ type Foo1 :: a -> b -> a+ type family Foo1 @a @b (a :: a) (a :: b) :: a where+ Foo1 x a_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 x a_0123456789876543210) a_0123456789876543210+ type Foo0 :: a -> b -> a+ type family Foo0 @a @b (a :: a) (a :: b) :: a where+ Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210+ sFoo8 ::+ (forall (t :: Foo a b). Sing t -> Sing (Foo8 t :: a) :: Type)+ sFoo7 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo7 t t :: b) :: Type)+ sFoo6 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo6 t t :: a) :: Type)+ sFoo5 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo5 t t :: b) :: Type)+ sFoo4 ::+ (forall (t :: a) (t :: b) (t :: c).+ Sing t -> Sing t -> Sing t -> Sing (Foo4 t t t :: a) :: Type)+ sFoo3 :: (forall (t :: a). Sing t -> Sing (Foo3 t :: a) :: Type)+ sFoo2 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo2 t t :: a) :: Type)+ sFoo1 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo1 t t :: a) :: Type)+ sFoo0 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo0 t t :: a) :: Type)+ sFoo8 (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases (SFoo (sA :: Sing a) _) -> sA))+ sX+ sFoo7 (sX :: Sing x) (sY :: Sing y)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x y)+ (\cases (STuple2 _ (sB :: Sing b)) -> sB))+ (applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY)+ sFoo6 (sA :: Sing a) (sB :: Sing b)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a b)+ (\cases+ (sX :: Sing x)+ -> singFun1+ @(LamCases_0123456789876543210Sym0 x a b) (\cases _ -> sX)))+ sA)+ sB+ sFoo5 (sX :: Sing x) (sY :: Sing y)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x y)+ (\cases (sX :: Sing x) -> sX))+ sY+ sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z)+ = applySing+ (applySing+ (singFun2+ @(LamCases_0123456789876543210Sym0 x y z) (\cases _ _ -> sX))+ sY)+ sZ+ sFoo3 (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases (sY :: Sing y) -> sY))+ sX+ sFoo2 (sX :: Sing x) (sY :: Sing y)+ = applySing+ (singFun1 @(LamCases_0123456789876543210Sym0 x y) (\cases _ -> sX))+ sY+ sFoo1+ (sX :: Sing x)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x a_0123456789876543210)+ (\cases _ -> sX))+ sA_0123456789876543210+ sFoo0+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210 a_0123456789876543210)+ (\cases (sX :: Sing x) (sY :: 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 SingI1 (Foo7Sym1 :: a -> (~>) b b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo7Sym1 (d :: a)) (sFoo7 s)+ 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 SingI1 (Foo6Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo6Sym1 (d :: a)) (sFoo6 s)+ 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 SingI1 (Foo5Sym1 :: a -> (~>) b b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo5Sym1 (d :: a)) (sFoo5 s)+ 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 SingI1 (Foo4Sym1 :: a -> (~>) b ((~>) c a)) where+ liftSing (s :: Sing (d :: a))+ = singFun2 @(Foo4Sym1 (d :: a)) (sFoo4 s)+ 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 d =>+ SingI1 (Foo4Sym2 (d :: a) :: b -> (~>) c a) where+ liftSing (s :: Sing (d :: b))+ = singFun1 @(Foo4Sym2 (d :: a) (d :: b)) (sFoo4 (sing @d) s)+ instance SingI2 (Foo4Sym2 :: a -> b -> (~>) c a) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun1 @(Foo4Sym2 (d :: a) (d :: b)) (sFoo4 s s)+ 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 SingI1 (Foo2Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo2Sym1 (d :: a)) (sFoo2 s)+ 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 SingI1 (Foo1Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo1Sym1 (d :: a)) (sFoo1 s)+ 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))+ instance SingI1 (Foo0Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo0Sym1 (d :: a)) (sFoo0 s)+ data SFoo :: forall a b. Foo a b -> Type+ where+ SFoo :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SFoo (Foo n n :: Foo a b)+ type instance Sing @(Foo a b) = SFoo+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SFoo c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where+ sing = SFoo sing sing+ instance SingI n => SingI1 (Foo (n :: a)) where+ liftSing = SFoo sing+ instance SingI2 Foo where+ liftSing2 = SFoo+ instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where+ sing = singFun2 @FooSym0 SFoo+ instance SingI d =>+ SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where+ sing = singFun1 @(FooSym1 (d :: a)) (SFoo (sing @d))+ instance SingI1 (FooSym1 :: a -> (~>) b (Foo a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(FooSym1 (d :: a)) (SFoo s)
tests/compile-and-dump/Singletons/Lambdas.hs view
@@ -1,92 +1,92 @@-{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing #-} - --- We expect unused binds and name shadowing in foo5 test. -module Singletons.Lambdas where - -import Data.Proxy -import Data.Singletons.Base.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 +{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing #-}++-- We expect unused binds and name shadowing in foo5 test.+module Singletons.Lambdas where++import Data.Proxy+import Data.Singletons.Base.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.golden view
@@ -1,84 +1,83 @@-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 x where - Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - type family Lambda_0123456789876543210Sym1 x0123456789876543210 where - Lambda_0123456789876543210Sym1 x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 - type BarSym0 :: [Nat] - type family BarSym0 :: [Nat] where - BarSym0 = Bar - type FooSym0 :: [Nat] - type family FooSym0 :: [Nat] where - FooSym0 = Foo - type Bar :: [Nat] - 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))) NilSym0)) - type Foo :: [Nat] - type family Foo :: [Nat] where - Foo = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) NilSym0)) - sBar :: (Sing (BarSym0 :: [Nat]) :: Type) - sFoo :: (Sing (FooSym0 :: [Nat]) :: Type) - 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)) +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 LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type BarSym0 :: [Nat]+ type family BarSym0 :: [Nat] where+ BarSym0 = Bar+ type FooSym0 :: [Nat]+ type family FooSym0 :: [Nat] where+ FooSym0 = Foo+ type Bar :: [Nat]+ 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))) NilSym0))+ type Foo :: [Nat]+ type family Foo :: [Nat] where+ Foo = Apply (Apply MapSym0 LamCases_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) NilSym0))+ sBar :: (Sing (Bar :: [Nat]) :: Type)+ sFoo :: (Sing (Foo :: [Nat]) :: Type)+ 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+ @LamCases_0123456789876543210Sym0+ (\cases+ (sX :: 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 view
@@ -1,27 +1,27 @@-module Singletons.LambdasComprehensive where - -import Data.Singletons.TH -import Prelude hiding (pred) -import Prelude.Singletons -import Singletons.Nat - -$(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 +module Singletons.LambdasComprehensive where++import Data.Singletons.TH+import Prelude hiding (pred)+import Prelude.Singletons+import Singletons.Nat++$(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.golden view
@@ -1,1003 +1,830 @@-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 - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - type family Let0123456789876543210ZSym1 x0123456789876543210 where - Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - data Let0123456789876543210YSym0 x0123456789876543210 - where - Let0123456789876543210YSym0KindInference :: SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0 x0123456789876543210 - type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210YSym0KindInference ()) - type family Let0123456789876543210YSym1 x0123456789876543210 where - Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - data Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 - where - Let0123456789876543210X_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => - Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210X_0123456789876543210Sym0KindInference ()) - type family Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 where - Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 - type family Let0123456789876543210Z x where - Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) - type family Let0123456789876543210Y x where - Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) - type family Let0123456789876543210X_0123456789876543210 x where - Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x - data Let0123456789876543210BarSym0 x0123456789876543210 - where - Let0123456789876543210BarSym0KindInference :: SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => - Let0123456789876543210BarSym0 x0123456789876543210 - type instance Apply Let0123456789876543210BarSym0 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210BarSym0KindInference ()) - type family Let0123456789876543210BarSym1 x0123456789876543210 :: a0123456789876543210 where - Let0123456789876543210BarSym1 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210 - type family Let0123456789876543210Bar x :: a where - Let0123456789876543210Bar x = x - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) ()) - type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where - (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m - (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x) - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - type family Let0123456789876543210ZSym1 x0123456789876543210 :: Nat where - Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) ()) - type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - 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) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) ()) - type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - 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 a_0123456789876543210 x x where - Lambda_0123456789876543210 a_0123456789876543210 x x = x - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 x0123456789876543210 - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - data Let0123456789876543210ZSym1 x0123456789876543210 :: (~>) Nat Nat - where - Let0123456789876543210ZSym1KindInference :: SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => - Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym1KindInference ()) - type family Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) :: Nat where - Let0123456789876543210ZSym2 x0123456789876543210 a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 - type family Let0123456789876543210Z x (a :: Nat) :: Nat where - Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) x) a_0123456789876543210 - type family Lambda_0123456789876543210 x x where - Lambda_0123456789876543210 x x = x - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 x0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym2 x0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 x0123456789876543210 - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - type family Let0123456789876543210ZSym1 x0123456789876543210 :: Nat where - Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 - data Let0123456789876543210XSym0 x0123456789876543210 - where - Let0123456789876543210XSym0KindInference :: SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0 x0123456789876543210 - type instance Apply Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210X x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210XSym0KindInference ()) - type family Let0123456789876543210XSym1 x0123456789876543210 :: Nat where - Let0123456789876543210XSym1 x0123456789876543210 = Let0123456789876543210X x0123456789876543210 - type family Let0123456789876543210X x :: Nat where - Let0123456789876543210X x = ZeroSym0 - data Let0123456789876543210FSym0 x0123456789876543210 - where - Let0123456789876543210FSym0KindInference :: SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0 x0123456789876543210 - type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym0KindInference ()) - data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat - where - Let0123456789876543210FSym1KindInference :: SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => - Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym1KindInference ()) - type family Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) :: Nat where - Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 y - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - type family Let0123456789876543210ZSym1 x0123456789876543210 :: Nat where - Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x - data Let0123456789876543210ZSym0 y0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 y0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym0KindInference ()) - data Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 - where - Let0123456789876543210ZSym1KindInference :: SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => - Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 - type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ZSym1KindInference ()) - type family Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 :: Nat where - Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 - type family Let0123456789876543210Z y x :: Nat where - Let0123456789876543210Z y x = Apply SuccSym0 y - data Let0123456789876543210FSym0 x0123456789876543210 - where - Let0123456789876543210FSym0KindInference :: SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0 x0123456789876543210 - type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym0KindInference ()) - data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat - where - Let0123456789876543210FSym1KindInference :: SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => - Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym1KindInference ()) - type family Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) :: Nat where - Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 y x) - data Let0123456789876543210FSym0 x0123456789876543210 - where - Let0123456789876543210FSym0KindInference :: SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0 x0123456789876543210 - type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym0KindInference ()) - data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat - where - Let0123456789876543210FSym1KindInference :: SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => - Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210FSym1KindInference ()) - type family Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) :: Nat where - Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 y - data Let0123456789876543210YSym0 x0123456789876543210 - where - Let0123456789876543210YSym0KindInference :: SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0 x0123456789876543210 - type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210YSym0KindInference ()) - type family Let0123456789876543210YSym1 x0123456789876543210 :: Nat where - Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - type family Let0123456789876543210Y x :: Nat where - Let0123456789876543210Y x = Apply SuccSym0 x - type family Let0123456789876543210ZSym0 where - Let0123456789876543210ZSym0 = Let0123456789876543210Z - type family Let0123456789876543210YSym0 where - Let0123456789876543210YSym0 = Let0123456789876543210Y - type family Let0123456789876543210Z where - Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 - type family Let0123456789876543210Y where - Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 - data Let0123456789876543210YSym0 x0123456789876543210 - where - Let0123456789876543210YSym0KindInference :: SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0 x0123456789876543210 - type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210YSym0KindInference ()) - type family Let0123456789876543210YSym1 x0123456789876543210 :: Nat where - Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 - type family Let0123456789876543210Y x :: Nat where - Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 - type Foo14Sym0 :: (~>) Nat (Nat, Nat) - data Foo14Sym0 :: (~>) Nat (Nat, Nat) - where - Foo14Sym0KindInference :: SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => - Foo14Sym0 a0123456789876543210 - type instance Apply Foo14Sym0 a0123456789876543210 = Foo14 a0123456789876543210 - instance SuppressUnusedWarnings Foo14Sym0 where - suppressUnusedWarnings = snd ((,) Foo14Sym0KindInference ()) - type Foo14Sym1 :: Nat -> (Nat, Nat) - type family Foo14Sym1 (a0123456789876543210 :: Nat) :: (Nat, - Nat) where - Foo14Sym1 a0123456789876543210 = Foo14 a0123456789876543210 - type Foo13_Sym0 :: (~>) a a - data Foo13_Sym0 :: (~>) a a - where - Foo13_Sym0KindInference :: SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => - Foo13_Sym0 a0123456789876543210 - type instance Apply Foo13_Sym0 a0123456789876543210 = Foo13_ a0123456789876543210 - instance SuppressUnusedWarnings Foo13_Sym0 where - suppressUnusedWarnings = snd ((,) Foo13_Sym0KindInference ()) - type Foo13_Sym1 :: a -> a - type family Foo13_Sym1 (a0123456789876543210 :: a) :: a where - Foo13_Sym1 a0123456789876543210 = Foo13_ a0123456789876543210 - type Foo13Sym0 :: forall a. (~>) a a - data Foo13Sym0 :: (~>) a a - where - Foo13Sym0KindInference :: SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => - Foo13Sym0 a0123456789876543210 - type instance Apply Foo13Sym0 a0123456789876543210 = Foo13 a0123456789876543210 - instance SuppressUnusedWarnings Foo13Sym0 where - suppressUnusedWarnings = snd ((,) Foo13Sym0KindInference ()) - type Foo13Sym1 :: forall a. a -> a - type family Foo13Sym1 (a0123456789876543210 :: a) :: a where - Foo13Sym1 a0123456789876543210 = Foo13 a0123456789876543210 - type Foo12Sym0 :: (~>) Nat Nat - data Foo12Sym0 :: (~>) Nat Nat - where - Foo12Sym0KindInference :: SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => - Foo12Sym0 a0123456789876543210 - type instance Apply Foo12Sym0 a0123456789876543210 = Foo12 a0123456789876543210 - instance SuppressUnusedWarnings Foo12Sym0 where - suppressUnusedWarnings = snd ((,) Foo12Sym0KindInference ()) - type Foo12Sym1 :: Nat -> Nat - type family Foo12Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo12Sym1 a0123456789876543210 = Foo12 a0123456789876543210 - type Foo11Sym0 :: (~>) Nat Nat - data Foo11Sym0 :: (~>) Nat Nat - where - Foo11Sym0KindInference :: SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => - Foo11Sym0 a0123456789876543210 - type instance Apply Foo11Sym0 a0123456789876543210 = Foo11 a0123456789876543210 - instance SuppressUnusedWarnings Foo11Sym0 where - suppressUnusedWarnings = snd ((,) Foo11Sym0KindInference ()) - type Foo11Sym1 :: Nat -> Nat - type family Foo11Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo11Sym1 a0123456789876543210 = Foo11 a0123456789876543210 - type Foo10Sym0 :: (~>) Nat Nat - data Foo10Sym0 :: (~>) Nat Nat - where - Foo10Sym0KindInference :: SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => - Foo10Sym0 a0123456789876543210 - type instance Apply Foo10Sym0 a0123456789876543210 = Foo10 a0123456789876543210 - instance SuppressUnusedWarnings Foo10Sym0 where - suppressUnusedWarnings = snd ((,) Foo10Sym0KindInference ()) - type Foo10Sym1 :: Nat -> Nat - type family Foo10Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo10Sym1 a0123456789876543210 = Foo10 a0123456789876543210 - type Foo9Sym0 :: (~>) Nat Nat - data Foo9Sym0 :: (~>) Nat Nat - where - Foo9Sym0KindInference :: SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => - Foo9Sym0 a0123456789876543210 - type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 - instance SuppressUnusedWarnings Foo9Sym0 where - suppressUnusedWarnings = snd ((,) Foo9Sym0KindInference ()) - type Foo9Sym1 :: Nat -> Nat - type family Foo9Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo9Sym1 a0123456789876543210 = Foo9 a0123456789876543210 - type Foo8Sym0 :: (~>) Nat Nat - data Foo8Sym0 :: (~>) Nat Nat - where - Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => - Foo8Sym0 a0123456789876543210 - type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 - instance SuppressUnusedWarnings Foo8Sym0 where - suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ()) - type Foo8Sym1 :: Nat -> Nat - type family Foo8Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210 - type Foo7Sym0 :: (~>) Nat Nat - data Foo7Sym0 :: (~>) Nat Nat - where - Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0 a0123456789876543210 - type instance Apply Foo7Sym0 a0123456789876543210 = Foo7 a0123456789876543210 - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ()) - type Foo7Sym1 :: Nat -> Nat - type family Foo7Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo7Sym1 a0123456789876543210 = Foo7 a0123456789876543210 - type Foo6Sym0 :: (~>) Nat Nat - data Foo6Sym0 :: (~>) Nat Nat - where - Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => - Foo6Sym0 a0123456789876543210 - type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 - instance SuppressUnusedWarnings Foo6Sym0 where - suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ()) - type Foo6Sym1 :: Nat -> Nat - type family Foo6Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo6Sym1 a0123456789876543210 = Foo6 a0123456789876543210 - type Foo5Sym0 :: (~>) Nat Nat - data Foo5Sym0 :: (~>) Nat Nat - where - Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0 a0123456789876543210 - type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ()) - type Foo5Sym1 :: Nat -> Nat - type family Foo5Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210 - type Foo4Sym0 :: (~>) Nat Nat - data Foo4Sym0 :: (~>) Nat Nat - where - Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0 a0123456789876543210 - type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ()) - type Foo4Sym1 :: Nat -> Nat - type family Foo4Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210 - type Foo3Sym0 :: (~>) Nat Nat - data Foo3Sym0 :: (~>) Nat Nat - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: Nat -> Nat - type family Foo3Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210 - type Foo2Sym0 :: Nat - type family Foo2Sym0 :: Nat where - Foo2Sym0 = Foo2 - type Foo1Sym0 :: (~>) Nat Nat - data Foo1Sym0 :: (~>) Nat Nat - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: Nat -> Nat - type family Foo1Sym1 (a0123456789876543210 :: Nat) :: Nat where - Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210 - type Foo14 :: Nat -> (Nat, Nat) - type family Foo14 (a :: Nat) :: (Nat, Nat) where - Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) - type Foo13_ :: a -> a - type family Foo13_ (a :: a) :: a where - Foo13_ y = y - type Foo13 :: forall a. a -> a - type family Foo13 (a :: a) :: a where - Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x) - type Foo12 :: Nat -> Nat - type family Foo12 (a :: Nat) :: Nat where - Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) - type Foo11 :: Nat -> Nat - type family Foo11 (a :: Nat) :: Nat where - Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x) - type Foo10 :: Nat -> Nat - type family Foo10 (a :: Nat) :: Nat where - Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) x - type Foo9 :: Nat -> Nat - type family Foo9 (a :: Nat) :: Nat where - Foo9 x = Apply (Let0123456789876543210ZSym1 x) x - type Foo8 :: Nat -> Nat - type family Foo8 (a :: Nat) :: Nat where - Foo8 x = Let0123456789876543210ZSym1 x - type Foo7 :: Nat -> Nat - type family Foo7 (a :: Nat) :: Nat where - Foo7 x = Let0123456789876543210XSym1 x - type Foo6 :: Nat -> Nat - type family Foo6 (a :: Nat) :: Nat where - Foo6 x = Let0123456789876543210ZSym1 x - type Foo5 :: Nat -> Nat - type family Foo5 (a :: Nat) :: Nat where - Foo5 x = Apply (Let0123456789876543210FSym1 x) x - type Foo4 :: Nat -> Nat - type family Foo4 (a :: Nat) :: Nat where - Foo4 x = Apply (Let0123456789876543210FSym1 x) x - type Foo3 :: Nat -> Nat - type family Foo3 (a :: Nat) :: Nat where - Foo3 x = Let0123456789876543210YSym1 x - type Foo2 :: Nat - type family Foo2 :: Nat where - Foo2 = Let0123456789876543210ZSym0 - type Foo1 :: Nat -> Nat - type family Foo1 (a :: Nat) :: Nat where - Foo1 x = Let0123456789876543210YSym1 x - sFoo14 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) :: Type) - sFoo13_ :: - (forall (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) :: Type) - sFoo13 :: - forall a (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) - sFoo12 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo12Sym0 t :: Nat) :: Type) - sFoo11 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo11Sym0 t :: Nat) :: Type) - sFoo10 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo10Sym0 t :: Nat) :: Type) - sFoo9 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo9Sym0 t :: Nat) :: Type) - sFoo8 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo8Sym0 t :: Nat) :: Type) - sFoo7 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo7Sym0 t :: Nat) :: Type) - sFoo6 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo6Sym0 t :: Nat) :: Type) - sFoo5 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo5Sym0 t :: Nat) :: Type) - sFoo4 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo4Sym0 t :: Nat) :: Type) - sFoo3 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo3Sym0 t :: Nat) :: Type) - sFoo2 :: (Sing (Foo2Sym0 :: Nat) :: Type) - sFoo1 :: - (forall (t :: Nat). - Sing t -> Sing (Apply Foo1Sym0 t :: Nat) :: Type) - sFoo14 (sX :: Sing x) - = let - sZ :: Sing @_ (Let0123456789876543210ZSym1 x) - sY :: Sing @_ (Let0123456789876543210YSym1 x) - sX_0123456789876543210 :: - Sing @_ (Let0123456789876543210X_0123456789876543210Sym1 x) - sZ - = id - @(Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x))) - (case sX_0123456789876543210 of - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210) - sY - = id - @(Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x))) - (case sX_0123456789876543210 of - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210) - 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) :: Type) - 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) :: Type) - (%+) 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) :: Type) - (%+) :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t - -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) :: Type) - 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) :: Type) - (%+) 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) :: Type) - sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) x) - (\ 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) :: Type) - 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) :: Type) - sX = SZero - in sX - sFoo6 (sX :: Sing x) - = let - sF :: - (forall (t :: Nat). - Sing t - -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) :: Type) - sF (sY :: Sing y) = applySing (singFun1 @SuccSym0 SSucc) sY in - let - sZ :: (Sing (Let0123456789876543210ZSym1 x :: Nat) :: Type) - 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) :: Type) - sF (sY :: Sing y) - = let - sZ :: (Sing (Let0123456789876543210ZSym2 y x :: Nat) :: Type) - 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) :: Type) - 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) :: Type) - sY = applySing (singFun1 @SuccSym0 SSucc) sX - in sY - sFoo2 - = let - sZ :: Sing @_ Let0123456789876543210ZSym0 - sY :: Sing @_ Let0123456789876543210YSym0 - sZ = applySing (singFun1 @SuccSym0 SSucc) sY - sY = applySing (singFun1 @SuccSym0 SSucc) SZero - in sZ - sFoo1 (sX :: Sing x) - = let - sY :: (Sing (Let0123456789876543210YSym1 x :: Nat) :: Type) - 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 +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 LamCases_0123456789876543210 (x0123456789876543210 :: Nat) a_0123456789876543210 where+ LamCases_0123456789876543210 x '(_,+ y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: Nat) a_0123456789876543210 where+ LamCases_0123456789876543210 x '(y_0123456789876543210,+ _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family Let0123456789876543210ZSym0 (x0123456789876543210 :: Nat) where+ Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210+ type family Let0123456789876543210YSym0 (x0123456789876543210 :: Nat) where+ Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210+ type family Let0123456789876543210X_0123456789876543210Sym0 (x0123456789876543210 :: Nat) where+ Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210+ type family Let0123456789876543210Z (x0123456789876543210 :: Nat) where+ Let0123456789876543210Z x = Apply (LamCases_0123456789876543210Sym0 x) (Let0123456789876543210X_0123456789876543210Sym0 x)+ type family Let0123456789876543210Y (x0123456789876543210 :: Nat) where+ Let0123456789876543210Y x = Apply (LamCases_0123456789876543210Sym0 x) (Let0123456789876543210X_0123456789876543210Sym0 x)+ type family Let0123456789876543210X_0123456789876543210 (x0123456789876543210 :: Nat) where+ Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x+ type family Let0123456789876543210BarSym0 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210BarSym0 a0123456789876543210 x0123456789876543210 = Let0123456789876543210Bar a0123456789876543210 x0123456789876543210+ type family Let0123456789876543210Bar a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210Bar a x = x+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) (x0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Nat)+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ())+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ())+ type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type family (<<<%%%%%%%%%%%%%%%%%%%%) (x0123456789876543210 :: Nat) (a :: Nat) (a :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m+ (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) n) x)+ type family Let0123456789876543210ZSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) (x0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Nat)+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ())+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ())+ type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type family Let0123456789876543210Z (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Z x = x+ type family (<<<%%%%%%%%%%%%%%%%%%%%) (x0123456789876543210 :: Nat) (a :: Nat) (a :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m+ (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) n) m)+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) (x0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Nat)+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) ())+ data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 arg) =>+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) ())+ type family (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210+ type family (<<<%%%%%%%%%%%%%%%%%%%%) (x0123456789876543210 :: Nat) (a :: Nat) (a :: Nat) :: Nat where+ (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m+ (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) n) m)+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: Nat) (x0123456789876543210 :: Nat) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 x x = x+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: Nat) (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: Nat) (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ data Let0123456789876543210ZSym0 (x0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ Let0123456789876543210ZSym0KindInference :: SameKind (Apply (Let0123456789876543210ZSym0 x0123456789876543210) arg) (Let0123456789876543210ZSym1 x0123456789876543210 arg) =>+ Let0123456789876543210ZSym0 x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (Let0123456789876543210ZSym0 x0123456789876543210) a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210ZSym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210ZSym0KindInference ())+ type family Let0123456789876543210ZSym1 (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210+ type family Let0123456789876543210Z (x0123456789876543210 :: Nat) (a :: Nat) :: Nat where+ Let0123456789876543210Z x a_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210 x) a_0123456789876543210+ type family LamCases_0123456789876543210 (x0123456789876543210 :: Nat) a_0123456789876543210 where+ LamCases_0123456789876543210 x x = x+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: Nat) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family Let0123456789876543210ZSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210+ type family Let0123456789876543210Z (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Z x = Apply (LamCases_0123456789876543210Sym0 x) ZeroSym0+ type family Let0123456789876543210XSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210X x0123456789876543210+ type family Let0123456789876543210X (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210X x = ZeroSym0+ data Let0123456789876543210FSym0 (x0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ Let0123456789876543210FSym0KindInference :: SameKind (Apply (Let0123456789876543210FSym0 x0123456789876543210) arg) (Let0123456789876543210FSym1 x0123456789876543210 arg) =>+ Let0123456789876543210FSym0 x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (Let0123456789876543210FSym0 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210FSym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210FSym0KindInference ())+ type family Let0123456789876543210FSym1 (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ type family Let0123456789876543210F (x0123456789876543210 :: Nat) (a :: Nat) :: Nat where+ Let0123456789876543210F x y = Apply SuccSym0 y+ type family Let0123456789876543210ZSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210+ type family Let0123456789876543210Z (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Z x = Apply (Let0123456789876543210FSym0 x) x+ type family Let0123456789876543210ZSym0 (y0123456789876543210 :: Nat) (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210ZSym0 y0123456789876543210 x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210+ type family Let0123456789876543210Z (y0123456789876543210 :: Nat) (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Z y x = Apply SuccSym0 y+ data Let0123456789876543210FSym0 (x0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ Let0123456789876543210FSym0KindInference :: SameKind (Apply (Let0123456789876543210FSym0 x0123456789876543210) arg) (Let0123456789876543210FSym1 x0123456789876543210 arg) =>+ Let0123456789876543210FSym0 x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (Let0123456789876543210FSym0 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210FSym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210FSym0KindInference ())+ type family Let0123456789876543210FSym1 (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ type family Let0123456789876543210F (x0123456789876543210 :: Nat) (a :: Nat) :: Nat where+ Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym0 y x)+ data Let0123456789876543210FSym0 (x0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ Let0123456789876543210FSym0KindInference :: SameKind (Apply (Let0123456789876543210FSym0 x0123456789876543210) arg) (Let0123456789876543210FSym1 x0123456789876543210 arg) =>+ Let0123456789876543210FSym0 x0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (Let0123456789876543210FSym0 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210FSym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210FSym0KindInference ())+ type family Let0123456789876543210FSym1 (x0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210+ type family Let0123456789876543210F (x0123456789876543210 :: Nat) (a :: Nat) :: Nat where+ Let0123456789876543210F x y = Apply SuccSym0 y+ type family Let0123456789876543210YSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210+ type family Let0123456789876543210Y (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Y x = Apply SuccSym0 x+ type family Let0123456789876543210ZSym0 where+ Let0123456789876543210ZSym0 = Let0123456789876543210Z+ type family Let0123456789876543210YSym0 where+ Let0123456789876543210YSym0 = Let0123456789876543210Y+ type family Let0123456789876543210Z where+ Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0+ type family Let0123456789876543210Y where+ Let0123456789876543210Y = Apply SuccSym0 ZeroSym0+ type family Let0123456789876543210YSym0 (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210+ type family Let0123456789876543210Y (x0123456789876543210 :: Nat) :: Nat where+ Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0+ type Foo14Sym0 :: (~>) Nat (Nat, Nat)+ data Foo14Sym0 :: (~>) Nat (Nat, Nat)+ where+ Foo14Sym0KindInference :: SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) =>+ Foo14Sym0 a0123456789876543210+ type instance Apply @Nat @(Nat,+ Nat) Foo14Sym0 a0123456789876543210 = Foo14 a0123456789876543210+ instance SuppressUnusedWarnings Foo14Sym0 where+ suppressUnusedWarnings = snd ((,) Foo14Sym0KindInference ())+ type Foo14Sym1 :: Nat -> (Nat, Nat)+ type family Foo14Sym1 (a0123456789876543210 :: Nat) :: (Nat,+ Nat) where+ Foo14Sym1 a0123456789876543210 = Foo14 a0123456789876543210+ type Foo13_Sym0 :: (~>) a a+ data Foo13_Sym0 :: (~>) a a+ where+ Foo13_Sym0KindInference :: SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) =>+ Foo13_Sym0 a0123456789876543210+ type instance Apply @a @a Foo13_Sym0 a0123456789876543210 = Foo13_ a0123456789876543210+ instance SuppressUnusedWarnings Foo13_Sym0 where+ suppressUnusedWarnings = snd ((,) Foo13_Sym0KindInference ())+ type Foo13_Sym1 :: a -> a+ type family Foo13_Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo13_Sym1 a0123456789876543210 = Foo13_ a0123456789876543210+ type Foo13Sym0 :: forall a. (~>) a a+ data Foo13Sym0 :: (~>) a a+ where+ Foo13Sym0KindInference :: SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) =>+ Foo13Sym0 a0123456789876543210+ type instance Apply @a @a Foo13Sym0 a0123456789876543210 = Foo13 a0123456789876543210+ instance SuppressUnusedWarnings Foo13Sym0 where+ suppressUnusedWarnings = snd ((,) Foo13Sym0KindInference ())+ type Foo13Sym1 :: forall a. a -> a+ type family Foo13Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo13Sym1 a0123456789876543210 = Foo13 a0123456789876543210+ type Foo12Sym0 :: (~>) Nat Nat+ data Foo12Sym0 :: (~>) Nat Nat+ where+ Foo12Sym0KindInference :: SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) =>+ Foo12Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo12Sym0 a0123456789876543210 = Foo12 a0123456789876543210+ instance SuppressUnusedWarnings Foo12Sym0 where+ suppressUnusedWarnings = snd ((,) Foo12Sym0KindInference ())+ type Foo12Sym1 :: Nat -> Nat+ type family Foo12Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo12Sym1 a0123456789876543210 = Foo12 a0123456789876543210+ type Foo11Sym0 :: (~>) Nat Nat+ data Foo11Sym0 :: (~>) Nat Nat+ where+ Foo11Sym0KindInference :: SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) =>+ Foo11Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo11Sym0 a0123456789876543210 = Foo11 a0123456789876543210+ instance SuppressUnusedWarnings Foo11Sym0 where+ suppressUnusedWarnings = snd ((,) Foo11Sym0KindInference ())+ type Foo11Sym1 :: Nat -> Nat+ type family Foo11Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo11Sym1 a0123456789876543210 = Foo11 a0123456789876543210+ type Foo10Sym0 :: (~>) Nat Nat+ data Foo10Sym0 :: (~>) Nat Nat+ where+ Foo10Sym0KindInference :: SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) =>+ Foo10Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo10Sym0 a0123456789876543210 = Foo10 a0123456789876543210+ instance SuppressUnusedWarnings Foo10Sym0 where+ suppressUnusedWarnings = snd ((,) Foo10Sym0KindInference ())+ type Foo10Sym1 :: Nat -> Nat+ type family Foo10Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo10Sym1 a0123456789876543210 = Foo10 a0123456789876543210+ type Foo9Sym0 :: (~>) Nat Nat+ data Foo9Sym0 :: (~>) Nat Nat+ where+ Foo9Sym0KindInference :: SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) =>+ Foo9Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210+ instance SuppressUnusedWarnings Foo9Sym0 where+ suppressUnusedWarnings = snd ((,) Foo9Sym0KindInference ())+ type Foo9Sym1 :: Nat -> Nat+ type family Foo9Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo9Sym1 a0123456789876543210 = Foo9 a0123456789876543210+ type Foo8Sym0 :: (~>) Nat Nat+ data Foo8Sym0 :: (~>) Nat Nat+ where+ Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>+ Foo8Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210+ instance SuppressUnusedWarnings Foo8Sym0 where+ suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ())+ type Foo8Sym1 :: Nat -> Nat+ type family Foo8Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210+ type Foo7Sym0 :: (~>) Nat Nat+ data Foo7Sym0 :: (~>) Nat Nat+ where+ Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>+ Foo7Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo7Sym0 a0123456789876543210 = Foo7 a0123456789876543210+ instance SuppressUnusedWarnings Foo7Sym0 where+ suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ())+ type Foo7Sym1 :: Nat -> Nat+ type family Foo7Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo7Sym1 a0123456789876543210 = Foo7 a0123456789876543210+ type Foo6Sym0 :: (~>) Nat Nat+ data Foo6Sym0 :: (~>) Nat Nat+ where+ Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>+ Foo6Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210+ instance SuppressUnusedWarnings Foo6Sym0 where+ suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ())+ type Foo6Sym1 :: Nat -> Nat+ type family Foo6Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo6Sym1 a0123456789876543210 = Foo6 a0123456789876543210+ type Foo5Sym0 :: (~>) Nat Nat+ data Foo5Sym0 :: (~>) Nat Nat+ where+ Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>+ Foo5Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210+ instance SuppressUnusedWarnings Foo5Sym0 where+ suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ())+ type Foo5Sym1 :: Nat -> Nat+ type family Foo5Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210+ type Foo4Sym0 :: (~>) Nat Nat+ data Foo4Sym0 :: (~>) Nat Nat+ where+ Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>+ Foo4Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210+ instance SuppressUnusedWarnings Foo4Sym0 where+ suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ())+ type Foo4Sym1 :: Nat -> Nat+ type family Foo4Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210+ type Foo3Sym0 :: (~>) Nat Nat+ data Foo3Sym0 :: (~>) Nat Nat+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: Nat -> Nat+ type family Foo3Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210+ type Foo2Sym0 :: Nat+ type family Foo2Sym0 :: Nat where+ Foo2Sym0 = Foo2+ type Foo1Sym0 :: (~>) Nat Nat+ data Foo1Sym0 :: (~>) Nat Nat+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @Nat @Nat Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: Nat -> Nat+ type family Foo1Sym1 (a0123456789876543210 :: Nat) :: Nat where+ Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210+ type Foo14 :: Nat -> (Nat, Nat)+ type family Foo14 (a :: Nat) :: (Nat, Nat) where+ Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym0 x)) (Let0123456789876543210YSym0 x)+ type Foo13_ :: a -> a+ type family Foo13_ @a (a :: a) :: a where+ Foo13_ y = y+ type Foo13 :: forall a. a -> a+ type family Foo13 @a (a :: a) :: a where+ Foo13 @a (x :: a) = Apply Foo13_Sym0 (Let0123456789876543210BarSym0 a x)+ type Foo12 :: Nat -> Nat+ type family Foo12 (a :: Nat) :: Nat where+ Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))+ type Foo11 :: Nat -> Nat+ type family Foo11 (a :: Nat) :: Nat where+ Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym0 x)+ type Foo10 :: Nat -> Nat+ type family Foo10 (a :: Nat) :: Nat where+ Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$) x) (Apply SuccSym0 ZeroSym0)) x+ type Foo9 :: Nat -> Nat+ type family Foo9 (a :: Nat) :: Nat where+ Foo9 x = Apply (Let0123456789876543210ZSym0 x) x+ type Foo8 :: Nat -> Nat+ type family Foo8 (a :: Nat) :: Nat where+ Foo8 x = Let0123456789876543210ZSym0 x+ type Foo7 :: Nat -> Nat+ type family Foo7 (a :: Nat) :: Nat where+ Foo7 x = Let0123456789876543210XSym0 x+ type Foo6 :: Nat -> Nat+ type family Foo6 (a :: Nat) :: Nat where+ Foo6 x = Let0123456789876543210ZSym0 x+ type Foo5 :: Nat -> Nat+ type family Foo5 (a :: Nat) :: Nat where+ Foo5 x = Apply (Let0123456789876543210FSym0 x) x+ type Foo4 :: Nat -> Nat+ type family Foo4 (a :: Nat) :: Nat where+ Foo4 x = Apply (Let0123456789876543210FSym0 x) x+ type Foo3 :: Nat -> Nat+ type family Foo3 (a :: Nat) :: Nat where+ Foo3 x = Let0123456789876543210YSym0 x+ type Foo2 :: Nat+ type family Foo2 :: Nat where+ Foo2 = Let0123456789876543210ZSym0+ type Foo1 :: Nat -> Nat+ type family Foo1 (a :: Nat) :: Nat where+ Foo1 x = Let0123456789876543210YSym0 x+ sFoo14 ::+ (forall (t :: Nat). Sing t -> Sing (Foo14 t :: (Nat, Nat)) :: Type)+ sFoo13_ ::+ (forall (t :: a). Sing t -> Sing (Foo13_ t :: a) :: Type)+ sFoo13 :: forall a (t :: a). Sing t -> Sing (Foo13 t :: a)+ sFoo12 ::+ (forall (t :: Nat). Sing t -> Sing (Foo12 t :: Nat) :: Type)+ sFoo11 ::+ (forall (t :: Nat). Sing t -> Sing (Foo11 t :: Nat) :: Type)+ sFoo10 ::+ (forall (t :: Nat). Sing t -> Sing (Foo10 t :: Nat) :: Type)+ sFoo9 ::+ (forall (t :: Nat). Sing t -> Sing (Foo9 t :: Nat) :: Type)+ sFoo8 ::+ (forall (t :: Nat). Sing t -> Sing (Foo8 t :: Nat) :: Type)+ sFoo7 ::+ (forall (t :: Nat). Sing t -> Sing (Foo7 t :: Nat) :: Type)+ sFoo6 ::+ (forall (t :: Nat). Sing t -> Sing (Foo6 t :: Nat) :: Type)+ sFoo5 ::+ (forall (t :: Nat). Sing t -> Sing (Foo5 t :: Nat) :: Type)+ sFoo4 ::+ (forall (t :: Nat). Sing t -> Sing (Foo4 t :: Nat) :: Type)+ sFoo3 ::+ (forall (t :: Nat). Sing t -> Sing (Foo3 t :: Nat) :: Type)+ sFoo2 :: (Sing (Foo2 :: Nat) :: Type)+ sFoo1 ::+ (forall (t :: Nat). Sing t -> Sing (Foo1 t :: Nat) :: Type)+ sFoo14 (sX :: Sing x)+ = let+ sZ :: Sing @_ (Let0123456789876543210Z x)+ sY :: Sing @_ (Let0123456789876543210Y x)+ sX_0123456789876543210 ::+ Sing @_ (Let0123456789876543210X_0123456789876543210 x)+ sZ+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases+ (STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sY+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases+ (STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ 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 (Let0123456789876543210Bar a x :: a) :: Type)+ sBar = sX+ in applySing (singFun1 @Foo13_Sym0 sFoo13_) sBar+ sFoo12 (sX :: Sing x)+ = let+ (%+) ::+ (forall (t :: Nat) (t :: Nat).+ Sing t+ -> Sing t -> Sing ((<<<%%%%%%%%%%%%%%%%%%%%) x t t :: Nat) :: Type)+ (%+) 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 (Let0123456789876543210Z x :: Nat) :: Type)+ (%+) ::+ (forall (t :: Nat) (t :: Nat).+ Sing t+ -> Sing t -> Sing ((<<<%%%%%%%%%%%%%%%%%%%%) x t t :: Nat) :: Type)+ 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 ((<<<%%%%%%%%%%%%%%%%%%%%) x t t :: Nat) :: Type)+ (%+) 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 (Let0123456789876543210Z x t :: Nat) :: Type)+ sZ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210 x)+ (\cases (sX :: Sing x) -> sX))+ sA_0123456789876543210+ in applySing (singFun1 @(Let0123456789876543210ZSym0 x) sZ) sX+ sFoo8 (sX :: Sing x)+ = let+ sZ :: (Sing (Let0123456789876543210Z x :: Nat) :: Type)+ sZ+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases (sX :: Sing x) -> sX))+ SZero+ in sZ+ sFoo7 (sX :: Sing x)+ = let+ sX :: (Sing (Let0123456789876543210X x :: Nat) :: Type)+ sX = SZero+ in sX+ sFoo6 (sX :: Sing x)+ = let+ sF ::+ (forall (t :: Nat).+ Sing t -> Sing (Let0123456789876543210F x t :: Nat) :: Type)+ sF (sY :: Sing y) = applySing (singFun1 @SuccSym0 SSucc) sY in+ let+ sZ :: (Sing (Let0123456789876543210Z x :: Nat) :: Type)+ sZ = applySing (singFun1 @(Let0123456789876543210FSym0 x) sF) sX+ in sZ+ sFoo5 (sX :: Sing x)+ = let+ sF ::+ (forall (t :: Nat).+ Sing t -> Sing (Let0123456789876543210F x t :: Nat) :: Type)+ sF (sY :: Sing y)+ = let+ sZ :: (Sing (Let0123456789876543210Z y x :: Nat) :: Type)+ sZ = applySing (singFun1 @SuccSym0 SSucc) sY+ in applySing (singFun1 @SuccSym0 SSucc) sZ+ in applySing (singFun1 @(Let0123456789876543210FSym0 x) sF) sX+ sFoo4 (sX :: Sing x)+ = let+ sF ::+ (forall (t :: Nat).+ Sing t -> Sing (Let0123456789876543210F x t :: Nat) :: Type)+ sF (sY :: Sing y) = applySing (singFun1 @SuccSym0 SSucc) sY+ in applySing (singFun1 @(Let0123456789876543210FSym0 x) sF) sX+ sFoo3 (sX :: Sing x)+ = let+ sY :: (Sing (Let0123456789876543210Y x :: Nat) :: Type)+ sY = applySing (singFun1 @SuccSym0 SSucc) sX+ in sY+ sFoo2+ = let+ sZ :: Sing @_ Let0123456789876543210Z+ sY :: Sing @_ Let0123456789876543210Y+ sZ = applySing (singFun1 @SuccSym0 SSucc) sY+ sY = applySing (singFun1 @SuccSym0 SSucc) SZero+ in sZ+ sFoo1 (sX :: Sing x)+ = let+ sY :: (Sing (Let0123456789876543210Y x :: Nat) :: Type)+ 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 view
@@ -1,192 +1,192 @@-{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-matches - -Wno-name-shadowing #-} - -module Singletons.LetStatements where - -import Data.Singletons -import Data.Singletons.TH -import Prelude.Singletons -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 +{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-matches+ -Wno-name-shadowing #-}++module Singletons.LetStatements where++import Data.Singletons+import Data.Singletons.TH+import Prelude.Singletons+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.golden view
@@ -1,186 +1,126 @@-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 :: forall a. Maybe a - type family NothingSym0 :: Maybe a where - NothingSym0 = Nothing - type JustSym0 :: forall a. (~>) a (Maybe a) - data JustSym0 :: (~>) a (Maybe a) - where - JustSym0KindInference :: SameKind (Apply JustSym0 arg) (JustSym1 arg) => - JustSym0 a0123456789876543210 - type instance Apply JustSym0 a0123456789876543210 = Just a0123456789876543210 - instance SuppressUnusedWarnings JustSym0 where - suppressUnusedWarnings = snd ((,) JustSym0KindInference ()) - type JustSym1 :: forall a. a -> Maybe a - type family JustSym1 (a0123456789876543210 :: a) :: Maybe a where - JustSym1 a0123456789876543210 = Just a0123456789876543210 - type TFHelper_0123456789876543210 :: Maybe a -> Maybe a -> Bool - type family TFHelper_0123456789876543210 (a :: Maybe a) (a :: Maybe a) :: Bool where - TFHelper_0123456789876543210 Nothing Nothing = TrueSym0 - TFHelper_0123456789876543210 Nothing (Just _) = FalseSym0 - TFHelper_0123456789876543210 (Just _) Nothing = FalseSym0 - TFHelper_0123456789876543210 (Just a_0123456789876543210) (Just b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) (Maybe a) ((~>) (Maybe a) Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) (Maybe a) ((~>) (Maybe a) Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Maybe a - -> (~>) (Maybe a) Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Maybe a) :: (~>) (Maybe a) Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Maybe a -> Maybe a -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: Maybe a) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq (Maybe a) where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Maybe a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Maybe a -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Maybe a) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Maybe a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow (Maybe a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data SMaybe :: forall a. Maybe a -> Type - where - SNothing :: forall a. SMaybe (Nothing :: Maybe a) - SJust :: forall a (n :: a). (Sing n) -> SMaybe (Just n :: Maybe a) - type instance Sing @(Maybe a) = SMaybe - 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 SEq a => SEq (Maybe a) where - (%==) :: - forall (t1 :: Maybe a) (t2 :: Maybe a). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun (Maybe a) ((~>) (Maybe a) Bool) - -> Type) t1) t2) - (%==) SNothing SNothing = STrue - (%==) SNothing (SJust _) = SFalse - (%==) (SJust _) SNothing = SFalse - (%==) - (SJust (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SJust (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210 - instance SShow a => SShow (Maybe a) where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: Maybe a) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - -> 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) - (sFromInteger (sing :: Sing 10)))) - (applySing - (applySing - (singFun3 @(.@#@$) (%.)) - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Just "))) - (applySing - (applySing - (singFun3 @ShowsPrecSym0 sShowsPrec) - (sFromInteger (sing :: Sing 11))) - sArg_0123456789876543210))) - sA_0123456789876543210 - instance SDecide a => SDecide (Maybe a) where - (%~) SNothing SNothing = Proved Refl - (%~) SNothing (SJust _) = Disproved (\ x -> case x of {}) - (%~) (SJust _) SNothing = Disproved (\ x -> case x of {}) - (%~) (SJust a) (SJust b) - = case (%~) a b of - Proved Refl -> Proved Refl - Disproved contra - -> Disproved (\ refl -> case refl of Refl -> contra Refl) - instance SDecide a => - Data.Type.Equality.TestEquality (SMaybe :: Maybe a -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide a => - Data.Type.Coercion.TestCoercion (SMaybe :: Maybe a -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Data.Singletons.ShowSing.ShowSing a => - Show (SMaybe (z :: Maybe a)) - instance SingI Nothing where - sing = SNothing - instance SingI n => SingI (Just (n :: a)) where - sing = SJust sing - instance SingI1 Just where - liftSing = SJust - instance SingI (JustSym0 :: (~>) a (Maybe a)) where - sing = singFun1 @JustSym0 SJust +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 :: forall a. Maybe a+ type family NothingSym0 @a :: Maybe a where+ NothingSym0 = Nothing+ type JustSym0 :: forall a. (~>) a (Maybe a)+ data JustSym0 :: (~>) a (Maybe a)+ where+ JustSym0KindInference :: SameKind (Apply JustSym0 arg) (JustSym1 arg) =>+ JustSym0 a0123456789876543210+ type instance Apply @a @(Maybe a) JustSym0 a0123456789876543210 = Just a0123456789876543210+ instance SuppressUnusedWarnings JustSym0 where+ suppressUnusedWarnings = snd ((,) JustSym0KindInference ())+ type JustSym1 :: forall a. a -> Maybe a+ type family JustSym1 @a (a0123456789876543210 :: a) :: Maybe a where+ JustSym1 a0123456789876543210 = Just a0123456789876543210+ type TFHelper_0123456789876543210 :: forall a. Maybe a+ -> Maybe a -> Bool+ type family TFHelper_0123456789876543210 @a (a :: Maybe a) (a :: Maybe a) :: Bool where+ TFHelper_0123456789876543210 @a (Nothing :: Maybe a) (Nothing :: Maybe a) = TrueSym0+ TFHelper_0123456789876543210 @a (Nothing :: Maybe a) (Just _ :: Maybe a) = FalseSym0+ TFHelper_0123456789876543210 @a (Just _ :: Maybe a) (Nothing :: Maybe a) = FalseSym0+ TFHelper_0123456789876543210 @a (Just a_0123456789876543210 :: Maybe a) (Just b_0123456789876543210 :: Maybe a) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq (Maybe a) where+ type (==) a a = TFHelper_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: forall a. GHC.Internal.Bignum.Natural.Natural+ -> Maybe a+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 @a (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Maybe a) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.Types.Symbol where+ ShowsPrec_0123456789876543210 @a (_ :: GHC.Internal.Bignum.Natural.Natural) (Nothing :: Maybe a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210+ ShowsPrec_0123456789876543210 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (Just arg_0123456789876543210 :: Maybe a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210+ instance PShow (Maybe a) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data SMaybe :: forall a. Maybe a -> Type+ where+ SNothing :: forall a. SMaybe (Nothing :: Maybe a)+ SJust :: forall a (n :: a). (Sing n) -> SMaybe (Just n :: Maybe a)+ type instance Sing @(Maybe a) = SMaybe+ 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))+ = (\cases (SomeSing c) -> SomeSing (SJust c))+ (toSing b :: SomeSing a)+ instance SEq a => SEq (Maybe a) where+ (%==) SNothing SNothing = STrue+ (%==) SNothing (SJust _) = SFalse+ (%==) (SJust _) SNothing = SFalse+ (%==)+ (SJust (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SJust (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SShow a => SShow (Maybe a) where+ 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)+ (sFromInteger (sing :: Sing 10))))+ (applySing+ (applySing+ (singFun3 @(.@#@$) (%.))+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Just ")))+ (applySing+ (applySing+ (singFun3 @ShowsPrecSym0 sShowsPrec)+ (sFromInteger (sing :: Sing 11)))+ sArg_0123456789876543210)))+ sA_0123456789876543210+ instance SDecide a => SDecide (Maybe a) where+ (%~) SNothing SNothing = Proved Refl+ (%~) SNothing (SJust _) = Disproved (\case)+ (%~) (SJust _) SNothing = Disproved (\case)+ (%~) (SJust a) (SJust b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SMaybe (z :: Maybe a)) where+ (==) _ _ = True+ instance SDecide a =>+ GHC.Internal.Data.Type.Equality.TestEquality (SMaybe :: Maybe a+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide a =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SMaybe :: Maybe a+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ deriving instance Data.Singletons.ShowSing.ShowSing a =>+ Show (SMaybe (z :: Maybe a))+ instance SingI Nothing where+ sing = SNothing+ instance SingI n => SingI (Just (n :: a)) where+ sing = SJust sing+ instance SingI1 Just where+ liftSing = SJust+ instance SingI (JustSym0 :: (~>) a (Maybe a)) where+ sing = singFun1 @JustSym0 SJust
tests/compile-and-dump/Singletons/Maybe.hs view
@@ -1,7 +1,7 @@-module Singletons.Maybe where - -import Data.Singletons.Base.TH - -$(singletons [d| - data Maybe a = Nothing | Just a deriving (Eq, Show) - |]) +module Singletons.Maybe where++import Data.Singletons.Base.TH++$(singletons [d|+ data Maybe a = Nothing | Just a deriving (Eq, Show)+ |])
tests/compile-and-dump/Singletons/Nat.golden view
@@ -1,321 +1,235 @@-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 :: Nat - type family ZeroSym0 :: Nat where - ZeroSym0 = Zero - type SuccSym0 :: (~>) Nat Nat - data SuccSym0 :: (~>) Nat Nat - where - SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0 a0123456789876543210 - type instance Apply SuccSym0 a0123456789876543210 = Succ a0123456789876543210 - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings = snd ((,) SuccSym0KindInference ()) - type SuccSym1 :: Nat -> Nat - type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where - SuccSym1 a0123456789876543210 = Succ a0123456789876543210 - type PredSym0 :: (~>) Nat Nat - data PredSym0 :: (~>) Nat Nat - where - PredSym0KindInference :: SameKind (Apply PredSym0 arg) (PredSym1 arg) => - PredSym0 a0123456789876543210 - type instance Apply PredSym0 a0123456789876543210 = Pred a0123456789876543210 - instance SuppressUnusedWarnings PredSym0 where - suppressUnusedWarnings = snd ((,) PredSym0KindInference ()) - type PredSym1 :: Nat -> Nat - type family PredSym1 (a0123456789876543210 :: Nat) :: Nat where - PredSym1 a0123456789876543210 = Pred a0123456789876543210 - type PlusSym0 :: (~>) Nat ((~>) Nat Nat) - data PlusSym0 :: (~>) Nat ((~>) Nat Nat) - where - PlusSym0KindInference :: SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => - PlusSym0 a0123456789876543210 - type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210 - instance SuppressUnusedWarnings PlusSym0 where - suppressUnusedWarnings = snd ((,) PlusSym0KindInference ()) - type PlusSym1 :: Nat -> (~>) Nat Nat - data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - PlusSym1KindInference :: SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) => - PlusSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (PlusSym1 a0123456789876543210) a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) PlusSym1KindInference ()) - type PlusSym2 :: Nat -> Nat -> Nat - type family PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - PlusSym2 a0123456789876543210 a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210 - type Pred :: Nat -> Nat - type family Pred (a :: Nat) :: Nat where - Pred Zero = ZeroSym0 - Pred (Succ n) = n - type Plus :: Nat -> Nat -> Nat - 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 TFHelper_0123456789876543210 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where - TFHelper_0123456789876543210 Zero Zero = TrueSym0 - TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0 - TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0 - TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Nat -> (~>) Nat Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Nat where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Nat -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Nat -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Nat -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Nat where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type Compare_0123456789876543210 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Nat -> (~>) Nat Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - sPred :: - (forall (t :: Nat). - Sing t -> Sing (Apply PredSym0 t :: Nat) :: Type) - sPlus :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) :: Type) - 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)) - instance SingI1 (PlusSym1 :: Nat -> (~>) Nat Nat) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(PlusSym1 (d :: Nat)) (sPlus s) - data SNat :: Nat -> Type - where - SZero :: SNat (Zero :: Nat) - SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat) - type instance Sing @Nat = SNat - 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 SEq Nat => SEq Nat where - (%==) :: - forall (t1 :: Nat) (t2 :: Nat). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Nat ((~>) Nat Bool) - -> Type) t1) t2) - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210 - instance SShow Nat => SShow Nat where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: Nat) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - -> 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) - (sFromInteger (sing :: Sing 10)))) - (applySing - (applySing - (singFun3 @(.@#@$) (%.)) - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Succ "))) - (applySing - (applySing - (singFun3 @ShowsPrecSym0 sShowsPrec) - (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) - -> Type) t1) t2) - sCompare SZero SZero - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - (applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing - (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210) - sB_0123456789876543210)) - SNil) - sCompare SZero (SSucc _) = SLT - sCompare (SSucc _) SZero = SGT - 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 SDecide Nat => - Data.Type.Equality.TestEquality (SNat :: Nat -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide Nat => - Data.Type.Coercion.TestCoercion (SNat :: Nat -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Data.Singletons.ShowSing.ShowSing Nat => - Show (SNat (z :: Nat)) - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing - instance SingI1 Succ where - liftSing = SSucc - instance SingI (SuccSym0 :: (~>) Nat Nat) where - sing = singFun1 @SuccSym0 SSucc +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 :: Nat+ type family ZeroSym0 :: Nat where+ ZeroSym0 = Zero+ type SuccSym0 :: (~>) Nat Nat+ data SuccSym0 :: (~>) Nat Nat+ where+ SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>+ SuccSym0 a0123456789876543210+ type instance Apply @Nat @Nat SuccSym0 a0123456789876543210 = Succ a0123456789876543210+ instance SuppressUnusedWarnings SuccSym0 where+ suppressUnusedWarnings = snd ((,) SuccSym0KindInference ())+ type SuccSym1 :: Nat -> Nat+ type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where+ SuccSym1 a0123456789876543210 = Succ a0123456789876543210+ type PredSym0 :: (~>) Nat Nat+ data PredSym0 :: (~>) Nat Nat+ where+ PredSym0KindInference :: SameKind (Apply PredSym0 arg) (PredSym1 arg) =>+ PredSym0 a0123456789876543210+ type instance Apply @Nat @Nat PredSym0 a0123456789876543210 = Pred a0123456789876543210+ instance SuppressUnusedWarnings PredSym0 where+ suppressUnusedWarnings = snd ((,) PredSym0KindInference ())+ type PredSym1 :: Nat -> Nat+ type family PredSym1 (a0123456789876543210 :: Nat) :: Nat where+ PredSym1 a0123456789876543210 = Pred a0123456789876543210+ type PlusSym0 :: (~>) Nat ((~>) Nat Nat)+ data PlusSym0 :: (~>) Nat ((~>) Nat Nat)+ where+ PlusSym0KindInference :: SameKind (Apply PlusSym0 arg) (PlusSym1 arg) =>+ PlusSym0 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210+ instance SuppressUnusedWarnings PlusSym0 where+ suppressUnusedWarnings = snd ((,) PlusSym0KindInference ())+ type PlusSym1 :: Nat -> (~>) Nat Nat+ data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ PlusSym1KindInference :: SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) =>+ PlusSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (PlusSym1 a0123456789876543210) a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) PlusSym1KindInference ())+ type PlusSym2 :: Nat -> Nat -> Nat+ type family PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ PlusSym2 a0123456789876543210 a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210+ type Pred :: Nat -> Nat+ type family Pred (a :: Nat) :: Nat where+ Pred Zero = ZeroSym0+ Pred (Succ n) = n+ type Plus :: Nat -> Nat -> Nat+ 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 TFHelper_0123456789876543210 :: Nat -> Nat -> Bool+ type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where+ TFHelper_0123456789876543210 Zero Zero = TrueSym0+ TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0+ TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0+ TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq Nat where+ type (==) a a = TFHelper_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Nat+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Nat) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.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) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210+ instance PShow Nat where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type Compare_0123456789876543210 :: Nat -> Nat -> Ordering+ type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where+ Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ Compare_0123456789876543210 Zero (Succ _) = LTSym0+ Compare_0123456789876543210 (Succ _) Zero = GTSym0+ instance POrd Nat where+ type Compare a a = Compare_0123456789876543210 a a+ sPred ::+ (forall (t :: Nat). Sing t -> Sing (Pred t :: Nat) :: Type)+ sPlus ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing (Plus t t :: Nat) :: Type)+ 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))+ instance SingI1 (PlusSym1 :: Nat -> (~>) Nat Nat) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(PlusSym1 (d :: Nat)) (sPlus s)+ data SNat :: Nat -> Type+ where+ SZero :: SNat (Zero :: Nat)+ SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat)+ type instance Sing @Nat = SNat+ 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))+ = (\cases (SomeSing c) -> SomeSing (SSucc c))+ (toSing b :: SomeSing Nat)+ instance SEq Nat => SEq Nat where+ (%==) SZero SZero = STrue+ (%==) SZero (SSucc _) = SFalse+ (%==) (SSucc _) SZero = SFalse+ (%==)+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SShow Nat => SShow Nat where+ 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)+ (sFromInteger (sing :: Sing 10))))+ (applySing+ (applySing+ (singFun3 @(.@#@$) (%.))+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Succ ")))+ (applySing+ (applySing+ (singFun3 @ShowsPrecSym0 sShowsPrec)+ (sFromInteger (sing :: Sing 11)))+ sArg_0123456789876543210)))+ sA_0123456789876543210+ instance SOrd Nat => SOrd Nat where+ sCompare SZero SZero+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ (applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing+ (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210)+ sB_0123456789876543210))+ SNil)+ sCompare SZero (SSucc _) = SLT+ sCompare (SSucc _) SZero = SGT+ instance SDecide Nat => SDecide Nat where+ (%~) SZero SZero = Proved Refl+ (%~) SZero (SSucc _) = Disproved (\case)+ (%~) (SSucc _) SZero = Disproved (\case)+ (%~) (SSucc a) (SSucc b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SNat (z :: Nat)) where+ (==) _ _ = True+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Equality.TestEquality (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SNat (z :: Nat)) where+ compare _ _ = EQ+ deriving instance Data.Singletons.ShowSing.ShowSing Nat =>+ Show (SNat (z :: Nat))+ instance SingI Zero where+ sing = SZero+ instance SingI n => SingI (Succ (n :: Nat)) where+ sing = SSucc sing+ instance SingI1 Succ where+ liftSing = SSucc+ instance SingI (SuccSym0 :: (~>) Nat Nat) where+ sing = singFun1 @SuccSym0 SSucc
tests/compile-and-dump/Singletons/Nat.hs view
@@ -1,18 +1,18 @@-module Singletons.Nat where - -import Data.Singletons.Base.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 - |]) +module Singletons.Nat where++import Data.Singletons.Base.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.hs view
@@ -1,11 +1,11 @@-module NatSymbolReflexive where - -import Data.Type.Equality ((:~:)(..)) -import GHC.TypeLits -import Prelude.Singletons - -test1 :: forall (a :: Natural). Sing a -> (a == a) :~: True -test1 _ = Refl - -test2 :: forall (a :: Symbol). Sing a -> (a == a) :~: True -test2 _ = Refl +module NatSymbolReflexive where++import Data.Type.Equality ((:~:)(..))+import GHC.TypeLits+import Prelude.Singletons++test1 :: forall (a :: Natural). Sing a -> (a == a) :~: True+test1 _ = Refl++test2 :: forall (a :: Symbol). Sing a -> (a == a) :~: True+test2 _ = Refl
tests/compile-and-dump/Singletons/Natural.golden view
@@ -1,80 +1,80 @@-Singletons/Natural.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| addAge :: Age -> Age -> Age - addAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) - = MkAge (x + y :: Natural) - - newtype Age = MkAge Natural |] - ======> - newtype Age = MkAge Natural - addAge :: Age -> Age -> Age - addAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) - = MkAge ((x + y) :: Natural) - type MkAgeSym0 :: (~>) Natural Age - data MkAgeSym0 :: (~>) Natural Age - where - MkAgeSym0KindInference :: SameKind (Apply MkAgeSym0 arg) (MkAgeSym1 arg) => - MkAgeSym0 a0123456789876543210 - type instance Apply MkAgeSym0 a0123456789876543210 = MkAge a0123456789876543210 - instance SuppressUnusedWarnings MkAgeSym0 where - suppressUnusedWarnings = snd ((,) MkAgeSym0KindInference ()) - type MkAgeSym1 :: Natural -> Age - type family MkAgeSym1 (a0123456789876543210 :: Natural) :: Age where - MkAgeSym1 a0123456789876543210 = MkAge a0123456789876543210 - type AddAgeSym0 :: (~>) Age ((~>) Age Age) - data AddAgeSym0 :: (~>) Age ((~>) Age Age) - where - AddAgeSym0KindInference :: SameKind (Apply AddAgeSym0 arg) (AddAgeSym1 arg) => - AddAgeSym0 a0123456789876543210 - type instance Apply AddAgeSym0 a0123456789876543210 = AddAgeSym1 a0123456789876543210 - instance SuppressUnusedWarnings AddAgeSym0 where - suppressUnusedWarnings = snd ((,) AddAgeSym0KindInference ()) - type AddAgeSym1 :: Age -> (~>) Age Age - data AddAgeSym1 (a0123456789876543210 :: Age) :: (~>) Age Age - where - AddAgeSym1KindInference :: SameKind (Apply (AddAgeSym1 a0123456789876543210) arg) (AddAgeSym2 a0123456789876543210 arg) => - AddAgeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AddAgeSym1 a0123456789876543210) a0123456789876543210 = AddAge a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AddAgeSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) AddAgeSym1KindInference ()) - type AddAgeSym2 :: Age -> Age -> Age - type family AddAgeSym2 (a0123456789876543210 :: Age) (a0123456789876543210 :: Age) :: Age where - AddAgeSym2 a0123456789876543210 a0123456789876543210 = AddAge a0123456789876543210 a0123456789876543210 - type AddAge :: Age -> Age -> Age - type family AddAge (a :: Age) (a :: Age) :: Age where - AddAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) = Apply MkAgeSym0 (Apply (Apply (+@#@$) x) y :: Natural) - sAddAge :: - (forall (t :: Age) (t :: Age). - Sing t - -> Sing t -> Sing (Apply (Apply AddAgeSym0 t) t :: Age) :: Type) - sAddAge (SMkAge (sX :: Sing x)) (SMkAge (sY :: Sing y)) - = case (,) (sX :: Sing x) (sY :: Sing y) of - (,) (_ :: Sing (x :: Natural)) (_ :: Sing (y :: Natural)) - -> applySing - (singFun1 @MkAgeSym0 SMkAge) - (applySing (applySing (singFun2 @(+@#@$) (%+)) sX) sY :: - Sing (Apply (Apply (+@#@$) x) y :: Natural)) - instance SingI (AddAgeSym0 :: (~>) Age ((~>) Age Age)) where - sing = singFun2 @AddAgeSym0 sAddAge - instance SingI d => - SingI (AddAgeSym1 (d :: Age) :: (~>) Age Age) where - sing = singFun1 @(AddAgeSym1 (d :: Age)) (sAddAge (sing @d)) - instance SingI1 (AddAgeSym1 :: Age -> (~>) Age Age) where - liftSing (s :: Sing (d :: Age)) - = singFun1 @(AddAgeSym1 (d :: Age)) (sAddAge s) - data SAge :: Age -> Type - where - SMkAge :: forall (n :: Natural). (Sing n) -> SAge (MkAge n :: Age) - type instance Sing @Age = SAge - instance SingKind Age where - type Demote Age = Age - fromSing (SMkAge b) = MkAge (fromSing b) - toSing (MkAge (b :: Demote Natural)) - = case toSing b :: SomeSing Natural of - SomeSing c -> SomeSing (SMkAge c) - instance SingI n => SingI (MkAge (n :: Natural)) where - sing = SMkAge sing - instance SingI1 MkAge where - liftSing = SMkAge - instance SingI (MkAgeSym0 :: (~>) Natural Age) where - sing = singFun1 @MkAgeSym0 SMkAge +Singletons/Natural.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| addAge :: Age -> Age -> Age+ addAge (MkAge (x :: Natural)) (MkAge (y :: Natural))+ = MkAge (x + y :: Natural)+ + newtype Age = MkAge Natural |]+ ======>+ newtype Age = MkAge Natural+ addAge :: Age -> Age -> Age+ addAge (MkAge (x :: Natural)) (MkAge (y :: Natural))+ = MkAge ((x + y) :: Natural)+ type MkAgeSym0 :: (~>) Natural Age+ data MkAgeSym0 :: (~>) Natural Age+ where+ MkAgeSym0KindInference :: SameKind (Apply MkAgeSym0 arg) (MkAgeSym1 arg) =>+ MkAgeSym0 a0123456789876543210+ type instance Apply @Natural @Age MkAgeSym0 a0123456789876543210 = MkAge a0123456789876543210+ instance SuppressUnusedWarnings MkAgeSym0 where+ suppressUnusedWarnings = snd ((,) MkAgeSym0KindInference ())+ type MkAgeSym1 :: Natural -> Age+ type family MkAgeSym1 (a0123456789876543210 :: Natural) :: Age where+ MkAgeSym1 a0123456789876543210 = MkAge a0123456789876543210+ type AddAgeSym0 :: (~>) Age ((~>) Age Age)+ data AddAgeSym0 :: (~>) Age ((~>) Age Age)+ where+ AddAgeSym0KindInference :: SameKind (Apply AddAgeSym0 arg) (AddAgeSym1 arg) =>+ AddAgeSym0 a0123456789876543210+ type instance Apply @Age @((~>) Age Age) AddAgeSym0 a0123456789876543210 = AddAgeSym1 a0123456789876543210+ instance SuppressUnusedWarnings AddAgeSym0 where+ suppressUnusedWarnings = snd ((,) AddAgeSym0KindInference ())+ type AddAgeSym1 :: Age -> (~>) Age Age+ data AddAgeSym1 (a0123456789876543210 :: Age) :: (~>) Age Age+ where+ AddAgeSym1KindInference :: SameKind (Apply (AddAgeSym1 a0123456789876543210) arg) (AddAgeSym2 a0123456789876543210 arg) =>+ AddAgeSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Age @Age (AddAgeSym1 a0123456789876543210) a0123456789876543210 = AddAge a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (AddAgeSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) AddAgeSym1KindInference ())+ type AddAgeSym2 :: Age -> Age -> Age+ type family AddAgeSym2 (a0123456789876543210 :: Age) (a0123456789876543210 :: Age) :: Age where+ AddAgeSym2 a0123456789876543210 a0123456789876543210 = AddAge a0123456789876543210 a0123456789876543210+ type AddAge :: Age -> Age -> Age+ type family AddAge (a :: Age) (a :: Age) :: Age where+ AddAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) = Apply MkAgeSym0 (Apply (Apply (+@#@$) x) y :: Natural)+ sAddAge ::+ (forall (t :: Age) (t :: Age).+ Sing t -> Sing t -> Sing (AddAge t t :: Age) :: Type)+ sAddAge (SMkAge (sX :: Sing x)) (SMkAge (sY :: Sing y))+ = (\cases+ (_ :: Sing (x :: Natural)) (_ :: Sing (y :: Natural))+ -> applySing+ (singFun1 @MkAgeSym0 SMkAge)+ (applySing (applySing (singFun2 @(+@#@$) (%+)) sX) sY ::+ Sing (Apply (Apply (+@#@$) x) y :: Natural)))+ (sX :: Sing x) (sY :: Sing y)+ instance SingI (AddAgeSym0 :: (~>) Age ((~>) Age Age)) where+ sing = singFun2 @AddAgeSym0 sAddAge+ instance SingI d =>+ SingI (AddAgeSym1 (d :: Age) :: (~>) Age Age) where+ sing = singFun1 @(AddAgeSym1 (d :: Age)) (sAddAge (sing @d))+ instance SingI1 (AddAgeSym1 :: Age -> (~>) Age Age) where+ liftSing (s :: Sing (d :: Age))+ = singFun1 @(AddAgeSym1 (d :: Age)) (sAddAge s)+ data SAge :: Age -> Type+ where+ SMkAge :: forall (n :: Natural). (Sing n) -> SAge (MkAge n :: Age)+ type instance Sing @Age = SAge+ instance SingKind Age where+ type Demote Age = Age+ fromSing (SMkAge b) = MkAge (fromSing b)+ toSing (MkAge (b :: Demote Natural))+ = (\cases (SomeSing c) -> SomeSing (SMkAge c))+ (toSing b :: SomeSing Natural)+ instance SingI n => SingI (MkAge (n :: Natural)) where+ sing = SMkAge sing+ instance SingI1 MkAge where+ liftSing = SMkAge+ instance SingI (MkAgeSym0 :: (~>) Natural Age) where+ sing = singFun1 @MkAgeSym0 SMkAge
tests/compile-and-dump/Singletons/Natural.hs view
@@ -1,13 +1,13 @@-module Singletons.Natural where - -import Data.Singletons.TH -import Numeric.Natural (Natural) -import Prelude.Singletons - -$(singletons [d| - newtype Age = MkAge Natural - - addAge :: Age -> Age -> Age - addAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) = - MkAge (x + y :: Natural) - |]) +module Singletons.Natural where++import Data.Singletons.TH+import Numeric.Natural (Natural)+import Prelude.Singletons++$(singletons [d|+ newtype Age = MkAge Natural++ addAge :: Age -> Age -> Age+ addAge (MkAge (x :: Natural)) (MkAge (y :: Natural)) =+ MkAge (x + y :: Natural)+ |])
tests/compile-and-dump/Singletons/NegativeLiterals.golden view
@@ -1,21 +1,21 @@-Singletons/NegativeLiterals.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| f :: Natural - f = -1 |] - ======> - f :: Natural - f = (-1) - type FSym0 :: Natural - type family FSym0 :: Natural where - FSym0 = F - type F :: Natural - type family F :: Natural where - F = Negate (FromInteger 1) - sF :: (Sing (FSym0 :: Natural) :: Type) - sF = sNegate (sFromInteger (sing :: Sing 1)) - -Singletons/NegativeLiterals.hs:0:0: warning: [GHC-97441] [-Woverflowed-literals] - Literal -1 is negative but Natural only supports positive numbers - | -8 | $(singletons [d| - | ^^^^^^^^^^^^^^^... +Singletons/NegativeLiterals.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| f :: Natural+ f = -1 |]+ ======>+ f :: Natural+ f = (-1)+ type FSym0 :: Natural+ type family FSym0 :: Natural where+ FSym0 = F+ type F :: Natural+ type family F :: Natural where+ F = Negate (FromInteger 1)+ sF :: (Sing (F :: Natural) :: Type)+ sF = sNegate (sFromInteger (sing :: Sing 1))+Singletons/NegativeLiterals.hs:0:0: warning: [GHC-97441] [-Woverflowed-literals]+ Literal -1 is negative but Natural only supports positive numbers+ |+8 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...+
tests/compile-and-dump/Singletons/NegativeLiterals.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE NegativeLiterals #-} - -module Singletons.NegativeLiterals where - -import Data.Singletons.Base.TH -import Numeric.Natural (Natural) - -$(singletons [d| - f :: Natural - f = -1 - |]) +{-# LANGUAGE NegativeLiterals #-}++module Singletons.NegativeLiterals where++import Data.Singletons.Base.TH+import Numeric.Natural (Natural)++$(singletons [d|+ f :: Natural+ f = -1+ |])
tests/compile-and-dump/Singletons/Operators.golden view
@@ -1,139 +1,137 @@-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 :: Foo - type family FLeafSym0 :: Foo where - FLeafSym0 = FLeaf - type (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) - data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) - where - (::+:@#@$###) :: SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => - (:+:@#@$) a0123456789876543210 - type instance Apply (:+:@#@$) a0123456789876543210 = (:+:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:+:@#@$) where - suppressUnusedWarnings = snd ((,) (::+:@#@$###) ()) - type (:+:@#@$$) :: Foo -> (~>) Foo Foo - data (:+:@#@$$) (a0123456789876543210 :: Foo) :: (~>) Foo Foo - where - (::+:@#@$$###) :: SameKind (Apply ((:+:@#@$$) a0123456789876543210) arg) ((:+:@#@$$$) a0123456789876543210 arg) => - (:+:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:+:@#@$$) a0123456789876543210) a0123456789876543210 = (:+:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:+:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::+:@#@$$###) ()) - type (:+:@#@$$$) :: Foo -> Foo -> Foo - type family (:+:@#@$$$) (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Foo where - (:+:@#@$$$) a0123456789876543210 a0123456789876543210 = (:+:) a0123456789876543210 a0123456789876543210 - type (+@#@$) :: (~>) Nat ((~>) Nat Nat) - data (+@#@$) :: (~>) Nat ((~>) Nat Nat) - where - (:+@#@$###) :: SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (+@#@$) a0123456789876543210 - type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings = snd ((,) (:+@#@$###) ()) - type (+@#@$$) :: Nat -> (~>) Nat Nat - data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - (:+@#@$$###) :: SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => - (+@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:+@#@$$###) ()) - type (+@#@$$$) :: Nat -> Nat -> Nat - type family (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - (+@#@$$$) a0123456789876543210 a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 - type ChildSym0 :: (~>) Foo Foo - data ChildSym0 :: (~>) Foo Foo - where - ChildSym0KindInference :: SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => - ChildSym0 a0123456789876543210 - type instance Apply ChildSym0 a0123456789876543210 = Child a0123456789876543210 - instance SuppressUnusedWarnings ChildSym0 where - suppressUnusedWarnings = snd ((,) ChildSym0KindInference ()) - type ChildSym1 :: Foo -> Foo - type family ChildSym1 (a0123456789876543210 :: Foo) :: Foo where - ChildSym1 a0123456789876543210 = Child a0123456789876543210 - type (+) :: Nat -> Nat -> Nat - type family (+) (a :: Nat) (a :: Nat) :: Nat where - (+) 'Zero m = m - (+) ('Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) - type Child :: Foo -> Foo - 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) :: Type) - sChild :: - (forall (t :: Foo). - Sing t -> Sing (Apply ChildSym0 t :: Foo) :: Type) - (%+) 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 SingI1 ((+@#@$$) :: Nat -> (~>) Nat Nat) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @((+@#@$$) (d :: Nat)) ((%+) s) - instance SingI (ChildSym0 :: (~>) Foo Foo) where - sing = singFun1 @ChildSym0 sChild - data SFoo :: Foo -> Type - where - SFLeaf :: SFoo (FLeaf :: Foo) - (:%+:) :: forall (n :: Foo) (n :: Foo). - (Sing n) -> (Sing n) -> SFoo ((:+:) n n :: Foo) - type instance Sing @Foo = SFoo - 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 n => SingI1 ((:+:) (n :: Foo)) where - liftSing = (:%+:) sing - instance SingI2 (:+:) where - liftSing2 = (:%+:) - instance SingI ((:+:@#@$) :: (~>) Foo ((~>) Foo Foo)) where - sing = singFun2 @(:+:@#@$) (:%+:) - instance SingI d => - SingI ((:+:@#@$$) (d :: Foo) :: (~>) Foo Foo) where - sing = singFun1 @((:+:@#@$$) (d :: Foo)) ((:%+:) (sing @d)) - instance SingI1 ((:+:@#@$$) :: Foo -> (~>) Foo Foo) where - liftSing (s :: Sing (d :: Foo)) - = singFun1 @((:+:@#@$$) (d :: Foo)) ((:%+:) s) +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 :: Foo+ type family FLeafSym0 :: Foo where+ FLeafSym0 = FLeaf+ type (:+:@#@$) :: (~>) Foo ((~>) Foo Foo)+ data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo)+ where+ (::+:@#@$###) :: SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) =>+ (:+:@#@$) a0123456789876543210+ type instance Apply @Foo @((~>) Foo Foo) (:+:@#@$) a0123456789876543210 = (:+:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:+:@#@$) where+ suppressUnusedWarnings = snd ((,) (::+:@#@$###) ())+ type (:+:@#@$$) :: Foo -> (~>) Foo Foo+ data (:+:@#@$$) (a0123456789876543210 :: Foo) :: (~>) Foo Foo+ where+ (::+:@#@$$###) :: SameKind (Apply ((:+:@#@$$) a0123456789876543210) arg) ((:+:@#@$$$) a0123456789876543210 arg) =>+ (:+:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Foo @Foo ((:+:@#@$$) a0123456789876543210) a0123456789876543210 = (:+:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:+:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::+:@#@$$###) ())+ type (:+:@#@$$$) :: Foo -> Foo -> Foo+ type family (:+:@#@$$$) (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) :: Foo where+ (:+:@#@$$$) a0123456789876543210 a0123456789876543210 = (:+:) a0123456789876543210 a0123456789876543210+ type (+@#@$) :: (~>) Nat ((~>) Nat Nat)+ data (+@#@$) :: (~>) Nat ((~>) Nat Nat)+ where+ (:+@#@$###) :: SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>+ (+@#@$) a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (+@#@$) where+ suppressUnusedWarnings = snd ((,) (:+@#@$###) ())+ type (+@#@$$) :: Nat -> (~>) Nat Nat+ data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ (:+@#@$$###) :: SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) =>+ (+@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:+@#@$$###) ())+ type (+@#@$$$) :: Nat -> Nat -> Nat+ type family (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ (+@#@$$$) a0123456789876543210 a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210+ type ChildSym0 :: (~>) Foo Foo+ data ChildSym0 :: (~>) Foo Foo+ where+ ChildSym0KindInference :: SameKind (Apply ChildSym0 arg) (ChildSym1 arg) =>+ ChildSym0 a0123456789876543210+ type instance Apply @Foo @Foo ChildSym0 a0123456789876543210 = Child a0123456789876543210+ instance SuppressUnusedWarnings ChildSym0 where+ suppressUnusedWarnings = snd ((,) ChildSym0KindInference ())+ type ChildSym1 :: Foo -> Foo+ type family ChildSym1 (a0123456789876543210 :: Foo) :: Foo where+ ChildSym1 a0123456789876543210 = Child a0123456789876543210+ type (+) :: Nat -> Nat -> Nat+ type family (+) (a :: Nat) (a :: Nat) :: Nat where+ (+) 'Zero m = m+ (+) ('Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m)+ type Child :: Foo -> Foo+ type family Child (a :: Foo) :: Foo where+ Child FLeaf = FLeafSym0+ Child ((:+:) a _) = a+ (%+) ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing ((+) t t :: Nat) :: Type)+ sChild ::+ (forall (t :: Foo). Sing t -> Sing (Child t :: Foo) :: Type)+ (%+) 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 SingI1 ((+@#@$$) :: Nat -> (~>) Nat Nat) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @((+@#@$$) (d :: Nat)) ((%+) s)+ instance SingI (ChildSym0 :: (~>) Foo Foo) where+ sing = singFun1 @ChildSym0 sChild+ data SFoo :: Foo -> Type+ where+ SFLeaf :: SFoo (FLeaf :: Foo)+ (:%+:) :: forall (n :: Foo) (n :: Foo).+ (Sing n) -> (Sing n) -> SFoo ((:+:) n n :: Foo)+ type instance Sing @Foo = SFoo+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%+:) c c))+ (toSing b :: SomeSing Foo) (toSing b :: SomeSing Foo)+ instance SingI FLeaf where+ sing = SFLeaf+ instance (SingI n, SingI n) =>+ SingI ((:+:) (n :: Foo) (n :: Foo)) where+ sing = (:%+:) sing sing+ instance SingI n => SingI1 ((:+:) (n :: Foo)) where+ liftSing = (:%+:) sing+ instance SingI2 (:+:) where+ liftSing2 = (:%+:)+ instance SingI ((:+:@#@$) :: (~>) Foo ((~>) Foo Foo)) where+ sing = singFun2 @(:+:@#@$) (:%+:)+ instance SingI d =>+ SingI ((:+:@#@$$) (d :: Foo) :: (~>) Foo Foo) where+ sing = singFun1 @((:+:@#@$$) (d :: Foo)) ((:%+:) (sing @d))+ instance SingI1 ((:+:@#@$$) :: Foo -> (~>) Foo Foo) where+ liftSing (s :: Sing (d :: Foo))+ = singFun1 @((:+:@#@$$) (d :: Foo)) ((:%+:) s)
tests/compile-and-dump/Singletons/Operators.hs view
@@ -1,19 +1,19 @@-module Singletons.Operators where - -import Data.Singletons -import Data.Singletons.TH -import Singletons.Nat - -$(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) - |]) +module Singletons.Operators where++import Data.Singletons+import Data.Singletons.TH+import Singletons.Nat++$(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.golden view
@@ -1,1498 +1,1373 @@-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 :: Nat - type family ZeroSym0 :: Nat where - ZeroSym0 = Zero - type SuccSym0 :: (~>) Nat Nat - data SuccSym0 :: (~>) Nat Nat - where - SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => - SuccSym0 a0123456789876543210 - type instance Apply SuccSym0 a0123456789876543210 = Succ a0123456789876543210 - instance SuppressUnusedWarnings SuccSym0 where - suppressUnusedWarnings = snd ((,) SuccSym0KindInference ()) - type SuccSym1 :: Nat -> Nat - type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where - SuccSym1 a0123456789876543210 = Succ a0123456789876543210 - type ASym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - ASym0KindInference :: SameKind (Apply ASym0 arg) (ASym1 arg) => - ASym0 a0123456789876543210 - type instance Apply ASym0 a0123456789876543210 = ASym1 a0123456789876543210 - instance SuppressUnusedWarnings ASym0 where - suppressUnusedWarnings = snd ((,) ASym0KindInference ()) - type ASym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data ASym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - ASym1KindInference :: SameKind (Apply (ASym1 a0123456789876543210) arg) (ASym2 a0123456789876543210 arg) => - ASym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ASym1 a0123456789876543210) a0123456789876543210 = ASym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ASym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ASym1KindInference ()) - type ASym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data ASym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - ASym2KindInference :: SameKind (Apply (ASym2 a0123456789876543210 a0123456789876543210) arg) (ASym3 a0123456789876543210 a0123456789876543210 arg) => - ASym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ASym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ASym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ASym2KindInference ()) - type ASym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data ASym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - ASym3KindInference :: SameKind (Apply (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (ASym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = A a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ASym3KindInference ()) - type ASym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family ASym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - ASym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = A a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type BSym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - BSym0KindInference :: SameKind (Apply BSym0 arg) (BSym1 arg) => - BSym0 a0123456789876543210 - type instance Apply BSym0 a0123456789876543210 = BSym1 a0123456789876543210 - instance SuppressUnusedWarnings BSym0 where - suppressUnusedWarnings = snd ((,) BSym0KindInference ()) - type BSym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data BSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - BSym1KindInference :: SameKind (Apply (BSym1 a0123456789876543210) arg) (BSym2 a0123456789876543210 arg) => - BSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BSym1 a0123456789876543210) a0123456789876543210 = BSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BSym1KindInference ()) - type BSym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data BSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - BSym2KindInference :: SameKind (Apply (BSym2 a0123456789876543210 a0123456789876543210) arg) (BSym3 a0123456789876543210 a0123456789876543210 arg) => - BSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BSym2KindInference ()) - type BSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data BSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - BSym3KindInference :: SameKind (Apply (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = B a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BSym3KindInference ()) - type BSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family BSym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - BSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = B a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type CSym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - CSym0KindInference :: SameKind (Apply CSym0 arg) (CSym1 arg) => - CSym0 a0123456789876543210 - type instance Apply CSym0 a0123456789876543210 = CSym1 a0123456789876543210 - instance SuppressUnusedWarnings CSym0 where - suppressUnusedWarnings = snd ((,) CSym0KindInference ()) - type CSym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data CSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - CSym1KindInference :: SameKind (Apply (CSym1 a0123456789876543210) arg) (CSym2 a0123456789876543210 arg) => - CSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (CSym1 a0123456789876543210) a0123456789876543210 = CSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (CSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) CSym1KindInference ()) - type CSym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data CSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - CSym2KindInference :: SameKind (Apply (CSym2 a0123456789876543210 a0123456789876543210) arg) (CSym3 a0123456789876543210 a0123456789876543210 arg) => - CSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (CSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (CSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) CSym2KindInference ()) - type CSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data CSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - CSym3KindInference :: SameKind (Apply (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (CSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = C a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) CSym3KindInference ()) - type CSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family CSym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - CSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = C a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type DSym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - DSym0KindInference :: SameKind (Apply DSym0 arg) (DSym1 arg) => - DSym0 a0123456789876543210 - type instance Apply DSym0 a0123456789876543210 = DSym1 a0123456789876543210 - instance SuppressUnusedWarnings DSym0 where - suppressUnusedWarnings = snd ((,) DSym0KindInference ()) - type DSym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data DSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - DSym1KindInference :: SameKind (Apply (DSym1 a0123456789876543210) arg) (DSym2 a0123456789876543210 arg) => - DSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (DSym1 a0123456789876543210) a0123456789876543210 = DSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (DSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) DSym1KindInference ()) - type DSym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data DSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - DSym2KindInference :: SameKind (Apply (DSym2 a0123456789876543210 a0123456789876543210) arg) (DSym3 a0123456789876543210 a0123456789876543210 arg) => - DSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (DSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (DSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) DSym2KindInference ()) - type DSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data DSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - DSym3KindInference :: SameKind (Apply (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (DSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = D a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) DSym3KindInference ()) - type DSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family DSym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - DSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = D a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type ESym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - ESym0KindInference :: SameKind (Apply ESym0 arg) (ESym1 arg) => - ESym0 a0123456789876543210 - type instance Apply ESym0 a0123456789876543210 = ESym1 a0123456789876543210 - instance SuppressUnusedWarnings ESym0 where - suppressUnusedWarnings = snd ((,) ESym0KindInference ()) - type ESym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data ESym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - ESym1KindInference :: SameKind (Apply (ESym1 a0123456789876543210) arg) (ESym2 a0123456789876543210 arg) => - ESym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ESym1 a0123456789876543210) a0123456789876543210 = ESym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ESym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ESym1KindInference ()) - type ESym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data ESym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - ESym2KindInference :: SameKind (Apply (ESym2 a0123456789876543210 a0123456789876543210) arg) (ESym3 a0123456789876543210 a0123456789876543210 arg) => - ESym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ESym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ESym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ESym2KindInference ()) - type ESym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data ESym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - ESym3KindInference :: SameKind (Apply (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (ESym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = E a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ESym3KindInference ()) - type ESym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family ESym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - ESym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = E a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type FSym0 :: forall a - b - c - d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - data FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d)))) - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: forall a b c d. a - -> (~>) b ((~>) c ((~>) d (Foo a b c d))) - data FSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d))) - where - FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) => - FSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FSym1 a0123456789876543210) a0123456789876543210 = FSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FSym1KindInference ()) - type FSym2 :: forall a b c d. a - -> b -> (~>) c ((~>) d (Foo a b c d)) - data FSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d)) - where - FSym2KindInference :: SameKind (Apply (FSym2 a0123456789876543210 a0123456789876543210) arg) (FSym3 a0123456789876543210 a0123456789876543210 arg) => - FSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FSym2KindInference ()) - type FSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d) - data FSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d) - where - FSym3KindInference :: SameKind (Apply (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (FSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) => - FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FSym3KindInference ()) - type FSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d - type family FSym4 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where - FSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type TFHelper_0123456789876543210 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where - TFHelper_0123456789876543210 Zero Zero = TrueSym0 - TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0 - TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0 - TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Nat -> (~>) Nat Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Nat -> Nat -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Nat where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where - Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - Compare_0123456789876543210 Zero (Succ _) = LTSym0 - Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Nat -> (~>) Nat Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Nat -> Nat -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Nat where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type TFHelper_0123456789876543210 :: Foo a b c d - -> Foo a b c d -> Bool - type family TFHelper_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Bool where - TFHelper_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - TFHelper_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - TFHelper_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - TFHelper_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - TFHelper_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - TFHelper_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = FalseSym0 - TFHelper_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210))) - type TFHelper_0123456789876543210Sym0 :: (~>) (Foo a b c d) ((~>) (Foo a b c d) Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) (Foo a b c d) ((~>) (Foo a b c d) Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Foo a b c d - -> (~>) (Foo a b c d) Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo a b c d) :: (~>) (Foo a b c d) Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Foo a b c d - -> Foo a b c d -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo a b c d) (a0123456789876543210 :: Foo a b c d) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq (Foo a b c d) where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Foo a b c d - -> Foo a b c d -> Ordering - 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 (<>@#@$)) 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)) NilSym0)))) - Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0)))) - Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0)))) - Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0)))) - Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0)))) - Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0)))) - 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_0123456789876543210Sym0 :: (~>) (Foo a b c d) ((~>) (Foo a b c d) Ordering) - data Compare_0123456789876543210Sym0 :: (~>) (Foo a b c d) ((~>) (Foo a b c d) Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Foo a b c d - -> (~>) (Foo a b c d) Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a b c d) :: (~>) (Foo a b c d) Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Foo a b c d - -> Foo a b c d -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a b c d) (a0123456789876543210 :: Foo a b c d) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd (Foo a b c d) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - data SNat :: Nat -> Type - where - SZero :: SNat (Zero :: Nat) - SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat) - type instance Sing @Nat = SNat - 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 SFoo :: forall a b c d. Foo a b c d -> Type - where - SA :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (A n n n n :: Foo a b c d) - SB :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (B n n n n :: Foo a b c d) - SC :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (C n n n n :: Foo a b c d) - SD :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (D n n n n :: Foo a b c d) - SE :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (E n n n n :: Foo a b c d) - SF :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). - (Sing n) -> - (Sing n) -> - (Sing n) -> - (Sing n) -> - SFoo (F n n n n :: Foo a b c d) - type instance Sing @(Foo a b c d) = SFoo - 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 SEq Nat => SEq Nat where - (%==) :: - forall (t1 :: Nat) (t2 :: Nat). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Nat ((~>) Nat Bool) - -> Type) t1) t2) - (%==) SZero SZero = STrue - (%==) SZero (SSucc _) = SFalse - (%==) (SSucc _) SZero = SFalse - (%==) - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_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) - -> Type) t1) t2) - sCompare SZero SZero - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare - (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - 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 a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where - (%==) :: - forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun (Foo a b c d) ((~>) (Foo a b c d) Bool) - -> Type) t1) t2) - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse - (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse - (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse - (%==) - (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 - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210))) - 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) - -> 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 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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 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 SDecide Nat => - Data.Type.Equality.TestEquality (SNat :: Nat -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide Nat => - Data.Type.Coercion.TestCoercion (SNat :: Nat -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - 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 (SDecide a, SDecide b, SDecide c, SDecide d) => - Data.Type.Equality.TestEquality (SFoo :: Foo a b c d -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance (SDecide a, SDecide b, SDecide c, SDecide d) => - Data.Type.Coercion.TestCoercion (SFoo :: Foo a b c d -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - instance SingI Zero where - sing = SZero - instance SingI n => SingI (Succ (n :: Nat)) where - sing = SSucc sing - instance SingI1 Succ where - liftSing = SSucc - instance SingI (SuccSym0 :: (~>) Nat Nat) where - sing = singFun1 @SuccSym0 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 n, SingI n, SingI n) => - SingI1 (A (n :: a) (n :: b) (n :: c)) where - liftSing = SA sing sing sing - instance (SingI n, SingI n) => SingI2 (A (n :: a) (n :: b)) where - liftSing2 = SA sing sing - instance SingI (ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @ASym0 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 SingI1 (ASym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(ASym1 (d :: a)) (SA s) - 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 => - SingI1 (ASym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(ASym2 (d :: a) (d :: b)) (SA (sing @d) s) - instance SingI2 (ASym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(ASym2 (d :: a) (d :: b)) (SA s s) - 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) => - SingI1 (ASym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(ASym3 (d :: a) (d :: b) (d :: c)) (SA (sing @d) (sing @d) s) - instance SingI d => - SingI2 (ASym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(ASym3 (d :: a) (d :: b) (d :: c)) (SA (sing @d) s s) - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = SB sing sing sing sing - instance (SingI n, SingI n, SingI n) => - SingI1 (B (n :: a) (n :: b) (n :: c)) where - liftSing = SB sing sing sing - instance (SingI n, SingI n) => SingI2 (B (n :: a) (n :: b)) where - liftSing2 = SB sing sing - instance SingI (BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @BSym0 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 SingI1 (BSym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(BSym1 (d :: a)) (SB s) - 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 => - SingI1 (BSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(BSym2 (d :: a) (d :: b)) (SB (sing @d) s) - instance SingI2 (BSym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(BSym2 (d :: a) (d :: b)) (SB s s) - 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) => - SingI1 (BSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(BSym3 (d :: a) (d :: b) (d :: c)) (SB (sing @d) (sing @d) s) - instance SingI d => - SingI2 (BSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(BSym3 (d :: a) (d :: b) (d :: c)) (SB (sing @d) s s) - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = SC sing sing sing sing - instance (SingI n, SingI n, SingI n) => - SingI1 (C (n :: a) (n :: b) (n :: c)) where - liftSing = SC sing sing sing - instance (SingI n, SingI n) => SingI2 (C (n :: a) (n :: b)) where - liftSing2 = SC sing sing - instance SingI (CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @CSym0 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 SingI1 (CSym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(CSym1 (d :: a)) (SC s) - 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 => - SingI1 (CSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(CSym2 (d :: a) (d :: b)) (SC (sing @d) s) - instance SingI2 (CSym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(CSym2 (d :: a) (d :: b)) (SC s s) - 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) => - SingI1 (CSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(CSym3 (d :: a) (d :: b) (d :: c)) (SC (sing @d) (sing @d) s) - instance SingI d => - SingI2 (CSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(CSym3 (d :: a) (d :: b) (d :: c)) (SC (sing @d) s s) - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = SD sing sing sing sing - instance (SingI n, SingI n, SingI n) => - SingI1 (D (n :: a) (n :: b) (n :: c)) where - liftSing = SD sing sing sing - instance (SingI n, SingI n) => SingI2 (D (n :: a) (n :: b)) where - liftSing2 = SD sing sing - instance SingI (DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @DSym0 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 SingI1 (DSym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(DSym1 (d :: a)) (SD s) - 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 => - SingI1 (DSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(DSym2 (d :: a) (d :: b)) (SD (sing @d) s) - instance SingI2 (DSym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(DSym2 (d :: a) (d :: b)) (SD s s) - 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) => - SingI1 (DSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(DSym3 (d :: a) (d :: b) (d :: c)) (SD (sing @d) (sing @d) s) - instance SingI d => - SingI2 (DSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(DSym3 (d :: a) (d :: b) (d :: c)) (SD (sing @d) s s) - instance (SingI n, SingI n, SingI n, SingI n) => - SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where - sing = SE sing sing sing sing - instance (SingI n, SingI n, SingI n) => - SingI1 (E (n :: a) (n :: b) (n :: c)) where - liftSing = SE sing sing sing - instance (SingI n, SingI n) => SingI2 (E (n :: a) (n :: b)) where - liftSing2 = SE sing sing - instance SingI (ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @ESym0 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 SingI1 (ESym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(ESym1 (d :: a)) (SE s) - 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 => - SingI1 (ESym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(ESym2 (d :: a) (d :: b)) (SE (sing @d) s) - instance SingI2 (ESym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(ESym2 (d :: a) (d :: b)) (SE s s) - 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) => - SingI1 (ESym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(ESym3 (d :: a) (d :: b) (d :: c)) (SE (sing @d) (sing @d) s) - instance SingI d => - SingI2 (ESym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(ESym3 (d :: a) (d :: b) (d :: c)) (SE (sing @d) s s) - 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 n, SingI n, SingI n) => - SingI1 (F (n :: a) (n :: b) (n :: c)) where - liftSing = SF sing sing sing - instance (SingI n, SingI n) => SingI2 (F (n :: a) (n :: b)) where - liftSing2 = SF sing sing - instance SingI (FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where - sing = singFun4 @FSym0 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 SingI1 (FSym1 :: a - -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where - liftSing (s :: Sing (d :: a)) = singFun3 @(FSym1 (d :: a)) (SF s) - 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 => - SingI1 (FSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing (s :: Sing (d :: b)) - = singFun2 @(FSym2 (d :: a) (d :: b)) (SF (sing @d) s) - instance SingI2 (FSym2 :: a - -> b -> (~>) c ((~>) d (Foo a b c d))) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun2 @(FSym2 (d :: a) (d :: b)) (SF s s) - 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) => - SingI1 (FSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where - liftSing (s :: Sing (d :: c)) - = singFun1 - @(FSym3 (d :: a) (d :: b) (d :: c)) (SF (sing @d) (sing @d) s) - instance SingI d => - SingI2 (FSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where - liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c)) - = singFun1 @(FSym3 (d :: a) (d :: b) (d :: c)) (SF (sing @d) s s) +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 :: Nat+ type family ZeroSym0 :: Nat where+ ZeroSym0 = Zero+ type SuccSym0 :: (~>) Nat Nat+ data SuccSym0 :: (~>) Nat Nat+ where+ SuccSym0KindInference :: SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>+ SuccSym0 a0123456789876543210+ type instance Apply @Nat @Nat SuccSym0 a0123456789876543210 = Succ a0123456789876543210+ instance SuppressUnusedWarnings SuccSym0 where+ suppressUnusedWarnings = snd ((,) SuccSym0KindInference ())+ type SuccSym1 :: Nat -> Nat+ type family SuccSym1 (a0123456789876543210 :: Nat) :: Nat where+ SuccSym1 a0123456789876543210 = Succ a0123456789876543210+ type ASym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ ASym0KindInference :: SameKind (Apply ASym0 arg) (ASym1 arg) =>+ ASym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) ASym0 a0123456789876543210 = ASym1 a0123456789876543210+ instance SuppressUnusedWarnings ASym0 where+ suppressUnusedWarnings = snd ((,) ASym0KindInference ())+ type ASym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data ASym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ ASym1KindInference :: SameKind (Apply (ASym1 a0123456789876543210) arg) (ASym2 a0123456789876543210 arg) =>+ ASym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (ASym1 a0123456789876543210) a0123456789876543210 = ASym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ASym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ASym1KindInference ())+ type ASym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data ASym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ ASym2KindInference :: SameKind (Apply (ASym2 a0123456789876543210 a0123456789876543210) arg) (ASym3 a0123456789876543210 a0123456789876543210 arg) =>+ ASym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (ASym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ASym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ASym2KindInference ())+ type ASym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data ASym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ ASym3KindInference :: SameKind (Apply (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (ASym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = A a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ASym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ASym3KindInference ())+ type ASym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family ASym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ ASym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = A a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type BSym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ BSym0KindInference :: SameKind (Apply BSym0 arg) (BSym1 arg) =>+ BSym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) BSym0 a0123456789876543210 = BSym1 a0123456789876543210+ instance SuppressUnusedWarnings BSym0 where+ suppressUnusedWarnings = snd ((,) BSym0KindInference ())+ type BSym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data BSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ BSym1KindInference :: SameKind (Apply (BSym1 a0123456789876543210) arg) (BSym2 a0123456789876543210 arg) =>+ BSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (BSym1 a0123456789876543210) a0123456789876543210 = BSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BSym1KindInference ())+ type BSym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data BSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ BSym2KindInference :: SameKind (Apply (BSym2 a0123456789876543210 a0123456789876543210) arg) (BSym3 a0123456789876543210 a0123456789876543210 arg) =>+ BSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (BSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BSym2KindInference ())+ type BSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data BSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ BSym3KindInference :: SameKind (Apply (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (BSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = B a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BSym3KindInference ())+ type BSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family BSym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ BSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = B a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type CSym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ CSym0KindInference :: SameKind (Apply CSym0 arg) (CSym1 arg) =>+ CSym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) CSym0 a0123456789876543210 = CSym1 a0123456789876543210+ instance SuppressUnusedWarnings CSym0 where+ suppressUnusedWarnings = snd ((,) CSym0KindInference ())+ type CSym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data CSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ CSym1KindInference :: SameKind (Apply (CSym1 a0123456789876543210) arg) (CSym2 a0123456789876543210 arg) =>+ CSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (CSym1 a0123456789876543210) a0123456789876543210 = CSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (CSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) CSym1KindInference ())+ type CSym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data CSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ CSym2KindInference :: SameKind (Apply (CSym2 a0123456789876543210 a0123456789876543210) arg) (CSym3 a0123456789876543210 a0123456789876543210 arg) =>+ CSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (CSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (CSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) CSym2KindInference ())+ type CSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data CSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ CSym3KindInference :: SameKind (Apply (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (CSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = C a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (CSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) CSym3KindInference ())+ type CSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family CSym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ CSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = C a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type DSym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ DSym0KindInference :: SameKind (Apply DSym0 arg) (DSym1 arg) =>+ DSym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) DSym0 a0123456789876543210 = DSym1 a0123456789876543210+ instance SuppressUnusedWarnings DSym0 where+ suppressUnusedWarnings = snd ((,) DSym0KindInference ())+ type DSym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data DSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ DSym1KindInference :: SameKind (Apply (DSym1 a0123456789876543210) arg) (DSym2 a0123456789876543210 arg) =>+ DSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (DSym1 a0123456789876543210) a0123456789876543210 = DSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (DSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) DSym1KindInference ())+ type DSym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data DSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ DSym2KindInference :: SameKind (Apply (DSym2 a0123456789876543210 a0123456789876543210) arg) (DSym3 a0123456789876543210 a0123456789876543210 arg) =>+ DSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (DSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (DSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) DSym2KindInference ())+ type DSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data DSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ DSym3KindInference :: SameKind (Apply (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (DSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = D a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (DSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) DSym3KindInference ())+ type DSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family DSym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ DSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = D a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type ESym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ ESym0KindInference :: SameKind (Apply ESym0 arg) (ESym1 arg) =>+ ESym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) ESym0 a0123456789876543210 = ESym1 a0123456789876543210+ instance SuppressUnusedWarnings ESym0 where+ suppressUnusedWarnings = snd ((,) ESym0KindInference ())+ type ESym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data ESym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ ESym1KindInference :: SameKind (Apply (ESym1 a0123456789876543210) arg) (ESym2 a0123456789876543210 arg) =>+ ESym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (ESym1 a0123456789876543210) a0123456789876543210 = ESym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ESym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ESym1KindInference ())+ type ESym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data ESym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ ESym2KindInference :: SameKind (Apply (ESym2 a0123456789876543210 a0123456789876543210) arg) (ESym3 a0123456789876543210 a0123456789876543210 arg) =>+ ESym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (ESym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ESym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ESym2KindInference ())+ type ESym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data ESym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ ESym3KindInference :: SameKind (Apply (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (ESym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = E a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ESym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ESym3KindInference ())+ type ESym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family ESym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ ESym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = E a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type FSym0 :: forall a+ b+ c+ d. (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ data FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) c ((~>) d (Foo a b c d)))) FSym0 a0123456789876543210 = FSym1 a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: forall a b c d. a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))+ data FSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))+ where+ FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) =>+ FSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) c ((~>) d (Foo a b c d))) (FSym1 a0123456789876543210) a0123456789876543210 = FSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FSym1KindInference ())+ type FSym2 :: forall a b c d. a+ -> b -> (~>) c ((~>) d (Foo a b c d))+ data FSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) c ((~>) d (Foo a b c d))+ where+ FSym2KindInference :: SameKind (Apply (FSym2 a0123456789876543210 a0123456789876543210) arg) (FSym3 a0123456789876543210 a0123456789876543210 arg) =>+ FSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @c @((~>) d (Foo a b c d)) (FSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FSym2KindInference ())+ type FSym3 :: forall a b c d. a -> b -> c -> (~>) d (Foo a b c d)+ data FSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) :: (~>) d (Foo a b c d)+ where+ FSym3KindInference :: SameKind (Apply (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) arg) (FSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 arg) =>+ FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @d @(Foo a b c d) (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FSym3KindInference ())+ type FSym4 :: forall a b c d. a -> b -> c -> d -> Foo a b c d+ type family FSym4 @a @b @c @d (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: c) (a0123456789876543210 :: d) :: Foo a b c d where+ FSym4 a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type TFHelper_0123456789876543210 :: Nat -> Nat -> Bool+ type family TFHelper_0123456789876543210 (a :: Nat) (a :: Nat) :: Bool where+ TFHelper_0123456789876543210 Zero Zero = TrueSym0+ TFHelper_0123456789876543210 Zero (Succ _) = FalseSym0+ TFHelper_0123456789876543210 (Succ _) Zero = FalseSym0+ TFHelper_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq Nat where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: Nat -> Nat -> Ordering+ type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where+ Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ Compare_0123456789876543210 Zero (Succ _) = LTSym0+ Compare_0123456789876543210 (Succ _) Zero = GTSym0+ instance POrd Nat where+ type Compare a a = Compare_0123456789876543210 a a+ type TFHelper_0123456789876543210 :: forall a b c d. Foo a b c d+ -> Foo a b c d -> Bool+ type family TFHelper_0123456789876543210 @a @b @c @d (a :: Foo a b c d) (a :: Foo a b c d) :: Bool where+ TFHelper_0123456789876543210 @a @b @c @d (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ TFHelper_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ TFHelper_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ TFHelper_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ TFHelper_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ TFHelper_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = FalseSym0+ TFHelper_0123456789876543210 @a @b @c @d (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)))+ instance PEq (Foo a b c d) where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: forall a b c d. Foo a b c d+ -> Foo a b c d -> Ordering+ type family Compare_0123456789876543210 @a @b @c @d (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where+ Compare_0123456789876543210 @a @b @c @d (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 :: Foo a b c d) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 :: Foo a b c d) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) 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)) NilSym0))))+ Compare_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (A _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (B _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (C _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (D _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (E _ _ _ _ :: Foo a b c d) (F _ _ _ _ :: Foo a b c d) = LTSym0+ Compare_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (A _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (B _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (C _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (D _ _ _ _ :: Foo a b c d) = GTSym0+ Compare_0123456789876543210 @a @b @c @d (F _ _ _ _ :: Foo a b c d) (E _ _ _ _ :: Foo a b c d) = GTSym0+ instance POrd (Foo a b c d) where+ type Compare a a = Compare_0123456789876543210 a a+ data SNat :: Nat -> Type+ where+ SZero :: SNat (Zero :: Nat)+ SSucc :: forall (n :: Nat). (Sing n) -> SNat (Succ n :: Nat)+ type instance Sing @Nat = SNat+ 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))+ = (\cases (SomeSing c) -> SomeSing (SSucc c))+ (toSing b :: SomeSing Nat)+ data SFoo :: forall a b c d. Foo a b c d -> Type+ where+ SA :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (A n n n n :: Foo a b c d)+ SB :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (B n n n n :: Foo a b c d)+ SC :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (C n n n n :: Foo a b c d)+ SD :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (D n n n n :: Foo a b c d)+ SE :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (E n n n n :: Foo a b c d)+ SF :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d).+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ (Sing n) ->+ SFoo (F n n n n :: Foo a b c d)+ type instance Sing @(Foo a b c d) = SFoo+ 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))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SA c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ toSing+ (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SB c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ toSing+ (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SC c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ toSing+ (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SD c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ toSing+ (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SE c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ toSing+ (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d))+ = (\cases+ (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c)+ -> SomeSing (SF c c c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ (toSing b :: SomeSing c) (toSing b :: SomeSing d)+ instance SEq Nat => SEq Nat where+ (%==) SZero SZero = STrue+ (%==) SZero (SSucc _) = SFalse+ (%==) (SSucc _) SZero = SFalse+ (%==)+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SOrd Nat => SOrd Nat where+ sCompare SZero SZero+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare+ (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ 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 a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse+ (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse+ (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse+ (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse+ (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse+ (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse+ (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse+ (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse+ (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse+ (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse+ (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse+ (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse+ (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse+ (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse+ (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse+ (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse+ (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse+ (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse+ (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse+ (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse+ (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse+ (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse+ (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse+ (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse+ (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse+ (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse+ (%==)+ (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+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)))+ instance (SOrd a, SOrd b, SOrd c, SOrd d) =>+ SOrd (Foo a b c d) where+ 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 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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 SDecide Nat => SDecide Nat where+ (%~) SZero SZero = Proved Refl+ (%~) SZero (SSucc _) = Disproved (\case)+ (%~) (SSucc _) SZero = Disproved (\case)+ (%~) (SSucc a) (SSucc b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SNat (z :: Nat)) where+ (==) _ _ = True+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Equality.TestEquality (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide Nat =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SNat :: Nat+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ 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)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\case)+ (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\case)+ (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\case)+ (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\case)+ (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\case)+ (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\case)+ (%~) (SB a a a a) (SB b b b b)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\case)+ (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\case)+ (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\case)+ (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\case)+ (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\case)+ (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\case)+ (%~) (SC a a a a) (SC b b b b)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\case)+ (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\case)+ (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\case)+ (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\case)+ (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\case)+ (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\case)+ (%~) (SD a a a a) (SD b b b b)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\case)+ (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\case)+ (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\case)+ (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\case)+ (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\case)+ (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\case)+ (%~) (SE a a a a) (SE b b b b)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\case)+ (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\case)+ (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\case)+ (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\case)+ (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\case)+ (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\case)+ (%~) (SF a a a a) (SF b b b b)+ = (\cases+ (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl)+ -> Proved Refl+ (Disproved contra) _ _ _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) _ _ -> Disproved (\cases Refl -> contra Refl)+ _ _ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ _ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b)+ instance Eq (SFoo (z :: Foo a b c d)) where+ (==) _ _ = True+ instance (SDecide a, SDecide b, SDecide c, SDecide d) =>+ GHC.Internal.Data.Type.Equality.TestEquality (SFoo :: Foo a b c d+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance (SDecide a, SDecide b, SDecide c, SDecide d) =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SFoo :: Foo a b c d+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SNat (z :: Nat)) where+ compare _ _ = EQ+ instance Ord (SFoo (z :: Foo a b c d)) where+ compare _ _ = EQ+ instance SingI Zero where+ sing = SZero+ instance SingI n => SingI (Succ (n :: Nat)) where+ sing = SSucc sing+ instance SingI1 Succ where+ liftSing = SSucc+ instance SingI (SuccSym0 :: (~>) Nat Nat) where+ sing = singFun1 @SuccSym0 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 n, SingI n, SingI n) =>+ SingI1 (A (n :: a) (n :: b) (n :: c)) where+ liftSing = SA sing sing sing+ instance (SingI n, SingI n) => SingI2 (A (n :: a) (n :: b)) where+ liftSing2 = SA sing sing+ instance SingI (ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @ASym0 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 SingI1 (ASym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(ASym1 (d :: a)) (SA s)+ 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 =>+ SingI1 (ASym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(ASym2 (d :: a) (d :: b)) (SA (sing @d) s)+ instance SingI2 (ASym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(ASym2 (d :: a) (d :: b)) (SA s s)+ 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) =>+ SingI1 (ASym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(ASym3 (d :: a) (d :: b) (d :: c)) (SA (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (ASym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(ASym3 (d :: a) (d :: b) (d :: c)) (SA (sing @d) s s)+ instance (SingI n, SingI n, SingI n, SingI n) =>+ SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where+ sing = SB sing sing sing sing+ instance (SingI n, SingI n, SingI n) =>+ SingI1 (B (n :: a) (n :: b) (n :: c)) where+ liftSing = SB sing sing sing+ instance (SingI n, SingI n) => SingI2 (B (n :: a) (n :: b)) where+ liftSing2 = SB sing sing+ instance SingI (BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @BSym0 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 SingI1 (BSym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(BSym1 (d :: a)) (SB s)+ 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 =>+ SingI1 (BSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(BSym2 (d :: a) (d :: b)) (SB (sing @d) s)+ instance SingI2 (BSym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(BSym2 (d :: a) (d :: b)) (SB s s)+ 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) =>+ SingI1 (BSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(BSym3 (d :: a) (d :: b) (d :: c)) (SB (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (BSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(BSym3 (d :: a) (d :: b) (d :: c)) (SB (sing @d) s s)+ instance (SingI n, SingI n, SingI n, SingI n) =>+ SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where+ sing = SC sing sing sing sing+ instance (SingI n, SingI n, SingI n) =>+ SingI1 (C (n :: a) (n :: b) (n :: c)) where+ liftSing = SC sing sing sing+ instance (SingI n, SingI n) => SingI2 (C (n :: a) (n :: b)) where+ liftSing2 = SC sing sing+ instance SingI (CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @CSym0 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 SingI1 (CSym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(CSym1 (d :: a)) (SC s)+ 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 =>+ SingI1 (CSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(CSym2 (d :: a) (d :: b)) (SC (sing @d) s)+ instance SingI2 (CSym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(CSym2 (d :: a) (d :: b)) (SC s s)+ 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) =>+ SingI1 (CSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(CSym3 (d :: a) (d :: b) (d :: c)) (SC (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (CSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(CSym3 (d :: a) (d :: b) (d :: c)) (SC (sing @d) s s)+ instance (SingI n, SingI n, SingI n, SingI n) =>+ SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where+ sing = SD sing sing sing sing+ instance (SingI n, SingI n, SingI n) =>+ SingI1 (D (n :: a) (n :: b) (n :: c)) where+ liftSing = SD sing sing sing+ instance (SingI n, SingI n) => SingI2 (D (n :: a) (n :: b)) where+ liftSing2 = SD sing sing+ instance SingI (DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @DSym0 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 SingI1 (DSym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(DSym1 (d :: a)) (SD s)+ 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 =>+ SingI1 (DSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(DSym2 (d :: a) (d :: b)) (SD (sing @d) s)+ instance SingI2 (DSym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(DSym2 (d :: a) (d :: b)) (SD s s)+ 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) =>+ SingI1 (DSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(DSym3 (d :: a) (d :: b) (d :: c)) (SD (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (DSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(DSym3 (d :: a) (d :: b) (d :: c)) (SD (sing @d) s s)+ instance (SingI n, SingI n, SingI n, SingI n) =>+ SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where+ sing = SE sing sing sing sing+ instance (SingI n, SingI n, SingI n) =>+ SingI1 (E (n :: a) (n :: b) (n :: c)) where+ liftSing = SE sing sing sing+ instance (SingI n, SingI n) => SingI2 (E (n :: a) (n :: b)) where+ liftSing2 = SE sing sing+ instance SingI (ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @ESym0 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 SingI1 (ESym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(ESym1 (d :: a)) (SE s)+ 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 =>+ SingI1 (ESym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(ESym2 (d :: a) (d :: b)) (SE (sing @d) s)+ instance SingI2 (ESym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(ESym2 (d :: a) (d :: b)) (SE s s)+ 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) =>+ SingI1 (ESym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(ESym3 (d :: a) (d :: b) (d :: c)) (SE (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (ESym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(ESym3 (d :: a) (d :: b) (d :: c)) (SE (sing @d) s s)+ 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 n, SingI n, SingI n) =>+ SingI1 (F (n :: a) (n :: b) (n :: c)) where+ liftSing = SF sing sing sing+ instance (SingI n, SingI n) => SingI2 (F (n :: a) (n :: b)) where+ liftSing2 = SF sing sing+ instance SingI (FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where+ sing = singFun4 @FSym0 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 SingI1 (FSym1 :: a+ -> (~>) b ((~>) c ((~>) d (Foo a b c d)))) where+ liftSing (s :: Sing (d :: a)) = singFun3 @(FSym1 (d :: a)) (SF s)+ 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 =>+ SingI1 (FSym2 (d :: a) :: b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing (s :: Sing (d :: b))+ = singFun2 @(FSym2 (d :: a) (d :: b)) (SF (sing @d) s)+ instance SingI2 (FSym2 :: a+ -> b -> (~>) c ((~>) d (Foo a b c d))) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun2 @(FSym2 (d :: a) (d :: b)) (SF s s)+ 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) =>+ SingI1 (FSym3 (d :: a) (d :: b) :: c -> (~>) d (Foo a b c d)) where+ liftSing (s :: Sing (d :: c))+ = singFun1+ @(FSym3 (d :: a) (d :: b) (d :: c)) (SF (sing @d) (sing @d) s)+ instance SingI d =>+ SingI2 (FSym3 (d :: a) :: b -> c -> (~>) d (Foo a b c d)) where+ liftSing2 (s :: Sing (d :: b)) (s :: Sing (d :: c))+ = singFun1 @(FSym3 (d :: a) (d :: b) (d :: c)) (SF (sing @d) s s)
tests/compile-and-dump/Singletons/OrdDeriving.hs view
@@ -1,57 +1,57 @@-module Singletons.OrdDeriving where - -import Data.Singletons.Base.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 +module Singletons.OrdDeriving where++import Data.Singletons.Base.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.golden view
@@ -1,41 +1,40 @@-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 FooSym0 :: Symbol - type family FooSym0 :: Symbol where - FooSym0 = Foo - type SymIdSym0 :: (~>) Symbol Symbol - data SymIdSym0 :: (~>) Symbol Symbol - where - SymIdSym0KindInference :: SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => - SymIdSym0 a0123456789876543210 - type instance Apply SymIdSym0 a0123456789876543210 = SymId a0123456789876543210 - instance SuppressUnusedWarnings SymIdSym0 where - suppressUnusedWarnings = snd ((,) SymIdSym0KindInference ()) - type SymIdSym1 :: Symbol -> Symbol - type family SymIdSym1 (a0123456789876543210 :: Symbol) :: Symbol where - SymIdSym1 a0123456789876543210 = SymId a0123456789876543210 - type Foo :: Symbol - type family Foo :: Symbol where - Foo = Apply SymIdSym0 (FromString "foo") - type SymId :: Symbol -> Symbol - type family SymId (a :: Symbol) :: Symbol where - SymId x = x - sFoo :: (Sing (FooSym0 :: Symbol) :: Type) - sSymId :: - (forall (t :: Symbol). - Sing t -> Sing (Apply SymIdSym0 t :: Symbol) :: Type) - sFoo - = applySing - (singFun1 @SymIdSym0 sSymId) (sFromString (sing :: Sing "foo")) - sSymId (sX :: Sing x) = sX - instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where - sing = singFun1 @SymIdSym0 sSymId +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 FooSym0 :: Symbol+ type family FooSym0 :: Symbol where+ FooSym0 = Foo+ type SymIdSym0 :: (~>) Symbol Symbol+ data SymIdSym0 :: (~>) Symbol Symbol+ where+ SymIdSym0KindInference :: SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) =>+ SymIdSym0 a0123456789876543210+ type instance Apply @Symbol @Symbol SymIdSym0 a0123456789876543210 = SymId a0123456789876543210+ instance SuppressUnusedWarnings SymIdSym0 where+ suppressUnusedWarnings = snd ((,) SymIdSym0KindInference ())+ type SymIdSym1 :: Symbol -> Symbol+ type family SymIdSym1 (a0123456789876543210 :: Symbol) :: Symbol where+ SymIdSym1 a0123456789876543210 = SymId a0123456789876543210+ type Foo :: Symbol+ type family Foo :: Symbol where+ Foo = Apply SymIdSym0 (FromString "foo")+ type SymId :: Symbol -> Symbol+ type family SymId (a :: Symbol) :: Symbol where+ SymId x = x+ sFoo :: (Sing (Foo :: Symbol) :: Type)+ sSymId ::+ (forall (t :: Symbol). Sing t -> Sing (SymId t :: Symbol) :: Type)+ sFoo+ = applySing+ (singFun1 @SymIdSym0 sSymId) (sFromString (sing :: Sing "foo"))+ sSymId (sX :: Sing x) = sX+ instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where+ sing = singFun1 @SymIdSym0 sSymId
tests/compile-and-dump/Singletons/OverloadedStrings.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE OverloadedStrings #-} - -module OverloadedStrings where - -import Data.Singletons.Base.TH -import GHC.TypeLits.Singletons - -$(singletons - [d| symId :: Symbol -> Symbol - symId x = x - - foo :: Symbol - foo = symId "foo" - |]) +{-# LANGUAGE OverloadedStrings #-}++module OverloadedStrings where++import Data.Singletons.Base.TH+import GHC.TypeLits.Singletons++$(singletons+ [d| symId :: Symbol -> Symbol+ symId x = x++ foo :: Symbol+ foo = symId "foo"+ |])
tests/compile-and-dump/Singletons/PatternMatching.golden view
@@ -1,600 +1,626 @@-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 PairSym0 :: forall a b. (~>) a ((~>) b (Pair a b)) - data PairSym0 :: (~>) a ((~>) b (Pair a b)) - where - PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 a0123456789876543210 - type instance Apply PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd ((,) PairSym0KindInference ()) - type PairSym1 :: forall a b. a -> (~>) b (Pair a b) - data PairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b) - where - PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) => - PairSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) PairSym1KindInference ()) - type PairSym2 :: forall a b. a -> b -> Pair a b - type family PairSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where - PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210 - type family AListSym0 where - AListSym0 = AList - type family TupleSym0 where - TupleSym0 = Tuple - type family ComplexSym0 where - ComplexSym0 = Complex - type family PrSym0 where - PrSym0 = Pr - type family AList where - AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) NilSym0)) - 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) NilSym0) - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Pair a b -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (Pair a b) ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (Pair a b) ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Pair a b -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Pair a b) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Pair a b -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Pair a b) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 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 SPair :: forall a b. Pair a b -> Type - where - SPair :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair a b) - type instance Sing @(Pair a b) = SPair - 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.Num.Natural.Natural) - (t2 :: Pair a b) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (Pair a b) ((~>) Symbol Symbol)) - -> 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 (SPair (z :: Pair a b)) - instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where - sing = SPair sing sing - instance SingI n => SingI1 (Pair (n :: a)) where - liftSing = SPair sing - instance SingI2 Pair where - liftSing2 = SPair - instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where - sing = singFun2 @PairSym0 SPair - instance SingI d => - SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where - sing = singFun1 @(PairSym1 (d :: a)) (SPair (sing @d)) - instance SingI1 (PairSym1 :: a -> (~>) b (Pair a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(PairSym1 (d :: a)) (SPair s) -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 - data Let0123456789876543210TSym0 x0123456789876543210 - where - Let0123456789876543210TSym0KindInference :: SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => - Let0123456789876543210TSym0 x0123456789876543210 - type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210TSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210TSym0KindInference ()) - data Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 - where - Let0123456789876543210TSym1KindInference :: SameKind (Apply (Let0123456789876543210TSym1 x0123456789876543210) arg) (Let0123456789876543210TSym2 x0123456789876543210 arg) => - Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 - type instance Apply (Let0123456789876543210TSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210TSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210TSym1KindInference ()) - type family Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 where - Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210 - type family Let0123456789876543210T x y where - Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y - type family Case_0123456789876543210 arg_0123456789876543210 a b x y t where - Case_0123456789876543210 arg_0123456789876543210 a b x y _ = a - type family Lambda_0123456789876543210 a b x y arg_0123456789876543210 where - Lambda_0123456789876543210 a b x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a b x y arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 a0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - data Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym4KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym4KindInference ()) - type family Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 x y t where - Case_0123456789876543210 x y '(a, - b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x) y) b - type family Case_0123456789876543210 arg_0123456789876543210 x y t where - Case_0123456789876543210 arg_0123456789876543210 x y _ = x - type family Lambda_0123456789876543210 x y arg_0123456789876543210 where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 arg_01234567898765432100123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - _, - 'Succ y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - y_0123456789876543210, - 'Succ _] = 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 SillySym0 :: (~>) a () - data SillySym0 :: (~>) a () - where - SillySym0KindInference :: SameKind (Apply SillySym0 arg) (SillySym1 arg) => - SillySym0 a0123456789876543210 - type instance Apply SillySym0 a0123456789876543210 = Silly a0123456789876543210 - instance SuppressUnusedWarnings SillySym0 where - suppressUnusedWarnings = snd ((,) SillySym0KindInference ()) - type SillySym1 :: a -> () - type family SillySym1 (a0123456789876543210 :: a) :: () where - SillySym1 a0123456789876543210 = Silly a0123456789876543210 - type Foo2Sym0 :: (~>) (a, b) a - data Foo2Sym0 :: (~>) (a, b) a - where - Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0 a0123456789876543210 - type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ()) - type Foo2Sym1 :: (a, b) -> a - type family Foo2Sym1 (a0123456789876543210 :: (a, b)) :: a where - Foo2Sym1 a0123456789876543210 = Foo2 a0123456789876543210 - type Foo1Sym0 :: (~>) (a, b) a - data Foo1Sym0 :: (~>) (a, b) a - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: (a, b) -> a - type family Foo1Sym1 (a0123456789876543210 :: (a, b)) :: a where - Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210 - type family BlimySym0 where - BlimySym0 = Blimy - type LszSym0 :: Nat - type family LszSym0 :: Nat where - LszSym0 = Lsz - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type family TtSym0 where - TtSym0 = Tt - type family TjzSym0 where - TjzSym0 = Tjz - type family TfSym0 where - TfSym0 = Tf - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type FlsSym0 :: Bool - type family FlsSym0 :: Bool where - FlsSym0 = Fls - type family ZzSym0 where - ZzSym0 = Zz - type family JzSym0 where - JzSym0 = Jz - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type family LzSym0 where - LzSym0 = Lz - type family SzSym0 where - SzSym0 = Sz - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type Silly :: a -> () - type family Silly (a :: a) :: () where - Silly x = Case_0123456789876543210 x x - type Foo2 :: (a, b) -> a - type family Foo2 (a :: (a, b)) :: a where - Foo2 '(x, - y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) - type Foo1 :: (a, b) -> a - type family Foo1 (a :: (a, b)) :: a where - Foo1 '(x, - y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Blimy where - Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 - type Lsz :: Nat - type family Lsz :: Nat where - Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = AListSym0 - type family Tt where - Tt = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tjz where - Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tf where - Tf = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = TupleSym0 - type Fls :: Bool - type family Fls :: Bool where - Fls = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Zz where - Zz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Jz where - Jz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = ComplexSym0 - type family Lz where - Lz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Sz where - Sz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = PrSym0 - sSilly :: - (forall (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) :: Type) - sFoo2 :: - (forall (t :: (a, b)). - Sing t -> Sing (Apply Foo2Sym0 t :: a) :: Type) - sFoo1 :: - (forall (t :: (a, b)). - Sing t -> Sing (Apply Foo1Sym0 t :: a) :: Type) - sBlimy :: Sing @_ BlimySym0 - sLsz :: (Sing (LszSym0 :: Nat) :: Type) - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sTt :: Sing @_ TtSym0 - sTjz :: Sing @_ TjzSym0 - sTf :: Sing @_ TfSym0 - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sFls :: (Sing (FlsSym0 :: Bool) :: Type) - sZz :: Sing @_ ZzSym0 - sJz :: Sing @_ JzSym0 - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sLz :: Sing @_ LzSym0 - sSz :: Sing @_ SzSym0 - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sSilly (sX :: Sing x) - = id - @(Sing (Case_0123456789876543210 x x)) (case sX of _ -> STuple0) - sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) - = let - sT :: Sing @_ (Let0123456789876543210TSym2 x y) - sT = applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY - in - id - @(Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y))) - (case sT of - STuple2 (sA :: Sing a) (sB :: Sing b) - -> applySing - (singFun1 - @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x) y) - (\ sArg_0123456789876543210 - -> case sArg_0123456789876543210 of - (_ :: Sing arg_0123456789876543210) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 a b x y arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sA))) - sB) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sX))) - sY - sBlimy - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons _ - (SCons _ - (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) - SNil)) - -> sY_0123456789876543210) - sLsz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons (SSucc _) SNil)) - -> sY_0123456789876543210) - sX_0123456789876543210 = sAList - sTt - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210) - sTjz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210) - sTf - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ - -> sY_0123456789876543210) - sX_0123456789876543210 = sTuple - sFls - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SPair (SPair _ _) - (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210) - sZz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SPair (SPair _ - (sY_0123456789876543210 :: Sing y_0123456789876543210)) - _ - -> sY_0123456789876543210) - sJz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) - _) - _ - -> sY_0123456789876543210) - sX_0123456789876543210 = sComplex - sLz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210) - sSz - = id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210) - sX_0123456789876543210 = sPr - 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 +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 PairSym0 :: forall a b. (~>) a ((~>) b (Pair a b))+ data PairSym0 :: (~>) a ((~>) b (Pair a b))+ where+ PairSym0KindInference :: SameKind (Apply PairSym0 arg) (PairSym1 arg) =>+ PairSym0 a0123456789876543210+ type instance Apply @a @((~>) b (Pair a b)) PairSym0 a0123456789876543210 = PairSym1 a0123456789876543210+ instance SuppressUnusedWarnings PairSym0 where+ suppressUnusedWarnings = snd ((,) PairSym0KindInference ())+ type PairSym1 :: forall a b. a -> (~>) b (Pair a b)+ data PairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b)+ where+ PairSym1KindInference :: SameKind (Apply (PairSym1 a0123456789876543210) arg) (PairSym2 a0123456789876543210 arg) =>+ PairSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(Pair a b) (PairSym1 a0123456789876543210) a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (PairSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) PairSym1KindInference ())+ type PairSym2 :: forall a b. a -> b -> Pair a b+ type family PairSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where+ PairSym2 a0123456789876543210 a0123456789876543210 = Pair a0123456789876543210 a0123456789876543210+ type family AListSym0 where+ AListSym0 = AList+ type family TupleSym0 where+ TupleSym0 = Tuple+ type family ComplexSym0 where+ ComplexSym0 = Complex+ type family PrSym0 where+ PrSym0 = Pr+ type family AList where+ AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) NilSym0))+ 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) NilSym0)+ type ShowsPrec_0123456789876543210 :: forall a+ b. GHC.Internal.Bignum.Natural.Natural+ -> Pair a b -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 @a @b (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Pair a b) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 @a @b (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (Pair arg_0123456789876543210 arg_0123456789876543210 :: Pair a b) (a_0123456789876543210 :: Symbol) = 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+ instance PShow (Pair a b) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ sAList :: Sing @_ AList+ sTuple :: Sing @_ Tuple+ sComplex :: Sing @_ Complex+ sPr :: Sing @_ Pr+ 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 SPair :: forall a b. Pair a b -> Type+ where+ SPair :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SPair (Pair n n :: Pair a b)+ type instance Sing @(Pair a b) = SPair+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SPair c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ instance (SShow a, SShow b) => SShow (Pair a b) where+ 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 (SPair (z :: Pair a b))+ instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where+ sing = SPair sing sing+ instance SingI n => SingI1 (Pair (n :: a)) where+ liftSing = SPair sing+ instance SingI2 Pair where+ liftSing2 = SPair+ instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where+ sing = singFun2 @PairSym0 SPair+ instance SingI d =>+ SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where+ sing = singFun1 @(PairSym1 (d :: a)) (SPair (sing @d))+ instance SingI1 (PairSym1 :: a -> (~>) b (Pair a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(PairSym1 (d :: a)) (SPair s)+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 LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x _ = Tuple0Sym0+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family Let0123456789876543210TSym0 x0123456789876543210 y0123456789876543210 where+ Let0123456789876543210TSym0 x0123456789876543210 y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210+ type family Let0123456789876543210T x0123456789876543210 y0123456789876543210 where+ Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y+ type family LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 a b x y _ = a+ data LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x y '(a,+ b) = Apply (LamCases_0123456789876543210Sym0 a b x y) b+ data LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x y _ = x+ data LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '[_,+ _,+ 'Succ y_0123456789876543210] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '[_,+ y_0123456789876543210,+ 'Succ _] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '(_,+ _,+ y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '(_,+ y_0123456789876543210,+ _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '(y_0123456789876543210,+ _,+ _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Pair ('Pair _ _) y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Pair ('Pair _ y_0123456789876543210) _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Pair ('Pair y_0123456789876543210 _) _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Pair _ y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Pair y_0123456789876543210 _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type SillySym0 :: (~>) a ()+ data SillySym0 :: (~>) a ()+ where+ SillySym0KindInference :: SameKind (Apply SillySym0 arg) (SillySym1 arg) =>+ SillySym0 a0123456789876543210+ type instance Apply @a @() SillySym0 a0123456789876543210 = Silly a0123456789876543210+ instance SuppressUnusedWarnings SillySym0 where+ suppressUnusedWarnings = snd ((,) SillySym0KindInference ())+ type SillySym1 :: a -> ()+ type family SillySym1 @a (a0123456789876543210 :: a) :: () where+ SillySym1 a0123456789876543210 = Silly a0123456789876543210+ type Foo2Sym0 :: (~>) (a, b) a+ data Foo2Sym0 :: (~>) (a, b) a+ where+ Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>+ Foo2Sym0 a0123456789876543210+ type instance Apply @(a,+ b) @a Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210+ instance SuppressUnusedWarnings Foo2Sym0 where+ suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ())+ type Foo2Sym1 :: (a, b) -> a+ type family Foo2Sym1 @a @b (a0123456789876543210 :: (a,+ b)) :: a where+ Foo2Sym1 a0123456789876543210 = Foo2 a0123456789876543210+ type Foo1Sym0 :: (~>) (a, b) a+ data Foo1Sym0 :: (~>) (a, b) a+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @(a,+ b) @a Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: (a, b) -> a+ type family Foo1Sym1 @a @b (a0123456789876543210 :: (a,+ b)) :: a where+ Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210+ type family BlimySym0 where+ BlimySym0 = Blimy+ type LszSym0 :: Nat+ type family LszSym0 :: Nat where+ LszSym0 = Lsz+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type family TtSym0 where+ TtSym0 = Tt+ type family TjzSym0 where+ TjzSym0 = Tjz+ type family TfSym0 where+ TfSym0 = Tf+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type FlsSym0 :: Bool+ type family FlsSym0 :: Bool where+ FlsSym0 = Fls+ type family ZzSym0 where+ ZzSym0 = Zz+ type family JzSym0 where+ JzSym0 = Jz+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type family LzSym0 where+ LzSym0 = Lz+ type family SzSym0 where+ SzSym0 = Sz+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type Silly :: a -> ()+ type family Silly @a (a :: a) :: () where+ Silly x = Apply (LamCases_0123456789876543210Sym0 x) x+ type Foo2 :: (a, b) -> a+ type family Foo2 @a @b (a :: (a, b)) :: a where+ Foo2 '(x,+ y) = Apply (LamCases_0123456789876543210Sym0 x y) (Let0123456789876543210TSym0 x y)+ type Foo1 :: (a, b) -> a+ type family Foo1 @a @b (a :: (a, b)) :: a where+ Foo1 '(x, y) = Apply (LamCases_0123456789876543210Sym0 x y) y+ type family Blimy where+ Blimy = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type Lsz :: Nat+ type family Lsz :: Nat where+ Lsz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = AListSym0+ type family Tt where+ Tt = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family Tjz where+ Tjz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family Tf where+ Tf = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = TupleSym0+ type Fls :: Bool+ type family Fls :: Bool where+ Fls = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family Zz where+ Zz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family Jz where+ Jz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = ComplexSym0+ type family Lz where+ Lz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family Sz where+ Sz = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = PrSym0+ sSilly :: (forall (t :: a). Sing t -> Sing (Silly t :: ()) :: Type)+ sFoo2 ::+ (forall (t :: (a, b)). Sing t -> Sing (Foo2 t :: a) :: Type)+ sFoo1 ::+ (forall (t :: (a, b)). Sing t -> Sing (Foo1 t :: a) :: Type)+ sBlimy :: Sing @_ Blimy+ sLsz :: (Sing (Lsz :: Nat) :: Type)+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sTt :: Sing @_ Tt+ sTjz :: Sing @_ Tjz+ sTf :: Sing @_ Tf+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sFls :: (Sing (Fls :: Bool) :: Type)+ sZz :: Sing @_ Zz+ sJz :: Sing @_ Jz+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sLz :: Sing @_ Lz+ sSz :: Sing @_ Sz+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sSilly (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x) (\cases _ -> STuple0))+ sX+ sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y))+ = let+ sT :: Sing @_ (Let0123456789876543210T x y)+ sT = applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY+ in+ applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x y)+ (\cases+ (STuple2 (sA :: Sing a) (sB :: Sing b))+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a b x y) (\cases _ -> sA))+ sB))+ sT+ sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y))+ = applySing+ (singFun1 @(LamCases_0123456789876543210Sym0 x y) (\cases _ -> sX))+ sY+ sBlimy+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SCons _+ (SCons _+ (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210))+ SNil)))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sLsz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SCons _+ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)+ (SCons (SSucc _) SNil)))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210 = sAList+ sTt+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (STuple3 _ _+ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sTjz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210)+ _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sTf+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _+ _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210 = sTuple+ sFls+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SPair (SPair _ _)+ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sZz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SPair (SPair _+ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sJz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210)+ _)+ _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210 = sComplex+ sLz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sSz+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210 = sPr+ 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 view
@@ -1,51 +1,51 @@-{-# OPTIONS_GHC -Wno-unused-matches #-} -{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Singletons.PatternMatching where - -import Data.Singletons.TH -import Prelude.Singletons -import Singletons.Nat -import Text.Show.Singletons - -$(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 +{-# OPTIONS_GHC -Wno-unused-matches #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++module Singletons.PatternMatching where++import Data.Singletons.TH+import Prelude.Singletons+import Singletons.Nat+import Text.Show.Singletons++$(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.golden view
@@ -1,27 +1,27 @@-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 FffSym0 :: forall k (a :: k). (~>) (Proxy (a :: k)) () - data FffSym0 :: (~>) (Proxy (a :: k)) () - where - FffSym0KindInference :: SameKind (Apply FffSym0 arg) (FffSym1 arg) => - FffSym0 a0123456789876543210 - type instance Apply FffSym0 a0123456789876543210 = Fff a0123456789876543210 - instance SuppressUnusedWarnings FffSym0 where - suppressUnusedWarnings = snd ((,) FffSym0KindInference ()) - type FffSym1 :: forall k (a :: k). Proxy (a :: k) -> () - type family FffSym1 (a0123456789876543210 :: Proxy (a :: k)) :: () where - FffSym1 a0123456789876543210 = Fff a0123456789876543210 - class PCls (a :: k) where - type family Fff (arg :: Proxy (a :: k)) :: () - class SCls (a :: k) where - sFff :: - (forall (t :: Proxy (a :: k)). - Sing t -> Sing (Apply FffSym0 t :: ()) :: Type) - instance SCls a => - SingI (FffSym0 :: (~>) (Proxy (a :: k)) ()) where - sing = singFun1 @FffSym0 sFff +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 FffSym0 :: forall k (a :: k). (~>) (Proxy (a :: k)) ()+ data FffSym0 :: (~>) (Proxy (a :: k)) ()+ where+ FffSym0KindInference :: SameKind (Apply FffSym0 arg) (FffSym1 arg) =>+ FffSym0 a0123456789876543210+ type instance Apply @(Proxy (a :: k)) @() FffSym0 a0123456789876543210 = Fff a0123456789876543210+ instance SuppressUnusedWarnings FffSym0 where+ suppressUnusedWarnings = snd ((,) FffSym0KindInference ())+ type FffSym1 :: forall k (a :: k). Proxy (a :: k) -> ()+ type family FffSym1 @k @(a :: k) (a0123456789876543210 :: Proxy (a :: k)) :: () where+ FffSym1 a0123456789876543210 = Fff a0123456789876543210+ class PCls (a :: k) where+ type family Fff (arg :: Proxy (a :: k)) :: ()+ class SCls (a :: k) where+ sFff ::+ (forall (t :: Proxy (a :: k)).+ Sing t -> Sing (Fff t :: ()) :: Type)+ instance SCls a =>+ SingI (FffSym0 :: (~>) (Proxy (a :: k)) ()) where+ sing = singFun1 @FffSym0 sFff
tests/compile-and-dump/Singletons/PolyKinds.hs view
@@ -1,8 +1,8 @@-module Singletons.PolyKinds where - -import Data.Singletons.TH - -$(singletons [d| - class Cls (a :: k) where - fff :: Proxy (a :: k) -> () - |]) +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.golden view
@@ -1,15 +1,16 @@-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 :: forall k (a :: k -> Type) (b :: k). (a :: k - -> Type) (b :: k) - type family FffSym0 :: (a :: k -> Type) (b :: k) where - FffSym0 = Fff - class PCls (a :: k -> Type) where - type family Fff :: (a :: k -> Type) (b :: k) - class SCls (a :: k -> Type) where - sFff :: (Sing (FffSym0 :: (a :: k -> Type) (b :: k)) :: Type) +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 :: forall k (a :: k -> Type) (b :: k). (a :: k+ -> Type) (b :: k)+ type family FffSym0 @k @(a :: k -> Type) @(b :: k) :: (a :: k+ -> Type) (b :: k) where+ FffSym0 = Fff+ class PCls (a :: k -> Type) where+ type family Fff :: (a :: k -> Type) (b :: k)+ class SCls (a :: k -> Type) where+ sFff :: (Sing (Fff :: (a :: k -> Type) (b :: k)) :: Type)
tests/compile-and-dump/Singletons/PolyKindsApp.hs view
@@ -1,12 +1,12 @@-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 - |]) +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.golden view
@@ -1,89 +1,87 @@-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 MkRecordSym0 :: forall a. (~>) a ((~>) Bool (Record a)) - data MkRecordSym0 :: (~>) a ((~>) Bool (Record a)) - where - MkRecordSym0KindInference :: SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => - MkRecordSym0 a0123456789876543210 - type instance Apply MkRecordSym0 a0123456789876543210 = MkRecordSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkRecordSym0 where - suppressUnusedWarnings = snd ((,) MkRecordSym0KindInference ()) - type MkRecordSym1 :: forall a. a -> (~>) Bool (Record a) - data MkRecordSym1 (a0123456789876543210 :: a) :: (~>) Bool (Record a) - where - MkRecordSym1KindInference :: SameKind (Apply (MkRecordSym1 a0123456789876543210) arg) (MkRecordSym2 a0123456789876543210 arg) => - MkRecordSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkRecordSym1 a0123456789876543210) a0123456789876543210 = MkRecord a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkRecordSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkRecordSym1KindInference ()) - type MkRecordSym2 :: forall a. a -> Bool -> Record a - type family MkRecordSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Bool) :: Record a where - MkRecordSym2 a0123456789876543210 a0123456789876543210 = MkRecord a0123456789876543210 a0123456789876543210 - type Field2Sym0 :: forall a. (~>) (Record a) Bool - data Field2Sym0 :: (~>) (Record a) Bool - where - Field2Sym0KindInference :: SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => - Field2Sym0 a0123456789876543210 - type instance Apply Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210 - instance SuppressUnusedWarnings Field2Sym0 where - suppressUnusedWarnings = snd ((,) Field2Sym0KindInference ()) - type Field2Sym1 :: forall a. Record a -> Bool - type family Field2Sym1 (a0123456789876543210 :: Record a) :: Bool where - Field2Sym1 a0123456789876543210 = Field2 a0123456789876543210 - type Field1Sym0 :: forall a. (~>) (Record a) a - data Field1Sym0 :: (~>) (Record a) a - where - Field1Sym0KindInference :: SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => - Field1Sym0 a0123456789876543210 - type instance Apply Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210 - instance SuppressUnusedWarnings Field1Sym0 where - suppressUnusedWarnings = snd ((,) Field1Sym0KindInference ()) - type Field1Sym1 :: forall a. Record a -> a - type family Field1Sym1 (a0123456789876543210 :: Record a) :: a where - Field1Sym1 a0123456789876543210 = Field1 a0123456789876543210 - type Field2 :: forall a. Record a -> Bool - type family Field2 (a :: Record a) :: Bool where - Field2 (MkRecord _ field) = field - type Field1 :: forall a. Record a -> a - type family Field1 (a :: Record a) :: a where - Field1 (MkRecord field _) = field - sField2 :: - forall a (t :: Record a). Sing t - -> Sing (Apply Field2Sym0 t :: Bool) - sField1 :: - forall a (t :: Record a). Sing t -> Sing (Apply Field1Sym0 t :: a) - sField2 (SMkRecord _ (sField :: Sing field)) = sField - sField1 (SMkRecord (sField :: Sing field) _) = sField - instance SingI (Field2Sym0 :: (~>) (Record a) Bool) where - sing = singFun1 @Field2Sym0 sField2 - instance SingI (Field1Sym0 :: (~>) (Record a) a) where - sing = singFun1 @Field1Sym0 sField1 - data SRecord :: forall a. Record a -> Type - where - SMkRecord :: forall a (n :: a) (n :: Bool). - (Sing n) -> (Sing n) -> SRecord (MkRecord n n :: Record a) - type instance Sing @(Record a) = SRecord - 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 n => SingI1 (MkRecord (n :: a)) where - liftSing = SMkRecord sing - instance SingI2 MkRecord where - liftSing2 = SMkRecord - instance SingI (MkRecordSym0 :: (~>) a ((~>) Bool (Record a))) where - sing = singFun2 @MkRecordSym0 SMkRecord - instance SingI d => - SingI (MkRecordSym1 (d :: a) :: (~>) Bool (Record a)) where - sing = singFun1 @(MkRecordSym1 (d :: a)) (SMkRecord (sing @d)) - instance SingI1 (MkRecordSym1 :: a -> (~>) Bool (Record a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkRecordSym1 (d :: a)) (SMkRecord s) +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 MkRecordSym0 :: forall a. (~>) a ((~>) Bool (Record a))+ data MkRecordSym0 :: (~>) a ((~>) Bool (Record a))+ where+ MkRecordSym0KindInference :: SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) =>+ MkRecordSym0 a0123456789876543210+ type instance Apply @a @((~>) Bool (Record a)) MkRecordSym0 a0123456789876543210 = MkRecordSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkRecordSym0 where+ suppressUnusedWarnings = snd ((,) MkRecordSym0KindInference ())+ type MkRecordSym1 :: forall a. a -> (~>) Bool (Record a)+ data MkRecordSym1 (a0123456789876543210 :: a) :: (~>) Bool (Record a)+ where+ MkRecordSym1KindInference :: SameKind (Apply (MkRecordSym1 a0123456789876543210) arg) (MkRecordSym2 a0123456789876543210 arg) =>+ MkRecordSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @(Record a) (MkRecordSym1 a0123456789876543210) a0123456789876543210 = MkRecord a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkRecordSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkRecordSym1KindInference ())+ type MkRecordSym2 :: forall a. a -> Bool -> Record a+ type family MkRecordSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Bool) :: Record a where+ MkRecordSym2 a0123456789876543210 a0123456789876543210 = MkRecord a0123456789876543210 a0123456789876543210+ type Field2Sym0 :: forall a. (~>) (Record a) Bool+ data Field2Sym0 :: (~>) (Record a) Bool+ where+ Field2Sym0KindInference :: SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) =>+ Field2Sym0 a0123456789876543210+ type instance Apply @(Record a) @Bool Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210+ instance SuppressUnusedWarnings Field2Sym0 where+ suppressUnusedWarnings = snd ((,) Field2Sym0KindInference ())+ type Field2Sym1 :: forall a. Record a -> Bool+ type family Field2Sym1 @a (a0123456789876543210 :: Record a) :: Bool where+ Field2Sym1 a0123456789876543210 = Field2 a0123456789876543210+ type Field1Sym0 :: forall a. (~>) (Record a) a+ data Field1Sym0 :: (~>) (Record a) a+ where+ Field1Sym0KindInference :: SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) =>+ Field1Sym0 a0123456789876543210+ type instance Apply @(Record a) @a Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210+ instance SuppressUnusedWarnings Field1Sym0 where+ suppressUnusedWarnings = snd ((,) Field1Sym0KindInference ())+ type Field1Sym1 :: forall a. Record a -> a+ type family Field1Sym1 @a (a0123456789876543210 :: Record a) :: a where+ Field1Sym1 a0123456789876543210 = Field1 a0123456789876543210+ type Field2 :: forall a. Record a -> Bool+ type family Field2 @a (a :: Record a) :: Bool where+ Field2 @a (MkRecord _ field :: Record a) = field+ type Field1 :: forall a. Record a -> a+ type family Field1 @a (a :: Record a) :: a where+ Field1 @a (MkRecord field _ :: Record a) = field+ sField2 ::+ forall a (t :: Record a). Sing t -> Sing (Field2 t :: Bool)+ sField1 :: forall a (t :: Record a). Sing t -> Sing (Field1 t :: a)+ sField2 (SMkRecord _ (sField :: Sing field)) = sField+ sField1 (SMkRecord (sField :: Sing field) _) = sField+ instance SingI (Field2Sym0 :: (~>) (Record a) Bool) where+ sing = singFun1 @Field2Sym0 sField2+ instance SingI (Field1Sym0 :: (~>) (Record a) a) where+ sing = singFun1 @Field1Sym0 sField1+ data SRecord :: forall a. Record a -> Type+ where+ SMkRecord :: forall a (n :: a) (n :: Bool).+ (Sing n) -> (Sing n) -> SRecord (MkRecord n n :: Record a)+ type instance Sing @(Record a) = SRecord+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkRecord c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing Bool)+ instance (SingI n, SingI n) =>+ SingI (MkRecord (n :: a) (n :: Bool)) where+ sing = SMkRecord sing sing+ instance SingI n => SingI1 (MkRecord (n :: a)) where+ liftSing = SMkRecord sing+ instance SingI2 MkRecord where+ liftSing2 = SMkRecord+ instance SingI (MkRecordSym0 :: (~>) a ((~>) Bool (Record a))) where+ sing = singFun2 @MkRecordSym0 SMkRecord+ instance SingI d =>+ SingI (MkRecordSym1 (d :: a) :: (~>) Bool (Record a)) where+ sing = singFun1 @(MkRecordSym1 (d :: a)) (SMkRecord (sing @d))+ instance SingI1 (MkRecordSym1 :: a -> (~>) Bool (Record a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkRecordSym1 (d :: a)) (SMkRecord s)
tests/compile-and-dump/Singletons/Records.hs view
@@ -1,28 +1,28 @@-module Singletons.Records where - -import Data.Singletons.TH -import Prelude.Singletons - -$(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 +module Singletons.Records where++import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,109 +1,105 @@-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 IdFooSym0 :: (~>) c ((~>) a a) - data IdFooSym0 :: (~>) c ((~>) a a) - where - IdFooSym0KindInference :: SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => - IdFooSym0 a0123456789876543210 - type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210 - instance SuppressUnusedWarnings IdFooSym0 where - suppressUnusedWarnings = snd ((,) IdFooSym0KindInference ()) - type IdFooSym1 :: c -> (~>) a a - data IdFooSym1 (a0123456789876543210 :: c) :: (~>) a a - where - IdFooSym1KindInference :: SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) => - IdFooSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) IdFooSym1KindInference ()) - type IdFooSym2 :: c -> a -> a - type family IdFooSym2 (a0123456789876543210 :: c) (a0123456789876543210 :: a) :: a where - IdFooSym2 a0123456789876543210 a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210 - type IdSym0 :: (~>) a a - data IdSym0 :: (~>) a a - where - IdSym0KindInference :: SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0 a0123456789876543210 - type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings = snd ((,) IdSym0KindInference ()) - type IdSym1 :: a -> a - type family IdSym1 (a0123456789876543210 :: a) :: a where - IdSym1 a0123456789876543210 = Id a0123456789876543210 - type ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) - data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) - where - ReturnFuncSym0KindInference :: SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => - ReturnFuncSym0 a0123456789876543210 - type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 - instance SuppressUnusedWarnings ReturnFuncSym0 where - suppressUnusedWarnings = snd ((,) ReturnFuncSym0KindInference ()) - type ReturnFuncSym1 :: Nat -> (~>) Nat Nat - data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - ReturnFuncSym1KindInference :: SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) => - ReturnFuncSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ReturnFuncSym1KindInference ()) - type ReturnFuncSym2 :: Nat -> Nat -> Nat - type family ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - ReturnFuncSym2 a0123456789876543210 a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210 - type IdFoo :: c -> a -> a - type family IdFoo (a :: c) (a :: a) :: a where - IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 - type Id :: a -> a - type family Id (a :: a) :: a where - Id x = x - type ReturnFunc :: Nat -> Nat -> Nat - type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where - ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 - sIdFoo :: - (forall (t :: c) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) :: Type) - sId :: - (forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) :: Type) - sReturnFunc :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t - -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) :: Type) - sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing (singFun1 @IdSym0 sId) sA_0123456789876543210 - sId (sX :: Sing x) = sX - sReturnFunc - _ - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing (singFun1 @SuccSym0 SSucc) sA_0123456789876543210 - 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 SingI1 (IdFooSym1 :: c -> (~>) a a) where - liftSing (s :: Sing (d :: c)) - = singFun1 @(IdFooSym1 (d :: c)) (sIdFoo s) - instance SingI (IdSym0 :: (~>) a a) where - sing = singFun1 @IdSym0 sId - 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)) - instance SingI1 (ReturnFuncSym1 :: Nat -> (~>) Nat Nat) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(ReturnFuncSym1 (d :: Nat)) (sReturnFunc s) +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 IdFooSym0 :: (~>) c ((~>) a a)+ data IdFooSym0 :: (~>) c ((~>) a a)+ where+ IdFooSym0KindInference :: SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) =>+ IdFooSym0 a0123456789876543210+ type instance Apply @c @((~>) a a) IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210+ instance SuppressUnusedWarnings IdFooSym0 where+ suppressUnusedWarnings = snd ((,) IdFooSym0KindInference ())+ type IdFooSym1 :: c -> (~>) a a+ data IdFooSym1 (a0123456789876543210 :: c) :: (~>) a a+ where+ IdFooSym1KindInference :: SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) =>+ IdFooSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @a (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) IdFooSym1KindInference ())+ type IdFooSym2 :: c -> a -> a+ type family IdFooSym2 @c @a (a0123456789876543210 :: c) (a0123456789876543210 :: a) :: a where+ IdFooSym2 a0123456789876543210 a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210+ type IdSym0 :: (~>) a a+ data IdSym0 :: (~>) a a+ where+ IdSym0KindInference :: SameKind (Apply IdSym0 arg) (IdSym1 arg) =>+ IdSym0 a0123456789876543210+ type instance Apply @a @a IdSym0 a0123456789876543210 = Id a0123456789876543210+ instance SuppressUnusedWarnings IdSym0 where+ suppressUnusedWarnings = snd ((,) IdSym0KindInference ())+ type IdSym1 :: a -> a+ type family IdSym1 @a (a0123456789876543210 :: a) :: a where+ IdSym1 a0123456789876543210 = Id a0123456789876543210+ type ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)+ data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)+ where+ ReturnFuncSym0KindInference :: SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) =>+ ReturnFuncSym0 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210+ instance SuppressUnusedWarnings ReturnFuncSym0 where+ suppressUnusedWarnings = snd ((,) ReturnFuncSym0KindInference ())+ type ReturnFuncSym1 :: Nat -> (~>) Nat Nat+ data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ ReturnFuncSym1KindInference :: SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) =>+ ReturnFuncSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ReturnFuncSym1KindInference ())+ type ReturnFuncSym2 :: Nat -> Nat -> Nat+ type family ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ ReturnFuncSym2 a0123456789876543210 a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210+ type IdFoo :: c -> a -> a+ type family IdFoo @c @a (a :: c) (a :: a) :: a where+ IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210+ type Id :: a -> a+ type family Id @a (a :: a) :: a where+ Id x = x+ type ReturnFunc :: Nat -> Nat -> Nat+ type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where+ ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210+ sIdFoo ::+ (forall (t :: c) (t :: a).+ Sing t -> Sing t -> Sing (IdFoo t t :: a) :: Type)+ sId :: (forall (t :: a). Sing t -> Sing (Id t :: a) :: Type)+ sReturnFunc ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing (ReturnFunc t t :: Nat) :: Type)+ sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing (singFun1 @IdSym0 sId) sA_0123456789876543210+ sId (sX :: Sing x) = sX+ sReturnFunc+ _+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing (singFun1 @SuccSym0 SSucc) sA_0123456789876543210+ 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 SingI1 (IdFooSym1 :: c -> (~>) a a) where+ liftSing (s :: Sing (d :: c))+ = singFun1 @(IdFooSym1 (d :: c)) (sIdFoo s)+ instance SingI (IdSym0 :: (~>) a a) where+ sing = singFun1 @IdSym0 sId+ 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))+ instance SingI1 (ReturnFuncSym1 :: Nat -> (~>) Nat Nat) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(ReturnFuncSym1 (d :: Nat)) (sReturnFunc s)
tests/compile-and-dump/Singletons/ReturnFunc.hs view
@@ -1,22 +1,22 @@-module Singletons.ReturnFunc where - -import Data.Singletons -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 - |]) +module Singletons.ReturnFunc where++import Data.Singletons+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.golden view
@@ -1,148 +1,146 @@-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 lhs_0123456789876543210 where - Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) - data Lambda_0123456789876543210Sym0 lhs_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 lhs_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 lhs_01234567898765432100123456789876543210 = Lambda_0123456789876543210 lhs_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - type family Lambda_0123456789876543210Sym1 lhs_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym1 lhs_01234567898765432100123456789876543210 = Lambda_0123456789876543210 lhs_01234567898765432100123456789876543210 - type Foo3Sym0 :: [Nat] - type family Foo3Sym0 :: [Nat] where - Foo3Sym0 = Foo3 - type Foo2Sym0 :: [Nat] - type family Foo2Sym0 :: [Nat] where - Foo2Sym0 = Foo2 - type Foo1Sym0 :: [Nat] - type family Foo1Sym0 :: [Nat] where - Foo1Sym0 = Foo1 - type (+@#@$) :: (~>) Nat ((~>) Nat Nat) - data (+@#@$) :: (~>) Nat ((~>) Nat Nat) - where - (:+@#@$###) :: SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (+@#@$) a0123456789876543210 - type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings = snd ((,) (:+@#@$###) ()) - type (+@#@$$) :: Nat -> (~>) Nat Nat - data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - (:+@#@$$###) :: SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => - (+@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:+@#@$$###) ()) - type (+@#@$$$) :: Nat -> Nat -> Nat - type family (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - (+@#@$$$) a0123456789876543210 a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 - type Foo3 :: [Nat] - type family Foo3 :: [Nat] where - Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0)) - type Foo2 :: [Nat] - type family Foo2 :: [Nat] where - Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0)) - type Foo1 :: [Nat] - type family Foo1 :: [Nat] where - Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0)) - type (+) :: Nat -> Nat -> Nat - type family (+) (a :: Nat) (a :: Nat) :: Nat where - (+) 'Zero m = m - (+) ('Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) - sFoo3 :: (Sing (Foo3Sym0 :: [Nat]) :: Type) - sFoo2 :: (Sing (Foo2Sym0 :: [Nat]) :: Type) - sFoo1 :: (Sing (Foo1Sym0 :: [Nat]) :: Type) - (%+) :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) :: Type) - 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)) - 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)) - 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)) - (%+) SZero (sM :: Sing m) = sM - (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = applySing - (singFun1 @SuccSym0 SSucc) - (applySing (applySing (singFun2 @(+@#@$) (%+)) sN) sM) - instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where - sing = singFun2 @(+@#@$) (%+) - instance SingI d => - SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where - sing = singFun1 @((+@#@$$) (d :: Nat)) ((%+) (sing @d)) - instance SingI1 ((+@#@$$) :: Nat -> (~>) Nat Nat) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @((+@#@$$) (d :: Nat)) ((%+) s) +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 LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0)+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type Foo3Sym0 :: [Nat]+ type family Foo3Sym0 :: [Nat] where+ Foo3Sym0 = Foo3+ type Foo2Sym0 :: [Nat]+ type family Foo2Sym0 :: [Nat] where+ Foo2Sym0 = Foo2+ type Foo1Sym0 :: [Nat]+ type family Foo1Sym0 :: [Nat] where+ Foo1Sym0 = Foo1+ type (+@#@$) :: (~>) Nat ((~>) Nat Nat)+ data (+@#@$) :: (~>) Nat ((~>) Nat Nat)+ where+ (:+@#@$###) :: SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>+ (+@#@$) a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (+@#@$) where+ suppressUnusedWarnings = snd ((,) (:+@#@$###) ())+ type (+@#@$$) :: Nat -> (~>) Nat Nat+ data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ (:+@#@$$###) :: SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) =>+ (+@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:+@#@$$###) ())+ type (+@#@$$$) :: Nat -> Nat -> Nat+ type family (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ (+@#@$$$) a0123456789876543210 a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210+ type Foo3 :: [Nat]+ type family Foo3 :: [Nat] where+ Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0))+ type Foo2 :: [Nat]+ type family Foo2 :: [Nat] where+ Foo2 = Apply (Apply MapSym0 LamCases_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0))+ type Foo1 :: [Nat]+ type family Foo1 :: [Nat] where+ Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) NilSym0))+ type (+) :: Nat -> Nat -> Nat+ type family (+) (a :: Nat) (a :: Nat) :: Nat where+ (+) 'Zero m = m+ (+) ('Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m)+ sFoo3 :: (Sing (Foo3 :: [Nat]) :: Type)+ sFoo2 :: (Sing (Foo2 :: [Nat]) :: Type)+ sFoo1 :: (Sing (Foo1 :: [Nat]) :: Type)+ (%+) ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing ((+) t t :: Nat) :: Type)+ 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))+ sFoo2+ = applySing+ (applySing+ (singFun2 @MapSym0 sMap)+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (sLhs_0123456789876543210 :: 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))+ 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))+ (%+) SZero (sM :: Sing m) = sM+ (%+) (SSucc (sN :: Sing n)) (sM :: Sing m)+ = applySing+ (singFun1 @SuccSym0 SSucc)+ (applySing (applySing (singFun2 @(+@#@$) (%+)) sN) sM)+ instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where+ sing = singFun2 @(+@#@$) (%+)+ instance SingI d =>+ SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where+ sing = singFun1 @((+@#@$$) (d :: Nat)) ((%+) (sing @d))+ instance SingI1 ((+@#@$$) :: Nat -> (~>) Nat Nat) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @((+@#@$$) (d :: Nat)) ((%+) s)
tests/compile-and-dump/Singletons/Sections.hs view
@@ -1,39 +1,39 @@-module Singletons.Sections where - -import Data.List.Singletons -import Data.Singletons -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 +module Singletons.Sections where++import Data.List.Singletons+import Data.Singletons+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.golden view
@@ -1,649 +1,522 @@-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 MkFoo1Sym0 :: Foo1 - type family MkFoo1Sym0 :: Foo1 where - MkFoo1Sym0 = MkFoo1 - type MkFoo2aSym0 :: forall a. (~>) a ((~>) a (Foo2 a)) - data MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a)) - where - MkFoo2aSym0KindInference :: SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => - MkFoo2aSym0 a0123456789876543210 - type instance Apply MkFoo2aSym0 a0123456789876543210 = MkFoo2aSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo2aSym0 where - suppressUnusedWarnings = snd ((,) MkFoo2aSym0KindInference ()) - type MkFoo2aSym1 :: forall a. a -> (~>) a (Foo2 a) - data MkFoo2aSym1 (a0123456789876543210 :: a) :: (~>) a (Foo2 a) - where - MkFoo2aSym1KindInference :: SameKind (Apply (MkFoo2aSym1 a0123456789876543210) arg) (MkFoo2aSym2 a0123456789876543210 arg) => - MkFoo2aSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkFoo2aSym1 a0123456789876543210) a0123456789876543210 = MkFoo2a a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkFoo2aSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkFoo2aSym1KindInference ()) - type MkFoo2aSym2 :: forall a. a -> a -> Foo2 a - type family MkFoo2aSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where - MkFoo2aSym2 a0123456789876543210 a0123456789876543210 = MkFoo2a a0123456789876543210 a0123456789876543210 - type MkFoo2bSym0 :: forall a. (~>) a ((~>) a (Foo2 a)) - data MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a)) - where - MkFoo2bSym0KindInference :: SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => - MkFoo2bSym0 a0123456789876543210 - type instance Apply MkFoo2bSym0 a0123456789876543210 = MkFoo2bSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo2bSym0 where - suppressUnusedWarnings = snd ((,) MkFoo2bSym0KindInference ()) - infixl 5 `MkFoo2bSym0` - type MkFoo2bSym1 :: forall a. a -> (~>) a (Foo2 a) - data MkFoo2bSym1 (a0123456789876543210 :: a) :: (~>) a (Foo2 a) - where - MkFoo2bSym1KindInference :: SameKind (Apply (MkFoo2bSym1 a0123456789876543210) arg) (MkFoo2bSym2 a0123456789876543210 arg) => - MkFoo2bSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkFoo2bSym1 a0123456789876543210) a0123456789876543210 = MkFoo2b a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkFoo2bSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkFoo2bSym1KindInference ()) - infixl 5 `MkFoo2bSym1` - type MkFoo2bSym2 :: forall a. a -> a -> Foo2 a - type family MkFoo2bSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where - MkFoo2bSym2 a0123456789876543210 a0123456789876543210 = MkFoo2b a0123456789876543210 a0123456789876543210 - infixl 5 `MkFoo2bSym2` - type (:*:@#@$) :: forall a. (~>) a ((~>) a (Foo2 a)) - data (:*:@#@$) :: (~>) a ((~>) a (Foo2 a)) - where - (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) a0123456789876543210 - type instance Apply (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd ((,) (::*:@#@$###) ()) - infixl 5 :*:@#@$ - type (:*:@#@$$) :: forall a. a -> (~>) a (Foo2 a) - data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) a (Foo2 a) - where - (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) => - (:*:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ()) - infixl 5 :*:@#@$$ - type (:*:@#@$$$) :: forall a. a -> a -> Foo2 a - type family (:*:@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where - (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - infixl 5 :*:@#@$$$ - type (:&:@#@$) :: forall a. (~>) a ((~>) a (Foo2 a)) - data (:&:@#@$) :: (~>) a ((~>) a (Foo2 a)) - where - (::&:@#@$###) :: SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => - (:&:@#@$) a0123456789876543210 - type instance Apply (:&:@#@$) a0123456789876543210 = (:&:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:&:@#@$) where - suppressUnusedWarnings = snd ((,) (::&:@#@$###) ()) - infixl 5 :&:@#@$ - type (:&:@#@$$) :: forall a. a -> (~>) a (Foo2 a) - data (:&:@#@$$) (a0123456789876543210 :: a) :: (~>) a (Foo2 a) - where - (::&:@#@$$###) :: SameKind (Apply ((:&:@#@$$) a0123456789876543210) arg) ((:&:@#@$$$) a0123456789876543210 arg) => - (:&:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:&:@#@$$) a0123456789876543210) a0123456789876543210 = (:&:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:&:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::&:@#@$$###) ()) - infixl 5 :&:@#@$$ - type (:&:@#@$$$) :: forall a. a -> a -> Foo2 a - type family (:&:@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where - (:&:@#@$$$) a0123456789876543210 a0123456789876543210 = (:&:) a0123456789876543210 a0123456789876543210 - infixl 5 :&:@#@$$$ - type MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) - data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) - where - MkFoo3Sym0KindInference :: SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => - MkFoo3Sym0 a0123456789876543210 - type instance Apply MkFoo3Sym0 a0123456789876543210 = MkFoo3Sym1 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo3Sym0 where - suppressUnusedWarnings = snd ((,) MkFoo3Sym0KindInference ()) - type MkFoo3Sym1 :: Bool -> (~>) Bool Foo3 - data MkFoo3Sym1 (a0123456789876543210 :: Bool) :: (~>) Bool Foo3 - where - MkFoo3Sym1KindInference :: SameKind (Apply (MkFoo3Sym1 a0123456789876543210) arg) (MkFoo3Sym2 a0123456789876543210 arg) => - MkFoo3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkFoo3Sym1 a0123456789876543210) a0123456789876543210 = MkFoo3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkFoo3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkFoo3Sym1KindInference ()) - type MkFoo3Sym2 :: Bool -> Bool -> Foo3 - type family MkFoo3Sym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Foo3 where - MkFoo3Sym2 a0123456789876543210 a0123456789876543210 = MkFoo3 a0123456789876543210 a0123456789876543210 - type (***@#@$) :: (~>) Foo3 Bool - data (***@#@$) :: (~>) Foo3 Bool - where - (:***@#@$###) :: SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => - (***@#@$) a0123456789876543210 - type instance Apply (***@#@$) a0123456789876543210 = (***) a0123456789876543210 - instance SuppressUnusedWarnings (***@#@$) where - suppressUnusedWarnings = snd ((,) (:***@#@$###) ()) - type (***@#@$$) :: Foo3 -> Bool - type family (***@#@$$) (a0123456789876543210 :: Foo3) :: Bool where - (***@#@$$) a0123456789876543210 = (***) a0123456789876543210 - type GetFoo3aSym0 :: (~>) Foo3 Bool - data GetFoo3aSym0 :: (~>) Foo3 Bool - where - GetFoo3aSym0KindInference :: SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => - GetFoo3aSym0 a0123456789876543210 - type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210 - instance SuppressUnusedWarnings GetFoo3aSym0 where - suppressUnusedWarnings = snd ((,) GetFoo3aSym0KindInference ()) - type GetFoo3aSym1 :: Foo3 -> Bool - type family GetFoo3aSym1 (a0123456789876543210 :: Foo3) :: Bool where - GetFoo3aSym1 a0123456789876543210 = GetFoo3a a0123456789876543210 - type (***) :: Foo3 -> Bool - type family (***) (a :: Foo3) :: Bool where - (***) (MkFoo3 _ field) = field - type GetFoo3a :: Foo3 -> Bool - type family GetFoo3a (a :: Foo3) :: Bool where - GetFoo3a (MkFoo3 field _) = field - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Foo1 -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (a :: Foo1) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo1 ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo1 ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) Foo1 ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) Foo1 ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Foo1 -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Foo1 -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Foo1 where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Foo2 a -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Foo2 a) ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Foo2 a) ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (Foo2 a) ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (Foo2 a) ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Foo2 a -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo2 a) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Foo2 a -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo2 a) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow (Foo2 a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Foo3 -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo3 ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Foo3 ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) Foo3 ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) Foo3 ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Foo3 -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Foo3 -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Foo3 where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - infixl 5 :%&: - infixl 5 :%*: - infixl 5 `SMkFoo2b` - (%***) :: - (forall (t :: Foo3). - Sing t -> Sing (Apply (***@#@$) t :: Bool) :: Type) - sGetFoo3a :: - (forall (t :: Foo3). - Sing t -> Sing (Apply GetFoo3aSym0 t :: Bool) :: Type) - (%***) (SMkFoo3 _ (sField :: Sing field)) = sField - sGetFoo3a (SMkFoo3 (sField :: Sing field) _) = sField - instance SingI ((***@#@$) :: (~>) Foo3 Bool) where - sing = singFun1 @(***@#@$) (%***) - instance SingI (GetFoo3aSym0 :: (~>) Foo3 Bool) where - sing = singFun1 @GetFoo3aSym0 sGetFoo3a - data SFoo1 :: Foo1 -> Type where SMkFoo1 :: SFoo1 (MkFoo1 :: Foo1) - type instance Sing @Foo1 = SFoo1 - instance SingKind Foo1 where - type Demote Foo1 = Foo1 - fromSing SMkFoo1 = MkFoo1 - toSing MkFoo1 = SomeSing SMkFoo1 - data SFoo2 :: forall a. Foo2 a -> Type - where - SMkFoo2a :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SFoo2 (MkFoo2a n n :: Foo2 a) - SMkFoo2b :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SFoo2 (MkFoo2b n n :: Foo2 a) - (:%*:) :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SFoo2 ((:*:) n n :: Foo2 a) - (:%&:) :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SFoo2 ((:&:) n n :: Foo2 a) - type instance Sing @(Foo2 a) = SFoo2 - 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 SFoo3 :: Foo3 -> Type - where - SMkFoo3 :: forall (n :: Bool) (n :: Bool). - (Sing n) -> (Sing n) -> SFoo3 (MkFoo3 n n :: Foo3) - type instance Sing @Foo3 = SFoo3 - 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.Num.Natural.Natural) - (t2 :: Foo1) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) Foo1 ((~>) Symbol Symbol)) - -> 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.Num.Natural.Natural) - (t2 :: Foo2 a) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (Foo2 a) ((~>) Symbol Symbol)) - -> 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.Num.Natural.Natural) - (t2 :: Foo3) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) Foo3 ((~>) Symbol Symbol)) - -> 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 (SFoo1 (z :: Foo1)) - deriving instance Data.Singletons.ShowSing.ShowSing a => - Show (SFoo2 (z :: Foo2 a)) - deriving instance Data.Singletons.ShowSing.ShowSing Bool => - Show (SFoo3 (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 n => SingI1 (MkFoo2a (n :: a)) where - liftSing = SMkFoo2a sing - instance SingI2 MkFoo2a where - liftSing2 = SMkFoo2a - instance SingI (MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))) where - sing = singFun2 @MkFoo2aSym0 SMkFoo2a - instance SingI d => - SingI (MkFoo2aSym1 (d :: a) :: (~>) a (Foo2 a)) where - sing = singFun1 @(MkFoo2aSym1 (d :: a)) (SMkFoo2a (sing @d)) - instance SingI1 (MkFoo2aSym1 :: a -> (~>) a (Foo2 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkFoo2aSym1 (d :: a)) (SMkFoo2a s) - instance (SingI n, SingI n) => - SingI (MkFoo2b (n :: a) (n :: a)) where - sing = SMkFoo2b sing sing - instance SingI n => SingI1 (MkFoo2b (n :: a)) where - liftSing = SMkFoo2b sing - instance SingI2 MkFoo2b where - liftSing2 = SMkFoo2b - instance SingI (MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))) where - sing = singFun2 @MkFoo2bSym0 SMkFoo2b - instance SingI d => - SingI (MkFoo2bSym1 (d :: a) :: (~>) a (Foo2 a)) where - sing = singFun1 @(MkFoo2bSym1 (d :: a)) (SMkFoo2b (sing @d)) - instance SingI1 (MkFoo2bSym1 :: a -> (~>) a (Foo2 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkFoo2bSym1 (d :: a)) (SMkFoo2b s) - instance (SingI n, SingI n) => - SingI ((:*:) (n :: a) (n :: a)) where - sing = (:%*:) sing sing - instance SingI n => SingI1 ((:*:) (n :: a)) where - liftSing = (:%*:) sing - instance SingI2 (:*:) where - liftSing2 = (:%*:) - instance SingI ((:*:@#@$) :: (~>) a ((~>) a (Foo2 a))) where - sing = singFun2 @(:*:@#@$) (:%*:) - instance SingI d => - SingI ((:*:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where - sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d)) - instance SingI1 ((:*:@#@$$) :: a -> (~>) a (Foo2 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s) - instance (SingI n, SingI n) => - SingI ((:&:) (n :: a) (n :: a)) where - sing = (:%&:) sing sing - instance SingI n => SingI1 ((:&:) (n :: a)) where - liftSing = (:%&:) sing - instance SingI2 (:&:) where - liftSing2 = (:%&:) - instance SingI ((:&:@#@$) :: (~>) a ((~>) a (Foo2 a))) where - sing = singFun2 @(:&:@#@$) (:%&:) - instance SingI d => - SingI ((:&:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where - sing = singFun1 @((:&:@#@$$) (d :: a)) ((:%&:) (sing @d)) - instance SingI1 ((:&:@#@$$) :: a -> (~>) a (Foo2 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:&:@#@$$) (d :: a)) ((:%&:) s) - instance (SingI n, SingI n) => - SingI (MkFoo3 (n :: Bool) (n :: Bool)) where - sing = SMkFoo3 sing sing - instance SingI n => SingI1 (MkFoo3 (n :: Bool)) where - liftSing = SMkFoo3 sing - instance SingI2 MkFoo3 where - liftSing2 = SMkFoo3 - instance SingI (MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)) where - sing = singFun2 @MkFoo3Sym0 SMkFoo3 - instance SingI d => - SingI (MkFoo3Sym1 (d :: Bool) :: (~>) Bool Foo3) where - sing = singFun1 @(MkFoo3Sym1 (d :: Bool)) (SMkFoo3 (sing @d)) - instance SingI1 (MkFoo3Sym1 :: Bool -> (~>) Bool Foo3) where - liftSing (s :: Sing (d :: Bool)) - = singFun1 @(MkFoo3Sym1 (d :: Bool)) (SMkFoo3 s) +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 MkFoo1Sym0 :: Foo1+ type family MkFoo1Sym0 :: Foo1 where+ MkFoo1Sym0 = MkFoo1+ type MkFoo2aSym0 :: forall a. (~>) a ((~>) a (Foo2 a))+ data MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))+ where+ MkFoo2aSym0KindInference :: SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) =>+ MkFoo2aSym0 a0123456789876543210+ type instance Apply @a @((~>) a (Foo2 a)) MkFoo2aSym0 a0123456789876543210 = MkFoo2aSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo2aSym0 where+ suppressUnusedWarnings = snd ((,) MkFoo2aSym0KindInference ())+ type MkFoo2aSym1 :: forall a. a -> (~>) a (Foo2 a)+ data MkFoo2aSym1 (a0123456789876543210 :: a) :: (~>) a (Foo2 a)+ where+ MkFoo2aSym1KindInference :: SameKind (Apply (MkFoo2aSym1 a0123456789876543210) arg) (MkFoo2aSym2 a0123456789876543210 arg) =>+ MkFoo2aSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Foo2 a) (MkFoo2aSym1 a0123456789876543210) a0123456789876543210 = MkFoo2a a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkFoo2aSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkFoo2aSym1KindInference ())+ type MkFoo2aSym2 :: forall a. a -> a -> Foo2 a+ type family MkFoo2aSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where+ MkFoo2aSym2 a0123456789876543210 a0123456789876543210 = MkFoo2a a0123456789876543210 a0123456789876543210+ type MkFoo2bSym0 :: forall a. (~>) a ((~>) a (Foo2 a))+ data MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))+ where+ MkFoo2bSym0KindInference :: SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) =>+ MkFoo2bSym0 a0123456789876543210+ type instance Apply @a @((~>) a (Foo2 a)) MkFoo2bSym0 a0123456789876543210 = MkFoo2bSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo2bSym0 where+ suppressUnusedWarnings = snd ((,) MkFoo2bSym0KindInference ())+ infixl 5 type `MkFoo2bSym0`+ type MkFoo2bSym1 :: forall a. a -> (~>) a (Foo2 a)+ data MkFoo2bSym1 (a0123456789876543210 :: a) :: (~>) a (Foo2 a)+ where+ MkFoo2bSym1KindInference :: SameKind (Apply (MkFoo2bSym1 a0123456789876543210) arg) (MkFoo2bSym2 a0123456789876543210 arg) =>+ MkFoo2bSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Foo2 a) (MkFoo2bSym1 a0123456789876543210) a0123456789876543210 = MkFoo2b a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkFoo2bSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkFoo2bSym1KindInference ())+ infixl 5 type `MkFoo2bSym1`+ type MkFoo2bSym2 :: forall a. a -> a -> Foo2 a+ type family MkFoo2bSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where+ MkFoo2bSym2 a0123456789876543210 a0123456789876543210 = MkFoo2b a0123456789876543210 a0123456789876543210+ infixl 5 type `MkFoo2bSym2`+ type (:*:@#@$) :: forall a. (~>) a ((~>) a (Foo2 a))+ data (:*:@#@$) :: (~>) a ((~>) a (Foo2 a))+ where+ (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>+ (:*:@#@$) a0123456789876543210+ type instance Apply @a @((~>) a (Foo2 a)) (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:*:@#@$) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$###) ())+ infixl 5 type :*:@#@$+ type (:*:@#@$$) :: forall a. a -> (~>) a (Foo2 a)+ data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) a (Foo2 a)+ where+ (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) =>+ (:*:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Foo2 a) ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ())+ infixl 5 type :*:@#@$$+ type (:*:@#@$$$) :: forall a. a -> a -> Foo2 a+ type family (:*:@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where+ (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ infixl 5 type :*:@#@$$$+ type (:&:@#@$) :: forall a. (~>) a ((~>) a (Foo2 a))+ data (:&:@#@$) :: (~>) a ((~>) a (Foo2 a))+ where+ (::&:@#@$###) :: SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) =>+ (:&:@#@$) a0123456789876543210+ type instance Apply @a @((~>) a (Foo2 a)) (:&:@#@$) a0123456789876543210 = (:&:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:&:@#@$) where+ suppressUnusedWarnings = snd ((,) (::&:@#@$###) ())+ infixl 5 type :&:@#@$+ type (:&:@#@$$) :: forall a. a -> (~>) a (Foo2 a)+ data (:&:@#@$$) (a0123456789876543210 :: a) :: (~>) a (Foo2 a)+ where+ (::&:@#@$$###) :: SameKind (Apply ((:&:@#@$$) a0123456789876543210) arg) ((:&:@#@$$$) a0123456789876543210 arg) =>+ (:&:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Foo2 a) ((:&:@#@$$) a0123456789876543210) a0123456789876543210 = (:&:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:&:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::&:@#@$$###) ())+ infixl 5 type :&:@#@$$+ type (:&:@#@$$$) :: forall a. a -> a -> Foo2 a+ type family (:&:@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Foo2 a where+ (:&:@#@$$$) a0123456789876543210 a0123456789876543210 = (:&:) a0123456789876543210 a0123456789876543210+ infixl 5 type :&:@#@$$$+ type MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)+ data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)+ where+ MkFoo3Sym0KindInference :: SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>+ MkFoo3Sym0 a0123456789876543210+ type instance Apply @Bool @((~>) Bool Foo3) MkFoo3Sym0 a0123456789876543210 = MkFoo3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo3Sym0 where+ suppressUnusedWarnings = snd ((,) MkFoo3Sym0KindInference ())+ type MkFoo3Sym1 :: Bool -> (~>) Bool Foo3+ data MkFoo3Sym1 (a0123456789876543210 :: Bool) :: (~>) Bool Foo3+ where+ MkFoo3Sym1KindInference :: SameKind (Apply (MkFoo3Sym1 a0123456789876543210) arg) (MkFoo3Sym2 a0123456789876543210 arg) =>+ MkFoo3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Foo3 (MkFoo3Sym1 a0123456789876543210) a0123456789876543210 = MkFoo3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkFoo3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkFoo3Sym1KindInference ())+ type MkFoo3Sym2 :: Bool -> Bool -> Foo3+ type family MkFoo3Sym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Foo3 where+ MkFoo3Sym2 a0123456789876543210 a0123456789876543210 = MkFoo3 a0123456789876543210 a0123456789876543210+ type (***@#@$) :: (~>) Foo3 Bool+ data (***@#@$) :: (~>) Foo3 Bool+ where+ (:***@#@$###) :: SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) =>+ (***@#@$) a0123456789876543210+ type instance Apply @Foo3 @Bool (***@#@$) a0123456789876543210 = (***) a0123456789876543210+ instance SuppressUnusedWarnings (***@#@$) where+ suppressUnusedWarnings = snd ((,) (:***@#@$###) ())+ type (***@#@$$) :: Foo3 -> Bool+ type family (***@#@$$) (a0123456789876543210 :: Foo3) :: Bool where+ (***@#@$$) a0123456789876543210 = (***) a0123456789876543210+ type GetFoo3aSym0 :: (~>) Foo3 Bool+ data GetFoo3aSym0 :: (~>) Foo3 Bool+ where+ GetFoo3aSym0KindInference :: SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) =>+ GetFoo3aSym0 a0123456789876543210+ type instance Apply @Foo3 @Bool GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210+ instance SuppressUnusedWarnings GetFoo3aSym0 where+ suppressUnusedWarnings = snd ((,) GetFoo3aSym0KindInference ())+ type GetFoo3aSym1 :: Foo3 -> Bool+ type family GetFoo3aSym1 (a0123456789876543210 :: Foo3) :: Bool where+ GetFoo3aSym1 a0123456789876543210 = GetFoo3a a0123456789876543210+ type (***) :: Foo3 -> Bool+ type family (***) (a :: Foo3) :: Bool where+ (***) (MkFoo3 _ field) = field+ type GetFoo3a :: Foo3 -> Bool+ type family GetFoo3a (a :: Foo3) :: Bool where+ GetFoo3a (MkFoo3 field _) = field+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Foo1 -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Foo1) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210+ instance PShow Foo1 where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type ShowsPrec_0123456789876543210 :: forall a. GHC.Internal.Bignum.Natural.Natural+ -> Foo2 a -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 @a (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Foo2 a) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (MkFoo2a arg_0123456789876543210 arg_0123456789876543210 :: Foo2 a) (a_0123456789876543210 :: Symbol) = 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 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (MkFoo2b argL_0123456789876543210 argR_0123456789876543210 :: Foo2 a) (a_0123456789876543210 :: Symbol) = 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 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) ((:*:) arg_0123456789876543210 arg_0123456789876543210 :: Foo2 a) (a_0123456789876543210 :: Symbol) = 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 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) ((:&:) argL_0123456789876543210 argR_0123456789876543210 :: Foo2 a) (a_0123456789876543210 :: Symbol) = 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+ instance PShow (Foo2 a) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Foo3 -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (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+ instance PShow Foo3 where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ infixl 5 data :%&:+ infixl 5 data :%*:+ infixl 5 data `SMkFoo2b`+ (%***) ::+ (forall (t :: Foo3). Sing t -> Sing ((***) t :: Bool) :: Type)+ sGetFoo3a ::+ (forall (t :: Foo3). Sing t -> Sing (GetFoo3a t :: Bool) :: Type)+ (%***) (SMkFoo3 _ (sField :: Sing field)) = sField+ sGetFoo3a (SMkFoo3 (sField :: Sing field) _) = sField+ instance SingI ((***@#@$) :: (~>) Foo3 Bool) where+ sing = singFun1 @(***@#@$) (%***)+ instance SingI (GetFoo3aSym0 :: (~>) Foo3 Bool) where+ sing = singFun1 @GetFoo3aSym0 sGetFoo3a+ data SFoo1 :: Foo1 -> Type where SMkFoo1 :: SFoo1 (MkFoo1 :: Foo1)+ type instance Sing @Foo1 = SFoo1+ instance SingKind Foo1 where+ type Demote Foo1 = Foo1+ fromSing SMkFoo1 = MkFoo1+ toSing MkFoo1 = SomeSing SMkFoo1+ data SFoo2 :: forall a. Foo2 a -> Type+ where+ SMkFoo2a :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SFoo2 (MkFoo2a n n :: Foo2 a)+ SMkFoo2b :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SFoo2 (MkFoo2b n n :: Foo2 a)+ (:%*:) :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SFoo2 ((:*:) n n :: Foo2 a)+ (:%&:) :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SFoo2 ((:&:) n n :: Foo2 a)+ type instance Sing @(Foo2 a) = SFoo2+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkFoo2a c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ toSing (MkFoo2b (b :: Demote a) (b :: Demote a))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkFoo2b c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ toSing ((:*:) (b :: Demote a) (b :: Demote a))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%*:) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ toSing ((:&:) (b :: Demote a) (b :: Demote a))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%&:) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ data SFoo3 :: Foo3 -> Type+ where+ SMkFoo3 :: forall (n :: Bool) (n :: Bool).+ (Sing n) -> (Sing n) -> SFoo3 (MkFoo3 n n :: Foo3)+ type instance Sing @Foo3 = SFoo3+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkFoo3 c c))+ (toSing b :: SomeSing Bool) (toSing b :: SomeSing Bool)+ instance SShow Foo1 where+ 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+ (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+ (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 (SFoo1 (z :: Foo1))+ deriving instance Data.Singletons.ShowSing.ShowSing a =>+ Show (SFoo2 (z :: Foo2 a))+ deriving instance Data.Singletons.ShowSing.ShowSing Bool =>+ Show (SFoo3 (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 n => SingI1 (MkFoo2a (n :: a)) where+ liftSing = SMkFoo2a sing+ instance SingI2 MkFoo2a where+ liftSing2 = SMkFoo2a+ instance SingI (MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))) where+ sing = singFun2 @MkFoo2aSym0 SMkFoo2a+ instance SingI d =>+ SingI (MkFoo2aSym1 (d :: a) :: (~>) a (Foo2 a)) where+ sing = singFun1 @(MkFoo2aSym1 (d :: a)) (SMkFoo2a (sing @d))+ instance SingI1 (MkFoo2aSym1 :: a -> (~>) a (Foo2 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkFoo2aSym1 (d :: a)) (SMkFoo2a s)+ instance (SingI n, SingI n) =>+ SingI (MkFoo2b (n :: a) (n :: a)) where+ sing = SMkFoo2b sing sing+ instance SingI n => SingI1 (MkFoo2b (n :: a)) where+ liftSing = SMkFoo2b sing+ instance SingI2 MkFoo2b where+ liftSing2 = SMkFoo2b+ instance SingI (MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))) where+ sing = singFun2 @MkFoo2bSym0 SMkFoo2b+ instance SingI d =>+ SingI (MkFoo2bSym1 (d :: a) :: (~>) a (Foo2 a)) where+ sing = singFun1 @(MkFoo2bSym1 (d :: a)) (SMkFoo2b (sing @d))+ instance SingI1 (MkFoo2bSym1 :: a -> (~>) a (Foo2 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkFoo2bSym1 (d :: a)) (SMkFoo2b s)+ instance (SingI n, SingI n) =>+ SingI ((:*:) (n :: a) (n :: a)) where+ sing = (:%*:) sing sing+ instance SingI n => SingI1 ((:*:) (n :: a)) where+ liftSing = (:%*:) sing+ instance SingI2 (:*:) where+ liftSing2 = (:%*:)+ instance SingI ((:*:@#@$) :: (~>) a ((~>) a (Foo2 a))) where+ sing = singFun2 @(:*:@#@$) (:%*:)+ instance SingI d =>+ SingI ((:*:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where+ sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d))+ instance SingI1 ((:*:@#@$$) :: a -> (~>) a (Foo2 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s)+ instance (SingI n, SingI n) =>+ SingI ((:&:) (n :: a) (n :: a)) where+ sing = (:%&:) sing sing+ instance SingI n => SingI1 ((:&:) (n :: a)) where+ liftSing = (:%&:) sing+ instance SingI2 (:&:) where+ liftSing2 = (:%&:)+ instance SingI ((:&:@#@$) :: (~>) a ((~>) a (Foo2 a))) where+ sing = singFun2 @(:&:@#@$) (:%&:)+ instance SingI d =>+ SingI ((:&:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where+ sing = singFun1 @((:&:@#@$$) (d :: a)) ((:%&:) (sing @d))+ instance SingI1 ((:&:@#@$$) :: a -> (~>) a (Foo2 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:&:@#@$$) (d :: a)) ((:%&:) s)+ instance (SingI n, SingI n) =>+ SingI (MkFoo3 (n :: Bool) (n :: Bool)) where+ sing = SMkFoo3 sing sing+ instance SingI n => SingI1 (MkFoo3 (n :: Bool)) where+ liftSing = SMkFoo3 sing+ instance SingI2 MkFoo3 where+ liftSing2 = SMkFoo3+ instance SingI (MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)) where+ sing = singFun2 @MkFoo3Sym0 SMkFoo3+ instance SingI d =>+ SingI (MkFoo3Sym1 (d :: Bool) :: (~>) Bool Foo3) where+ sing = singFun1 @(MkFoo3Sym1 (d :: Bool)) (SMkFoo3 (sing @d))+ instance SingI1 (MkFoo3Sym1 :: Bool -> (~>) Bool Foo3) where+ liftSing (s :: Sing (d :: Bool))+ = singFun1 @(MkFoo3Sym1 (d :: Bool)) (SMkFoo3 s)
tests/compile-and-dump/Singletons/ShowDeriving.hs view
@@ -1,41 +1,41 @@-module Singletons.ShowDeriving where - -import Data.Type.Equality -import Data.Singletons.TH -import Prelude.Singletons -import Text.Show.Singletons - -$(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 +module Singletons.ShowDeriving where++import Data.Type.Equality+import Data.Singletons.TH+import Prelude.Singletons+import Text.Show.Singletons++$(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.golden view
@@ -1,553 +1,361 @@-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 (:*:@#@$) :: forall a b. (~>) a ((~>) b (T a b)) - data (:*:@#@$) :: (~>) a ((~>) b (T a b)) - where - (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) a0123456789876543210 - type instance Apply (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd ((,) (::*:@#@$###) ()) - infixl 6 :*:@#@$ - type (:*:@#@$$) :: forall a b. a -> (~>) b (T a b) - data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) b (T a b) - where - (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) => - (:*:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ()) - infixl 6 :*:@#@$$ - type (:*:@#@$$$) :: forall a b. a -> b -> T a b - type family (:*:@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: T a b where - (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - infixl 6 :*:@#@$$$ - type S1Sym0 :: S - type family S1Sym0 :: S where - S1Sym0 = S1 - type S2Sym0 :: S - type family S2Sym0 :: S where - S2Sym0 = S2 - type TFHelper_0123456789876543210 :: T a () -> T a () -> Bool - type family TFHelper_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Bool where - TFHelper_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210) - type TFHelper_0123456789876543210Sym0 :: (~>) (T a ()) ((~>) (T a ()) Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) (T a ()) ((~>) (T a ()) Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: T a () - -> (~>) (T a ()) Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: T a ()) :: (~>) (T a ()) Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: T a () -> T a () -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: T a ()) (a0123456789876543210 :: T a ()) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq (T a ()) where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: T a () -> T a () -> Ordering - 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 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)) - type Compare_0123456789876543210Sym0 :: (~>) (T a ()) ((~>) (T a ()) Ordering) - data Compare_0123456789876543210Sym0 :: (~>) (T a ()) ((~>) (T a ()) Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: T a () - -> (~>) (T a ()) Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a ()) :: (~>) (T a ()) Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: T a () - -> T a () -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a ()) (a0123456789876543210 :: T a ()) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd (T a ()) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> T a () -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (T a ()) ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (T a ()) ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (T a ()) ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (T a ()) ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> T a () -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: T a ()) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> T a () -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: T a ()) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow (T a ()) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type TFHelper_0123456789876543210 :: S -> S -> Bool - type family TFHelper_0123456789876543210 (a :: S) (a :: S) :: Bool where - TFHelper_0123456789876543210 S1 S1 = TrueSym0 - TFHelper_0123456789876543210 S1 S2 = FalseSym0 - TFHelper_0123456789876543210 S2 S1 = FalseSym0 - TFHelper_0123456789876543210 S2 S2 = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) S ((~>) S Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) S ((~>) S Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: S -> (~>) S Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: S) :: (~>) S Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: S -> S -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq S where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: S -> S -> Ordering - type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where - Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 S1 S2 = LTSym0 - Compare_0123456789876543210 S2 S1 = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) - data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: S -> (~>) S Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: S) :: (~>) S Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: S -> S -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd S where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> S -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) S ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) S ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) S ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) S ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> S -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: S) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> S -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow S where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type MinBound_0123456789876543210 :: S - type family MinBound_0123456789876543210 :: S where - MinBound_0123456789876543210 = S1Sym0 - type MinBound_0123456789876543210Sym0 :: S - type family MinBound_0123456789876543210Sym0 :: S where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: S - type family MaxBound_0123456789876543210 :: S where - MaxBound_0123456789876543210 = S2Sym0 - type MaxBound_0123456789876543210Sym0 :: S - type family MaxBound_0123456789876543210Sym0 :: S where - 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 ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural -> S - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: S where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural S - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural S - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural -> S - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: S where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: S -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: S) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210 S1 = FromInteger 0 - FromEnum_0123456789876543210 S2 = FromInteger 1 - type FromEnum_0123456789876543210Sym0 :: (~>) S GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) S GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: S - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance PEnum S where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - infixl 6 :%*: - data ST :: forall a b. T a b -> Type - where - (:%*:) :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> ST ((:*:) n n :: T a b) - type instance Sing @(T a b) = ST - 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 SS :: S -> Type - where - SS1 :: SS (S1 :: S) - SS2 :: SS (S2 :: S) - type instance Sing @S = SS - instance SingKind S where - type Demote S = S - fromSing SS1 = S1 - fromSing SS2 = S2 - toSing S1 = SomeSing SS1 - toSing S2 = SomeSing SS2 - instance SEq a => SEq (T a ()) where - (%==) :: - forall (t1 :: T a ()) (t2 :: T a ()). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun (T a ()) ((~>) (T a ()) Bool) - -> Type) t1) t2) - (%==) - ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210) - 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) - -> 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 @(<>@#@$) (%<>))) - 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.Num.Natural.Natural) - (t2 :: T a ()) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (T a ()) ((~>) Symbol Symbol)) - -> 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 SEq S where - (%==) :: - forall (t1 :: S) (t2 :: S). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun S ((~>) S Bool) - -> Type) t1) t2) - (%==) SS1 SS1 = STrue - (%==) SS1 SS2 = SFalse - (%==) SS2 SS1 = SFalse - (%==) SS2 SS2 = STrue - instance SOrd S where - sCompare :: - forall (t1 :: S) (t2 :: S). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun S ((~>) S Ordering) - -> Type) t1) t2) - sCompare SS1 SS1 - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SS2 SS2 - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SS1 SS2 = SLT - sCompare SS2 SS1 = SGT - instance SShow S where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: S) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) S ((~>) Symbol Symbol)) - -> 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.Num.Natural.Natural). Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Num.Natural.Natural S - -> Type) t) - sFromEnum :: - forall (t :: S). Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Num.Natural.Natural - -> Type) t) - sToEnum (sN :: Sing n) - = id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SS1 - SFalse - -> id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 1)) - of - STrue -> SS2 - SFalse -> sError (sing :: Sing "toEnum: bad argument"))) - sFromEnum SS1 = sFromInteger (sing :: Sing 0) - sFromEnum SS2 = sFromInteger (sing :: Sing 1) - 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 SDecide a => - Data.Type.Equality.TestEquality (ST :: T a () -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide a => - Data.Type.Coercion.TestCoercion (ST :: T a () -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - instance SDecide S where - (%~) SS1 SS1 = Proved Refl - (%~) SS1 SS2 = Disproved (\ x -> case x of {}) - (%~) SS2 SS1 = Disproved (\ x -> case x of {}) - (%~) SS2 SS2 = Proved Refl - instance Data.Type.Equality.TestEquality (SS :: S -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (SS :: S -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Data.Singletons.ShowSing.ShowSing a => - Show (ST (z :: T a ())) - deriving instance Show (SS (z :: S)) - instance (SingI n, SingI n) => - SingI ((:*:) (n :: a) (n :: b)) where - sing = (:%*:) sing sing - instance SingI n => SingI1 ((:*:) (n :: a)) where - liftSing = (:%*:) sing - instance SingI2 (:*:) where - liftSing2 = (:%*:) - instance SingI ((:*:@#@$) :: (~>) a ((~>) b (T a b))) where - sing = singFun2 @(:*:@#@$) (:%*:) - instance SingI d => - SingI ((:*:@#@$$) (d :: a) :: (~>) b (T a b)) where - sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d)) - instance SingI1 ((:*:@#@$$) :: a -> (~>) b (T a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s) - instance SingI S1 where - sing = SS1 - instance SingI S2 where - sing = SS2 +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 (:*:@#@$) :: forall a b. (~>) a ((~>) b (T a b))+ data (:*:@#@$) :: (~>) a ((~>) b (T a b))+ where+ (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>+ (:*:@#@$) a0123456789876543210+ type instance Apply @a @((~>) b (T a b)) (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:*:@#@$) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$###) ())+ infixl 6 type :*:@#@$+ type (:*:@#@$$) :: forall a b. a -> (~>) b (T a b)+ data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) b (T a b)+ where+ (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) =>+ (:*:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @b @(T a b) ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ())+ infixl 6 type :*:@#@$$+ type (:*:@#@$$$) :: forall a b. a -> b -> T a b+ type family (:*:@#@$$$) @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: T a b where+ (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ infixl 6 type :*:@#@$$$+ type S1Sym0 :: S+ type family S1Sym0 :: S where+ S1Sym0 = S1+ type S2Sym0 :: S+ type family S2Sym0 :: S where+ S2Sym0 = S2+ type TFHelper_0123456789876543210 :: forall a. T a ()+ -> T a () -> Bool+ type family TFHelper_0123456789876543210 @a (a :: T a ()) (a :: T a ()) :: Bool where+ TFHelper_0123456789876543210 @a ((:*:) a_0123456789876543210 a_0123456789876543210 :: T a ()) ((:*:) b_0123456789876543210 b_0123456789876543210 :: T a ()) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)+ instance PEq (T a ()) where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: forall a. T a ()+ -> T a () -> Ordering+ type family Compare_0123456789876543210 @a (a :: T a ()) (a :: T a ()) :: Ordering where+ Compare_0123456789876543210 @a ((:*:) a_0123456789876543210 a_0123456789876543210 :: T a ()) ((:*:) b_0123456789876543210 b_0123456789876543210 :: T a ()) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0))+ instance POrd (T a ()) where+ type Compare a a = Compare_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: forall a. GHC.Internal.Bignum.Natural.Natural+ -> T a () -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 @a (a :: GHC.Internal.Bignum.Natural.Natural) (a :: T a ()) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) ((:*:) argL_0123456789876543210 argR_0123456789876543210 :: T a ()) (a_0123456789876543210 :: Symbol) = 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+ instance PShow (T a ()) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type TFHelper_0123456789876543210 :: S -> S -> Bool+ type family TFHelper_0123456789876543210 (a :: S) (a :: S) :: Bool where+ TFHelper_0123456789876543210 S1 S1 = TrueSym0+ TFHelper_0123456789876543210 S1 S2 = FalseSym0+ TFHelper_0123456789876543210 S2 S1 = FalseSym0+ TFHelper_0123456789876543210 S2 S2 = TrueSym0+ instance PEq S where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: S -> S -> Ordering+ type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where+ Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 S1 S2 = LTSym0+ Compare_0123456789876543210 S2 S1 = GTSym0+ instance POrd S where+ type Compare a a = Compare_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> S -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (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+ instance PShow S where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type MinBound_0123456789876543210 :: S+ type family MinBound_0123456789876543210 :: S where+ MinBound_0123456789876543210 = S1Sym0+ type MaxBound_0123456789876543210 :: S+ type family MaxBound_0123456789876543210 :: S where+ MaxBound_0123456789876543210 = S2Sym0+ instance PBounded S where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = S2Sym0+ LamCases_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = S1Sym0+ LamCases_0123456789876543210 n 'False = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 1))+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> S+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: S where+ ToEnum_0123456789876543210 n = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 0))+ type FromEnum_0123456789876543210 :: S+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: S) :: GHC.Internal.Bignum.Natural.Natural where+ FromEnum_0123456789876543210 S1 = FromInteger 0+ FromEnum_0123456789876543210 S2 = FromInteger 1+ instance PEnum S where+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ infixl 6 data :%*:+ data ST :: forall a b. T a b -> Type+ where+ (:%*:) :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> ST ((:*:) n n :: T a b)+ type instance Sing @(T a b) = ST+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%*:) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ data SS :: S -> Type+ where+ SS1 :: SS (S1 :: S)+ SS2 :: SS (S2 :: S)+ type instance Sing @S = SS+ instance SingKind S where+ type Demote S = S+ fromSing SS1 = S1+ fromSing SS2 = S2+ toSing S1 = SomeSing SS1+ toSing S2 = SomeSing SS2+ instance SEq a => SEq (T a ()) where+ (%==)+ ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210))+ ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210)+ (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)+ instance SOrd a => SOrd (T a ()) where+ 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 @(<>@#@$) (%<>)))+ 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+ (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 SEq S where+ (%==) SS1 SS1 = STrue+ (%==) SS1 SS2 = SFalse+ (%==) SS2 SS1 = SFalse+ (%==) SS2 SS2 = STrue+ instance SOrd S where+ sCompare SS1 SS1+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SS2 SS2+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SS1 SS2 = SLT+ sCompare SS2 SS1 = SGT+ instance SShow S where+ 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 = SS1+ sMaxBound = SS2+ instance SEnum S where+ sToEnum (sN :: Sing n)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SS1+ SFalse+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SS2+ SFalse+ -> applySing+ (singFun1 @ErrorSym0 sError)+ (sing :: Sing "toEnum: bad argument")))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 1)))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 0)))+ sFromEnum SS1 = sFromInteger (sing :: Sing 0)+ sFromEnum SS2 = sFromInteger (sing :: Sing 1)+ instance SDecide a => SDecide (T a ()) where+ (%~) ((:%*:) a a) ((:%*:) b b)+ = (\cases+ (Proved Refl) (Proved Refl) -> Proved Refl+ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b)+ instance Eq (ST (z :: T a ())) where+ (==) _ _ = True+ instance SDecide a =>+ GHC.Internal.Data.Type.Equality.TestEquality (ST :: T a ()+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide a =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (ST :: T a ()+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance SDecide S where+ (%~) SS1 SS1 = Proved Refl+ (%~) SS1 SS2 = Disproved (\case)+ (%~) SS2 SS1 = Disproved (\case)+ (%~) SS2 SS2 = Proved Refl+ instance Eq (SS (z :: S)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (SS :: S+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (SS :: S+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (ST (z :: T a ())) where+ compare _ _ = EQ+ instance Ord (SS (z :: S)) where+ compare _ _ = EQ+ deriving instance Data.Singletons.ShowSing.ShowSing a =>+ Show (ST (z :: T a ()))+ deriving instance Show (SS (z :: S))+ instance (SingI n, SingI n) =>+ SingI ((:*:) (n :: a) (n :: b)) where+ sing = (:%*:) sing sing+ instance SingI n => SingI1 ((:*:) (n :: a)) where+ liftSing = (:%*:) sing+ instance SingI2 (:*:) where+ liftSing2 = (:%*:)+ instance SingI ((:*:@#@$) :: (~>) a ((~>) b (T a b))) where+ sing = singFun2 @(:*:@#@$) (:%*:)+ instance SingI d =>+ SingI ((:*:@#@$$) (d :: a) :: (~>) b (T a b)) where+ sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d))+ instance SingI1 ((:*:@#@$$) :: a -> (~>) b (T a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s)+ instance SingI S1 where+ sing = SS1+ instance SingI S2 where+ sing = SS2
tests/compile-and-dump/Singletons/StandaloneDeriving.hs view
@@ -1,30 +1,30 @@-module Singletons.StandaloneDeriving where - -import Data.Singletons.Base.TH -import Prelude.Singletons -import Text.Show.Singletons - -$(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 +module Singletons.StandaloneDeriving where++import Data.Singletons.Base.TH+import Prelude.Singletons+import Text.Show.Singletons++$(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.golden view
@@ -1,507 +1,415 @@-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 :: Type - type family NatSym0 :: Type where - NatSym0 = Nat - type IntSym0 :: Type - type family IntSym0 :: Type where - IntSym0 = Int - type StringSym0 :: Type - type family StringSym0 :: Type where - StringSym0 = String - type MaybeSym0 :: (~>) Type Type - data MaybeSym0 :: (~>) Type Type - where - MaybeSym0KindInference :: SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => - MaybeSym0 a0123456789876543210 - type instance Apply MaybeSym0 a0123456789876543210 = Maybe a0123456789876543210 - instance SuppressUnusedWarnings MaybeSym0 where - suppressUnusedWarnings = snd ((,) MaybeSym0KindInference ()) - type MaybeSym1 :: Type -> Type - type family MaybeSym1 (a0123456789876543210 :: Type) :: Type where - MaybeSym1 a0123456789876543210 = Maybe a0123456789876543210 - type VecSym0 :: (~>) Type ((~>) Nat Type) - data VecSym0 :: (~>) Type ((~>) Nat Type) - where - VecSym0KindInference :: SameKind (Apply VecSym0 arg) (VecSym1 arg) => - VecSym0 a0123456789876543210 - type instance Apply VecSym0 a0123456789876543210 = VecSym1 a0123456789876543210 - instance SuppressUnusedWarnings VecSym0 where - suppressUnusedWarnings = snd ((,) VecSym0KindInference ()) - type VecSym1 :: Type -> (~>) Nat Type - data VecSym1 (a0123456789876543210 :: Type) :: (~>) Nat Type - where - VecSym1KindInference :: SameKind (Apply (VecSym1 a0123456789876543210) arg) (VecSym2 a0123456789876543210 arg) => - VecSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (VecSym1 a0123456789876543210) a0123456789876543210 = Vec a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (VecSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) VecSym1KindInference ()) - type VecSym2 :: Type -> Nat -> Type - type family VecSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Nat) :: Type where - VecSym2 a0123456789876543210 a0123456789876543210 = Vec a0123456789876543210 a0123456789876543210 - type TFHelper_0123456789876543210 :: Type -> Type -> Bool - type family TFHelper_0123456789876543210 (a :: Type) (a :: Type) :: Bool where - TFHelper_0123456789876543210 Nat Nat = TrueSym0 - TFHelper_0123456789876543210 Nat Int = FalseSym0 - TFHelper_0123456789876543210 Nat String = FalseSym0 - TFHelper_0123456789876543210 Nat (Maybe _) = FalseSym0 - TFHelper_0123456789876543210 Nat (Vec _ _) = FalseSym0 - TFHelper_0123456789876543210 Int Nat = FalseSym0 - TFHelper_0123456789876543210 Int Int = TrueSym0 - TFHelper_0123456789876543210 Int String = FalseSym0 - TFHelper_0123456789876543210 Int (Maybe _) = FalseSym0 - TFHelper_0123456789876543210 Int (Vec _ _) = FalseSym0 - TFHelper_0123456789876543210 String Nat = FalseSym0 - TFHelper_0123456789876543210 String Int = FalseSym0 - TFHelper_0123456789876543210 String String = TrueSym0 - TFHelper_0123456789876543210 String (Maybe _) = FalseSym0 - TFHelper_0123456789876543210 String (Vec _ _) = FalseSym0 - TFHelper_0123456789876543210 (Maybe _) Nat = FalseSym0 - TFHelper_0123456789876543210 (Maybe _) Int = FalseSym0 - TFHelper_0123456789876543210 (Maybe _) String = FalseSym0 - TFHelper_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - TFHelper_0123456789876543210 (Maybe _) (Vec _ _) = FalseSym0 - TFHelper_0123456789876543210 (Vec _ _) Nat = FalseSym0 - TFHelper_0123456789876543210 (Vec _ _) Int = FalseSym0 - TFHelper_0123456789876543210 (Vec _ _) String = FalseSym0 - TFHelper_0123456789876543210 (Vec _ _) (Maybe _) = FalseSym0 - TFHelper_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210) - type TFHelper_0123456789876543210Sym0 :: (~>) Type ((~>) Type Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Type ((~>) Type Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Type -> (~>) Type Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Type) :: (~>) Type Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Type -> Type -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Type where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Type -> Type -> Ordering - type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where - Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)) - 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_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Type -> (~>) Type Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Type) :: (~>) Type Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Type -> Type -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Type where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Type -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Type ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) Type ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) Type ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) Type ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Type -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Type -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Type where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data SRep :: Type -> Type - where - SNat :: SRep (Nat :: Type) - SInt :: SRep (Int :: Type) - SString :: SRep (String :: Type) - SMaybe :: forall (n :: Type). (Sing n) -> SRep (Maybe n :: Type) - SVec :: forall (n :: Type) (n :: Nat). - (Sing n) -> (Sing n) -> SRep (Vec n n :: Type) - type instance Sing @Type = SRep - 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 (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 (SDecide Type, SDecide Nat) => - Data.Type.Equality.TestEquality (SRep :: Type -> Type) where - Data.Type.Equality.testEquality = decideEquality - instance (SDecide Type, SDecide Nat) => - Data.Type.Coercion.TestCoercion (SRep :: Type -> Type) where - Data.Type.Coercion.testCoercion = decideCoercion - instance (SEq Type, SEq Nat) => SEq Type where - (%==) :: - forall (t1 :: Type) (t2 :: Type). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Type ((~>) Type Bool) - -> Type) t1) t2) - (%==) 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 (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210 - (%==) (SMaybe _) (SVec _ _) = SFalse - (%==) (SVec _ _) SNat = SFalse - (%==) (SVec _ _) SInt = SFalse - (%==) (SVec _ _) SString = SFalse - (%==) (SVec _ _) (SMaybe _) = SFalse - (%==) - (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) - (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (singFun2 @(&&@#@$) (%&&)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210)) - (applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210) - 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 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SInt SInt - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SString SString - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare - (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - 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 @(<>@#@$) (%<>))) - 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.Num.Natural.Natural) - (t2 :: Type) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) 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 SingI1 Maybe where - liftSing = SMaybe - instance SingI (MaybeSym0 :: (~>) Type Type) where - sing = singFun1 @MaybeSym0 SMaybe - instance (SingI n, SingI n) => - SingI (Vec (n :: Type) (n :: Nat)) where - sing = SVec sing sing - instance SingI n => SingI1 (Vec (n :: Type)) where - liftSing = SVec sing - instance SingI2 Vec where - liftSing2 = SVec - instance SingI (VecSym0 :: (~>) Type ((~>) Nat Type)) where - sing = singFun2 @VecSym0 SVec - instance SingI d => - SingI (VecSym1 (d :: Type) :: (~>) Nat Type) where - sing = singFun1 @(VecSym1 (d :: Type)) (SVec (sing @d)) - instance SingI1 (VecSym1 :: Type -> (~>) Nat Type) where - liftSing (s :: Sing (d :: Type)) - = singFun1 @(VecSym1 (d :: Type)) (SVec s) +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 :: Type+ type family NatSym0 :: Type where+ NatSym0 = Nat+ type IntSym0 :: Type+ type family IntSym0 :: Type where+ IntSym0 = Int+ type StringSym0 :: Type+ type family StringSym0 :: Type where+ StringSym0 = String+ type MaybeSym0 :: (~>) Type Type+ data MaybeSym0 :: (~>) Type Type+ where+ MaybeSym0KindInference :: SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) =>+ MaybeSym0 a0123456789876543210+ type instance Apply @Type @Type MaybeSym0 a0123456789876543210 = Maybe a0123456789876543210+ instance SuppressUnusedWarnings MaybeSym0 where+ suppressUnusedWarnings = snd ((,) MaybeSym0KindInference ())+ type MaybeSym1 :: Type -> Type+ type family MaybeSym1 (a0123456789876543210 :: Type) :: Type where+ MaybeSym1 a0123456789876543210 = Maybe a0123456789876543210+ type VecSym0 :: (~>) Type ((~>) Nat Type)+ data VecSym0 :: (~>) Type ((~>) Nat Type)+ where+ VecSym0KindInference :: SameKind (Apply VecSym0 arg) (VecSym1 arg) =>+ VecSym0 a0123456789876543210+ type instance Apply @Type @((~>) Nat Type) VecSym0 a0123456789876543210 = VecSym1 a0123456789876543210+ instance SuppressUnusedWarnings VecSym0 where+ suppressUnusedWarnings = snd ((,) VecSym0KindInference ())+ type VecSym1 :: Type -> (~>) Nat Type+ data VecSym1 (a0123456789876543210 :: Type) :: (~>) Nat Type+ where+ VecSym1KindInference :: SameKind (Apply (VecSym1 a0123456789876543210) arg) (VecSym2 a0123456789876543210 arg) =>+ VecSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Type (VecSym1 a0123456789876543210) a0123456789876543210 = Vec a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (VecSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) VecSym1KindInference ())+ type VecSym2 :: Type -> Nat -> Type+ type family VecSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Nat) :: Type where+ VecSym2 a0123456789876543210 a0123456789876543210 = Vec a0123456789876543210 a0123456789876543210+ type TFHelper_0123456789876543210 :: Type -> Type -> Bool+ type family TFHelper_0123456789876543210 (a :: Type) (a :: Type) :: Bool where+ TFHelper_0123456789876543210 Nat Nat = TrueSym0+ TFHelper_0123456789876543210 Nat Int = FalseSym0+ TFHelper_0123456789876543210 Nat String = FalseSym0+ TFHelper_0123456789876543210 Nat (Maybe _) = FalseSym0+ TFHelper_0123456789876543210 Nat (Vec _ _) = FalseSym0+ TFHelper_0123456789876543210 Int Nat = FalseSym0+ TFHelper_0123456789876543210 Int Int = TrueSym0+ TFHelper_0123456789876543210 Int String = FalseSym0+ TFHelper_0123456789876543210 Int (Maybe _) = FalseSym0+ TFHelper_0123456789876543210 Int (Vec _ _) = FalseSym0+ TFHelper_0123456789876543210 String Nat = FalseSym0+ TFHelper_0123456789876543210 String Int = FalseSym0+ TFHelper_0123456789876543210 String String = TrueSym0+ TFHelper_0123456789876543210 String (Maybe _) = FalseSym0+ TFHelper_0123456789876543210 String (Vec _ _) = FalseSym0+ TFHelper_0123456789876543210 (Maybe _) Nat = FalseSym0+ TFHelper_0123456789876543210 (Maybe _) Int = FalseSym0+ TFHelper_0123456789876543210 (Maybe _) String = FalseSym0+ TFHelper_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ TFHelper_0123456789876543210 (Maybe _) (Vec _ _) = FalseSym0+ TFHelper_0123456789876543210 (Vec _ _) Nat = FalseSym0+ TFHelper_0123456789876543210 (Vec _ _) Int = FalseSym0+ TFHelper_0123456789876543210 (Vec _ _) String = FalseSym0+ TFHelper_0123456789876543210 (Vec _ _) (Maybe _) = FalseSym0+ TFHelper_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (&&@#@$) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210)+ instance PEq Type where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: Type -> Type -> Ordering+ type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where+ Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0))+ 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+ instance POrd Type where+ type Compare a a = Compare_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Type -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (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+ instance PShow Type where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data SRep :: Type -> Type+ where+ SNat :: SRep (Nat :: Type)+ SInt :: SRep (Int :: Type)+ SString :: SRep (String :: Type)+ SMaybe :: forall (n :: Type). (Sing n) -> SRep (Maybe n :: Type)+ SVec :: forall (n :: Type) (n :: Nat).+ (Sing n) -> (Sing n) -> SRep (Vec n n :: Type)+ type instance Sing @Type = SRep+ 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))+ = (\cases (SomeSing c) -> SomeSing (SMaybe c))+ (toSing b :: SomeSing Type)+ toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SVec c c))+ (toSing b :: SomeSing Type) (toSing b :: SomeSing Nat)+ instance (SDecide Type, SDecide Nat) => SDecide Type where+ (%~) SNat SNat = Proved Refl+ (%~) SNat SInt = Disproved (\case)+ (%~) SNat SString = Disproved (\case)+ (%~) SNat (SMaybe _) = Disproved (\case)+ (%~) SNat (SVec _ _) = Disproved (\case)+ (%~) SInt SNat = Disproved (\case)+ (%~) SInt SInt = Proved Refl+ (%~) SInt SString = Disproved (\case)+ (%~) SInt (SMaybe _) = Disproved (\case)+ (%~) SInt (SVec _ _) = Disproved (\case)+ (%~) SString SNat = Disproved (\case)+ (%~) SString SInt = Disproved (\case)+ (%~) SString SString = Proved Refl+ (%~) SString (SMaybe _) = Disproved (\case)+ (%~) SString (SVec _ _) = Disproved (\case)+ (%~) (SMaybe _) SNat = Disproved (\case)+ (%~) (SMaybe _) SInt = Disproved (\case)+ (%~) (SMaybe _) SString = Disproved (\case)+ (%~) (SMaybe a) (SMaybe b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ (%~) (SMaybe _) (SVec _ _) = Disproved (\case)+ (%~) (SVec _ _) SNat = Disproved (\case)+ (%~) (SVec _ _) SInt = Disproved (\case)+ (%~) (SVec _ _) SString = Disproved (\case)+ (%~) (SVec _ _) (SMaybe _) = Disproved (\case)+ (%~) (SVec a a) (SVec b b)+ = (\cases+ (Proved Refl) (Proved Refl) -> Proved Refl+ (Disproved contra) _ -> Disproved (\cases Refl -> contra Refl)+ _ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b) ((%~) a b)+ instance Eq (SRep (z :: Type)) where+ (==) _ _ = True+ instance (SDecide Type, SDecide Nat) =>+ GHC.Internal.Data.Type.Equality.TestEquality (SRep :: Type+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality = decideEquality+ instance (SDecide Type, SDecide Nat) =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SRep :: Type+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion = decideCoercion+ 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 (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ (%==) (SMaybe _) (SVec _ _) = SFalse+ (%==) (SVec _ _) SNat = SFalse+ (%==) (SVec _ _) SInt = SFalse+ (%==) (SVec _ _) SString = SFalse+ (%==) (SVec _ _) (SMaybe _) = SFalse+ (%==)+ (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210)+ (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (singFun2 @(&&@#@$) (%&&))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210)+ instance (SOrd Type, SOrd Nat) => SOrd Type where+ sCompare SNat SNat+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SInt SInt+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SString SString+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare+ (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ 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 @(<>@#@$) (%<>)))+ 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+ _+ 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 SingI1 Maybe where+ liftSing = SMaybe+ instance SingI (MaybeSym0 :: (~>) Type Type) where+ sing = singFun1 @MaybeSym0 SMaybe+ instance (SingI n, SingI n) =>+ SingI (Vec (n :: Type) (n :: Nat)) where+ sing = SVec sing sing+ instance SingI n => SingI1 (Vec (n :: Type)) where+ liftSing = SVec sing+ instance SingI2 Vec where+ liftSing2 = SVec+ instance SingI (VecSym0 :: (~>) Type ((~>) Nat Type)) where+ sing = singFun2 @VecSym0 SVec+ instance SingI d =>+ SingI (VecSym1 (d :: Type) :: (~>) Nat Type) where+ sing = singFun1 @(VecSym1 (d :: Type)) (SVec (sing @d))+ instance SingI1 (VecSym1 :: Type -> (~>) Nat Type) where+ liftSing (s :: Sing (d :: Type))+ = singFun1 @(VecSym1 (d :: Type)) (SVec s)
tests/compile-and-dump/Singletons/Star.hs view
@@ -1,13 +1,13 @@-module Singletons.Star where - -import Data.Singletons.Decide -import Data.Singletons.Base.CustomStar -import Prelude.Singletons -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]) +module Singletons.Star where++import Data.Singletons.Decide+import Data.Singletons.Base.CustomStar+import Prelude.Singletons+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.golden view
@@ -1,37 +1,36 @@-Singletons/T124.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: Bool -> () - foo True = () - foo False = () |] - ======> - foo :: Bool -> () - foo True = () - foo False = () - type FooSym0 :: (~>) Bool () - data FooSym0 :: (~>) Bool () - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: Bool -> () - type family FooSym1 (a0123456789876543210 :: Bool) :: () where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Foo :: Bool -> () - type family Foo (a :: Bool) :: () where - Foo 'True = Tuple0Sym0 - Foo 'False = Tuple0Sym0 - sFoo :: - (forall (t :: Bool). - Sing t -> Sing (Apply FooSym0 t :: ()) :: Type) - 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 +Singletons/T124.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| foo :: Bool -> ()+ foo True = ()+ foo False = () |]+ ======>+ foo :: Bool -> ()+ foo True = ()+ foo False = ()+ type FooSym0 :: (~>) Bool ()+ data FooSym0 :: (~>) Bool ()+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @Bool @() FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: Bool -> ()+ type family FooSym1 (a0123456789876543210 :: Bool) :: () where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Foo :: Bool -> ()+ type family Foo (a :: Bool) :: () where+ Foo 'True = Tuple0Sym0+ Foo 'False = Tuple0Sym0+ sFoo :: (forall (t :: Bool). Sing t -> Sing (Foo t :: ()) :: Type)+ 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 |]+ ======>+ (\cases+ SFalse -> STuple0+ STrue -> STuple0)+ b
tests/compile-and-dump/Singletons/T124.hs view
@@ -1,13 +1,13 @@-module Singletons.T124 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - foo :: Bool -> () - foo True = () - foo False = () - |]) - -bar :: SBool b -> STuple0 (Foo b) -bar b = $(sCases ''Bool [| b |] [| STuple0 |]) +module Singletons.T124 where++import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,186 +1,157 @@-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 Succ_0123456789876543210 :: [Bool] -> [Bool] - type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where - Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) NilSym0 - Succ_0123456789876543210 ('(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as - Succ_0123456789876543210 ('(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as) - type Succ_0123456789876543210Sym0 :: (~>) [Bool] [Bool] - data Succ_0123456789876543210Sym0 :: (~>) [Bool] [Bool] - where - Succ_0123456789876543210Sym0KindInference :: SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => - Succ_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Succ_0123456789876543210Sym0 a0123456789876543210 = Succ_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Succ_0123456789876543210Sym0KindInference ()) - type Succ_0123456789876543210Sym1 :: [Bool] -> [Bool] - type family Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) :: [Bool] where - Succ_0123456789876543210Sym1 a0123456789876543210 = Succ_0123456789876543210 a0123456789876543210 - type Pred_0123456789876543210 :: [Bool] -> [Bool] - 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_0123456789876543210Sym0 :: (~>) [Bool] [Bool] - data Pred_0123456789876543210Sym0 :: (~>) [Bool] [Bool] - where - Pred_0123456789876543210Sym0KindInference :: SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => - Pred_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Pred_0123456789876543210Sym0 a0123456789876543210 = Pred_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Pred_0123456789876543210Sym0KindInference ()) - type Pred_0123456789876543210Sym1 :: [Bool] -> [Bool] - type family Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) :: [Bool] where - Pred_0123456789876543210Sym1 a0123456789876543210 = Pred_0123456789876543210 a0123456789876543210 - type family Case_0123456789876543210 i arg_0123456789876543210 t where - Case_0123456789876543210 i arg_0123456789876543210 'True = NilSym0 - 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 ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural - -> [Bool] - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: [Bool] where - ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural [Bool] - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural [Bool] - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> [Bool] - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: [Bool] where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: [Bool] - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Num.Natural.Natural 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_0123456789876543210Sym0 :: (~>) [Bool] GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) [Bool] GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: [Bool] - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 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] -> Type) t) - sPred :: - forall (t :: [Bool]). Sing t - -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] -> Type) t) - sToEnum :: - forall (t :: GHC.Num.Natural.Natural). Sing t - -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Num.Natural.Natural [Bool] - -> Type) t) - sFromEnum :: - forall (t :: [Bool]). Sing t - -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Num.Natural.Natural - -> 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) - = id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210)) - (case sArg_0123456789876543210 of - (sI :: Sing i) - -> id - @(Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(<@#@$) (%<)) sI) - (sFromInteger (sing :: Sing 0)) - of - STrue -> sError (sing :: Sing "negative toEnum") - SFalse - -> id - @(Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)))) - (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))))) - 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)) +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 Succ_0123456789876543210 :: [Bool] -> [Bool]+ type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where+ Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) NilSym0+ Succ_0123456789876543210 ('(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as+ Succ_0123456789876543210 ('(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as)+ type Pred_0123456789876543210 :: [Bool] -> [Bool]+ 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 family LamCases_0123456789876543210 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 i arg_0123456789876543210 'True = NilSym0+ LamCases_0123456789876543210 i arg_0123456789876543210 'False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i))+ data LamCases_0123456789876543210Sym0 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 i0123456789876543210 arg_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 i arg_0123456789876543210 'True = Apply ErrorSym0 "negative toEnum"+ LamCases_0123456789876543210 i arg_0123456789876543210 'False = Apply (LamCases_0123456789876543210Sym0 i arg_0123456789876543210) (Apply (Apply (==@#@$) i) (FromInteger 0))+ data LamCases_0123456789876543210Sym0 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 i0123456789876543210 arg_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 i0123456789876543210 arg_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 i0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 i0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 arg_0123456789876543210 i = Apply (LamCases_0123456789876543210Sym0 i arg_0123456789876543210) (Apply (Apply (<@#@$) i) (FromInteger 0))+ data LamCases_0123456789876543210Sym0 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 arg_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 arg_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 arg_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 arg_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (arg_01234567898765432100123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 arg_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> [Bool]+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: [Bool] where+ ToEnum_0123456789876543210 arg_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 arg_0123456789876543210) arg_0123456789876543210+ type FromEnum_0123456789876543210 :: [Bool]+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Internal.Bignum.Natural.Natural 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))+ instance PEnum [Bool] where+ type Succ a = Succ_0123456789876543210 a+ type Pred a = Pred_0123456789876543210 a+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ instance SEnum [Bool] where+ 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+ = applySing (singFun1 @ErrorSym0 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)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 arg_0123456789876543210)+ (\cases+ (sI :: Sing i)+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 i arg_0123456789876543210)+ (\cases+ STrue+ -> applySing+ (singFun1 @ErrorSym0 sError) (sing :: Sing "negative toEnum")+ SFalse+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 i arg_0123456789876543210)+ (\cases+ STrue -> SNil+ SFalse+ -> applySing+ (singFun1 @SuccSym0 sSucc)+ (applySing+ (singFun1 @ToEnumSym0 sToEnum)+ (applySing (singFun1 @PredSym0 sPred) sI))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sI)+ (sFromInteger (sing :: Sing 0)))))+ (applySing+ (applySing (singFun2 @(<@#@$) (%<)) sI)+ (sFromInteger (sing :: Sing 0)))))+ sArg_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 view
@@ -1,27 +1,27 @@-module Binary where - -import Data.Singletons.Base.Enum -import Data.Singletons.TH -import Prelude.Singletons - -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 - |]) +module Binary where++import Data.Singletons.Base.Enum+import Data.Singletons.TH+import Prelude.Singletons++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.golden view
@@ -1,55 +1,39 @@-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 MethSym0 :: forall a. (~>) a a - data MethSym0 :: (~>) a a - where - MethSym0KindInference :: SameKind (Apply MethSym0 arg) (MethSym1 arg) => - MethSym0 a0123456789876543210 - type instance Apply MethSym0 a0123456789876543210 = Meth a0123456789876543210 - instance SuppressUnusedWarnings MethSym0 where - suppressUnusedWarnings = snd ((,) MethSym0KindInference ()) - type MethSym1 :: forall a. a -> a - type family MethSym1 (a0123456789876543210 :: a) :: a where - MethSym1 a0123456789876543210 = Meth a0123456789876543210 - class PC a where - type family Meth (arg :: a) :: a - class SC a where - sMeth :: - (forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) :: Type) - 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 Meth_0123456789876543210 :: Bool -> Bool - type family Meth_0123456789876543210 (a :: Bool) :: Bool where - Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym0 :: (~>) Bool Bool - data Meth_0123456789876543210Sym0 :: (~>) Bool Bool - where - Meth_0123456789876543210Sym0KindInference :: SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => - Meth_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Meth_0123456789876543210Sym0KindInference ()) - type Meth_0123456789876543210Sym1 :: Bool -> Bool - type family Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) :: Bool where - Meth_0123456789876543210Sym1 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 -> Type) t) - sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing (singFun1 @NotSym0 sNot) sA_0123456789876543210 +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 MethSym0 :: forall a. (~>) a a+ data MethSym0 :: (~>) a a+ where+ MethSym0KindInference :: SameKind (Apply MethSym0 arg) (MethSym1 arg) =>+ MethSym0 a0123456789876543210+ type instance Apply @a @a MethSym0 a0123456789876543210 = Meth a0123456789876543210+ instance SuppressUnusedWarnings MethSym0 where+ suppressUnusedWarnings = snd ((,) MethSym0KindInference ())+ type MethSym1 :: forall a. a -> a+ type family MethSym1 @a (a0123456789876543210 :: a) :: a where+ MethSym1 a0123456789876543210 = Meth a0123456789876543210+ class PC a where+ type family Meth (arg :: a) :: a+ class SC a where+ sMeth :: (forall (t :: a). Sing t -> Sing (Meth t :: a) :: Type)+ 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 Meth_0123456789876543210 :: Bool -> Bool+ type family Meth_0123456789876543210 (a :: Bool) :: Bool where+ Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210+ instance PC Bool where+ type Meth a = Meth_0123456789876543210 a+ instance SC Bool where+ sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing (singFun1 @NotSym0 sNot) sA_0123456789876543210
tests/compile-and-dump/Singletons/T136b.hs view
@@ -1,14 +1,14 @@-module T136b where - -import Data.Bool.Singletons -import Data.Singletons.TH - -$(singletons [d| - class C a where - meth :: a -> a - |]) - -$(singletons [d| - instance C Bool where - meth = not - |]) +module T136b where++import Data.Bool.Singletons+import Data.Singletons.TH++$(singletons [d|+ class C a where+ meth :: a -> a+ |])++$(singletons [d|+ instance C Bool where+ meth = not+ |])
tests/compile-and-dump/Singletons/T145.golden view
@@ -1,42 +1,41 @@-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 ColSym0 :: forall f a. (~>) (f a) ((~>) a Bool) - data ColSym0 :: (~>) (f a) ((~>) a Bool) - where - ColSym0KindInference :: SameKind (Apply ColSym0 arg) (ColSym1 arg) => - ColSym0 a0123456789876543210 - type instance Apply ColSym0 a0123456789876543210 = ColSym1 a0123456789876543210 - instance SuppressUnusedWarnings ColSym0 where - suppressUnusedWarnings = snd ((,) ColSym0KindInference ()) - type ColSym1 :: forall f a. f a -> (~>) a Bool - data ColSym1 (a0123456789876543210 :: f a) :: (~>) a Bool - where - ColSym1KindInference :: SameKind (Apply (ColSym1 a0123456789876543210) arg) (ColSym2 a0123456789876543210 arg) => - ColSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ColSym1 a0123456789876543210) a0123456789876543210 = Col a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ColSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ColSym1KindInference ()) - type ColSym2 :: forall f a. f a -> a -> Bool - type family ColSym2 (a0123456789876543210 :: f a) (a0123456789876543210 :: a) :: Bool where - ColSym2 a0123456789876543210 a0123456789876543210 = Col a0123456789876543210 a0123456789876543210 - class PColumn (f :: Type -> Type) where - type family Col (arg :: f a) (arg :: a) :: Bool - class SColumn (f :: Type -> Type) where - sCol :: - (forall (t :: f a) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool) :: Type) - 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)) - instance SColumn f => SingI1 (ColSym1 :: f a -> (~>) a Bool) where - liftSing (s :: Sing (d :: f a)) - = singFun1 @(ColSym1 (d :: f a)) (sCol s) +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 ColSym0 :: forall f a. (~>) (f a) ((~>) a Bool)+ data ColSym0 :: (~>) (f a) ((~>) a Bool)+ where+ ColSym0KindInference :: SameKind (Apply ColSym0 arg) (ColSym1 arg) =>+ ColSym0 a0123456789876543210+ type instance Apply @(f a) @((~>) a Bool) ColSym0 a0123456789876543210 = ColSym1 a0123456789876543210+ instance SuppressUnusedWarnings ColSym0 where+ suppressUnusedWarnings = snd ((,) ColSym0KindInference ())+ type ColSym1 :: forall f a. f a -> (~>) a Bool+ data ColSym1 (a0123456789876543210 :: f a) :: (~>) a Bool+ where+ ColSym1KindInference :: SameKind (Apply (ColSym1 a0123456789876543210) arg) (ColSym2 a0123456789876543210 arg) =>+ ColSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @Bool (ColSym1 a0123456789876543210) a0123456789876543210 = Col a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ColSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ColSym1KindInference ())+ type ColSym2 :: forall f a. f a -> a -> Bool+ type family ColSym2 @f @a (a0123456789876543210 :: f a) (a0123456789876543210 :: a) :: Bool where+ ColSym2 a0123456789876543210 a0123456789876543210 = Col a0123456789876543210 a0123456789876543210+ class PColumn (f :: Type -> Type) where+ type family Col (arg :: f a) (arg :: a) :: Bool+ class SColumn (f :: Type -> Type) where+ sCol ::+ (forall (t :: f a) (t :: a).+ Sing t -> Sing t -> Sing (Col t t :: Bool) :: Type)+ 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))+ instance SColumn f => SingI1 (ColSym1 :: f a -> (~>) a Bool) where+ liftSing (s :: Sing (d :: f a))+ = singFun1 @(ColSym1 (d :: f a)) (sCol s)
tests/compile-and-dump/Singletons/T145.hs view
@@ -1,9 +1,9 @@-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 - |]) +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/T150.golden view
@@ -1,417 +1,424 @@-Singletons/T150.hs:(0,0)-(0,0): Splicing declarations - withOptions defaultOptions {genSingKindInsts = False} - $ singletons - $ lift - [d| headVec :: Vec (Succ n) a -> a - headVec (VCons x _) = x - tailVec :: Vec (Succ n) a -> Vec n a - tailVec (VCons _ xs) = xs - (!) :: Vec n a -> Fin n -> a - VCons x _ ! FZ = x - VCons _ xs ! FS n = xs ! n - VNil ! n = case n of {} - mapVec :: (a -> b) -> Vec n a -> Vec n b - mapVec _ VNil = VNil - mapVec f (VCons x xs) = VCons (f x) (mapVec f xs) - symmetry :: Equal a b -> Equal b a - symmetry Reflexive = Reflexive - transitivity :: Equal a b -> Equal b c -> Equal a c - transitivity Reflexive Reflexive = Reflexive - - data Fin :: Nat -> Type - where - FZ :: Fin (Succ n) - FS :: Fin n -> Fin (Succ n) - data Foo :: Type -> Type - where - MkFoo1 :: Foo Bool - MkFoo2 :: Foo Ordering - data Vec :: Nat -> Type -> Type - where - VNil :: Vec Zero a - VCons :: a -> Vec n a -> Vec (Succ n) a - data Equal :: Type -> Type -> Type where Reflexive :: Equal a a - data HList :: [Type] -> Type - where - HNil :: HList '[] - HCons :: x -> HList xs -> HList (x : xs) - data Obj :: Type where Obj :: a -> Obj |] - ======> - data Fin :: Nat -> Type - where - FZ :: Fin ('Succ n) - FS :: (Fin n) -> Fin ('Succ n) - data Foo :: Type -> Type - where - MkFoo1 :: Foo Bool - MkFoo2 :: Foo Ordering - data Vec :: Nat -> Type -> Type - where - VNil :: Vec 'Zero a - VCons :: a -> (Vec n a) -> Vec ('Succ n) a - headVec :: Vec ('Succ n) a -> a - headVec (VCons x _) = x - tailVec :: Vec ('Succ n) a -> Vec n a - tailVec (VCons _ xs) = xs - (!) :: Vec n a -> Fin n -> a - (!) (VCons x _) FZ = x - (!) (VCons _ xs) (FS n) = (xs ! n) - (!) VNil n = case n of {} - mapVec :: (a -> b) -> Vec n a -> Vec n b - mapVec _ VNil = VNil - mapVec f (VCons x xs) = VCons (f x) (mapVec f xs) - data Equal :: Type -> Type -> Type where Reflexive :: Equal a a - symmetry :: Equal a b -> Equal b a - symmetry Reflexive = Reflexive - transitivity :: Equal a b -> Equal b c -> Equal a c - transitivity Reflexive Reflexive = Reflexive - data HList :: [Type] -> Type - where - HNil :: HList '[] - HCons :: x -> (HList xs) -> HList ('(:) x xs) - data Obj :: Type where Obj :: a -> Obj - type FZSym0 :: Fin ('Succ n) - type family FZSym0 :: Fin ('Succ n) where - FZSym0 = FZ - type FSSym0 :: (~>) (Fin n) (Fin ('Succ n)) - data FSSym0 :: (~>) (Fin n) (Fin ('Succ n)) - where - FSSym0KindInference :: SameKind (Apply FSSym0 arg) (FSSym1 arg) => - FSSym0 a0123456789876543210 - type instance Apply FSSym0 a0123456789876543210 = FS a0123456789876543210 - instance SuppressUnusedWarnings FSSym0 where - suppressUnusedWarnings = snd ((,) FSSym0KindInference ()) - type FSSym1 :: Fin n -> Fin ('Succ n) - type family FSSym1 (a0123456789876543210 :: Fin n) :: Fin ('Succ n) where - FSSym1 a0123456789876543210 = FS a0123456789876543210 - type MkFoo1Sym0 :: Foo Bool - type family MkFoo1Sym0 :: Foo Bool where - MkFoo1Sym0 = MkFoo1 - type MkFoo2Sym0 :: Foo Ordering - type family MkFoo2Sym0 :: Foo Ordering where - MkFoo2Sym0 = MkFoo2 - type VNilSym0 :: Vec 'Zero a - type family VNilSym0 :: Vec 'Zero a where - VNilSym0 = VNil - type VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a)) - data VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a)) - where - VConsSym0KindInference :: SameKind (Apply VConsSym0 arg) (VConsSym1 arg) => - VConsSym0 a0123456789876543210 - type instance Apply VConsSym0 a0123456789876543210 = VConsSym1 a0123456789876543210 - instance SuppressUnusedWarnings VConsSym0 where - suppressUnusedWarnings = snd ((,) VConsSym0KindInference ()) - type VConsSym1 :: a -> (~>) (Vec n a) (Vec ('Succ n) a) - data VConsSym1 (a0123456789876543210 :: a) :: (~>) (Vec n a) (Vec ('Succ n) a) - where - VConsSym1KindInference :: SameKind (Apply (VConsSym1 a0123456789876543210) arg) (VConsSym2 a0123456789876543210 arg) => - VConsSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (VConsSym1 a0123456789876543210) a0123456789876543210 = VCons a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (VConsSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) VConsSym1KindInference ()) - type VConsSym2 :: a -> Vec n a -> Vec ('Succ n) a - type family VConsSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: Vec n a) :: Vec ('Succ n) a where - VConsSym2 a0123456789876543210 a0123456789876543210 = VCons a0123456789876543210 a0123456789876543210 - type ReflexiveSym0 :: Equal a a - type family ReflexiveSym0 :: Equal a a where - ReflexiveSym0 = Reflexive - type HNilSym0 :: HList '[] - type family HNilSym0 :: HList '[] where - HNilSym0 = HNil - type HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs))) - data HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs))) - where - HConsSym0KindInference :: SameKind (Apply HConsSym0 arg) (HConsSym1 arg) => - HConsSym0 a0123456789876543210 - type instance Apply HConsSym0 a0123456789876543210 = HConsSym1 a0123456789876543210 - instance SuppressUnusedWarnings HConsSym0 where - suppressUnusedWarnings = snd ((,) HConsSym0KindInference ()) - type HConsSym1 :: x -> (~>) (HList xs) (HList ('(:) x xs)) - data HConsSym1 (a0123456789876543210 :: x) :: (~>) (HList xs) (HList ('(:) x xs)) - where - HConsSym1KindInference :: SameKind (Apply (HConsSym1 a0123456789876543210) arg) (HConsSym2 a0123456789876543210 arg) => - HConsSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (HConsSym1 a0123456789876543210) a0123456789876543210 = HCons a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (HConsSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) HConsSym1KindInference ()) - type HConsSym2 :: x -> HList xs -> HList ('(:) x xs) - type family HConsSym2 (a0123456789876543210 :: x) (a0123456789876543210 :: HList xs) :: HList ('(:) x xs) where - HConsSym2 a0123456789876543210 a0123456789876543210 = HCons a0123456789876543210 a0123456789876543210 - type ObjSym0 :: (~>) a Obj - data ObjSym0 :: (~>) a Obj - where - ObjSym0KindInference :: SameKind (Apply ObjSym0 arg) (ObjSym1 arg) => - ObjSym0 a0123456789876543210 - type instance Apply ObjSym0 a0123456789876543210 = Obj a0123456789876543210 - instance SuppressUnusedWarnings ObjSym0 where - suppressUnusedWarnings = snd ((,) ObjSym0KindInference ()) - type ObjSym1 :: a -> Obj - type family ObjSym1 (a0123456789876543210 :: a) :: Obj where - ObjSym1 a0123456789876543210 = Obj a0123456789876543210 - type family Case_0123456789876543210 n t where - type TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c)) - data TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c)) - where - TransitivitySym0KindInference :: SameKind (Apply TransitivitySym0 arg) (TransitivitySym1 arg) => - TransitivitySym0 a0123456789876543210 - type instance Apply TransitivitySym0 a0123456789876543210 = TransitivitySym1 a0123456789876543210 - instance SuppressUnusedWarnings TransitivitySym0 where - suppressUnusedWarnings = snd ((,) TransitivitySym0KindInference ()) - type TransitivitySym1 :: Equal a b -> (~>) (Equal b c) (Equal a c) - data TransitivitySym1 (a0123456789876543210 :: Equal a b) :: (~>) (Equal b c) (Equal a c) - where - TransitivitySym1KindInference :: SameKind (Apply (TransitivitySym1 a0123456789876543210) arg) (TransitivitySym2 a0123456789876543210 arg) => - TransitivitySym1 a0123456789876543210 a0123456789876543210 - type instance Apply (TransitivitySym1 a0123456789876543210) a0123456789876543210 = Transitivity a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (TransitivitySym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) TransitivitySym1KindInference ()) - type TransitivitySym2 :: Equal a b -> Equal b c -> Equal a c - type family TransitivitySym2 (a0123456789876543210 :: Equal a b) (a0123456789876543210 :: Equal b c) :: Equal a c where - TransitivitySym2 a0123456789876543210 a0123456789876543210 = Transitivity a0123456789876543210 a0123456789876543210 - type SymmetrySym0 :: (~>) (Equal a b) (Equal b a) - data SymmetrySym0 :: (~>) (Equal a b) (Equal b a) - where - SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => - SymmetrySym0 a0123456789876543210 - type instance Apply SymmetrySym0 a0123456789876543210 = Symmetry a0123456789876543210 - instance SuppressUnusedWarnings SymmetrySym0 where - suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ()) - type SymmetrySym1 :: Equal a b -> Equal b a - type family SymmetrySym1 (a0123456789876543210 :: Equal a b) :: Equal b a where - SymmetrySym1 a0123456789876543210 = Symmetry a0123456789876543210 - type MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b)) - data MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b)) - where - MapVecSym0KindInference :: SameKind (Apply MapVecSym0 arg) (MapVecSym1 arg) => - MapVecSym0 a0123456789876543210 - type instance Apply MapVecSym0 a0123456789876543210 = MapVecSym1 a0123456789876543210 - instance SuppressUnusedWarnings MapVecSym0 where - suppressUnusedWarnings = snd ((,) MapVecSym0KindInference ()) - type MapVecSym1 :: (~>) a b -> (~>) (Vec n a) (Vec n b) - data MapVecSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Vec n a) (Vec n b) - where - MapVecSym1KindInference :: SameKind (Apply (MapVecSym1 a0123456789876543210) arg) (MapVecSym2 a0123456789876543210 arg) => - MapVecSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MapVecSym1 a0123456789876543210) a0123456789876543210 = MapVec a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MapVecSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MapVecSym1KindInference ()) - type MapVecSym2 :: (~>) a b -> Vec n a -> Vec n b - type family MapVecSym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Vec n a) :: Vec n b where - MapVecSym2 a0123456789876543210 a0123456789876543210 = MapVec a0123456789876543210 a0123456789876543210 - type (!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a) - data (!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a) - where - (:!@#@$###) :: SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => - (!@#@$) a0123456789876543210 - type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (!@#@$) where - suppressUnusedWarnings = snd ((,) (:!@#@$###) ()) - type (!@#@$$) :: Vec n a -> (~>) (Fin n) a - data (!@#@$$) (a0123456789876543210 :: Vec n a) :: (~>) (Fin n) a - where - (:!@#@$$###) :: SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) => - (!@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:!@#@$$###) ()) - type (!@#@$$$) :: Vec n a -> Fin n -> a - type family (!@#@$$$) (a0123456789876543210 :: Vec n a) (a0123456789876543210 :: Fin n) :: a where - (!@#@$$$) a0123456789876543210 a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210 - type TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a) - data TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a) - where - TailVecSym0KindInference :: SameKind (Apply TailVecSym0 arg) (TailVecSym1 arg) => - TailVecSym0 a0123456789876543210 - type instance Apply TailVecSym0 a0123456789876543210 = TailVec a0123456789876543210 - instance SuppressUnusedWarnings TailVecSym0 where - suppressUnusedWarnings = snd ((,) TailVecSym0KindInference ()) - type TailVecSym1 :: Vec ('Succ n) a -> Vec n a - type family TailVecSym1 (a0123456789876543210 :: Vec ('Succ n) a) :: Vec n a where - TailVecSym1 a0123456789876543210 = TailVec a0123456789876543210 - type HeadVecSym0 :: (~>) (Vec ('Succ n) a) a - data HeadVecSym0 :: (~>) (Vec ('Succ n) a) a - where - HeadVecSym0KindInference :: SameKind (Apply HeadVecSym0 arg) (HeadVecSym1 arg) => - HeadVecSym0 a0123456789876543210 - type instance Apply HeadVecSym0 a0123456789876543210 = HeadVec a0123456789876543210 - instance SuppressUnusedWarnings HeadVecSym0 where - suppressUnusedWarnings = snd ((,) HeadVecSym0KindInference ()) - type HeadVecSym1 :: Vec ('Succ n) a -> a - type family HeadVecSym1 (a0123456789876543210 :: Vec ('Succ n) a) :: a where - HeadVecSym1 a0123456789876543210 = HeadVec a0123456789876543210 - type Transitivity :: Equal a b -> Equal b c -> Equal a c - type family Transitivity (a :: Equal a b) (a :: Equal b c) :: Equal a c where - Transitivity Reflexive Reflexive = ReflexiveSym0 - type Symmetry :: Equal a b -> Equal b a - type family Symmetry (a :: Equal a b) :: Equal b a where - Symmetry Reflexive = ReflexiveSym0 - type MapVec :: (~>) a b -> Vec n a -> Vec n b - type family MapVec (a :: (~>) a b) (a :: Vec n a) :: Vec n b where - MapVec _ VNil = VNilSym0 - MapVec f (VCons x xs) = Apply (Apply VConsSym0 (Apply f x)) (Apply (Apply MapVecSym0 f) xs) - type (!) :: Vec n a -> Fin n -> a - type family (!) (a :: Vec n a) (a :: Fin n) :: a where - (!) (VCons x _) FZ = x - (!) (VCons _ xs) (FS n) = Apply (Apply (!@#@$) xs) n - (!) VNil n = Case_0123456789876543210 n n - type TailVec :: Vec ('Succ n) a -> Vec n a - type family TailVec (a :: Vec ('Succ n) a) :: Vec n a where - TailVec (VCons _ xs) = xs - type HeadVec :: Vec ('Succ n) a -> a - type family HeadVec (a :: Vec ('Succ n) a) :: a where - HeadVec (VCons x _) = x - sTransitivity :: - (forall (t :: Equal a b) (t :: Equal b c). - Sing t - -> Sing t - -> Sing (Apply (Apply TransitivitySym0 t) t :: Equal a c) :: Type) - sSymmetry :: - (forall (t :: Equal a b). - Sing t -> Sing (Apply SymmetrySym0 t :: Equal b a) :: Type) - sMapVec :: - (forall (t :: (~>) a b) (t :: Vec n a). - Sing t - -> Sing t - -> Sing (Apply (Apply MapVecSym0 t) t :: Vec n b) :: Type) - (%!) :: - (forall (t :: Vec n a) (t :: Fin n). - Sing t -> Sing t -> Sing (Apply (Apply (!@#@$) t) t :: a) :: Type) - sTailVec :: - (forall (t :: Vec ('Succ n) a). - Sing t -> Sing (Apply TailVecSym0 t :: Vec n a) :: Type) - sHeadVec :: - (forall (t :: Vec ('Succ n) a). - Sing t -> Sing (Apply HeadVecSym0 t :: a) :: Type) - sTransitivity SReflexive SReflexive = SReflexive - sSymmetry SReflexive = SReflexive - sMapVec _ SVNil = SVNil - sMapVec (sF :: Sing f) (SVCons (sX :: Sing x) (sXs :: Sing xs)) - = applySing - (applySing (singFun2 @VConsSym0 SVCons) (applySing sF sX)) - (applySing (applySing (singFun2 @MapVecSym0 sMapVec) sF) sXs) - (%!) (SVCons (sX :: Sing x) _) SFZ = sX - (%!) (SVCons _ (sXs :: Sing xs)) (SFS (sN :: Sing n)) - = applySing (applySing (singFun2 @(!@#@$) (%!)) sXs) sN - (%!) SVNil (sN :: Sing n) - = id @(Sing (Case_0123456789876543210 n n)) (case sN of {}) - sTailVec (SVCons _ (sXs :: Sing xs)) = sXs - sHeadVec (SVCons (sX :: Sing x) _) = sX - instance SingI (TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c))) where - sing = singFun2 @TransitivitySym0 sTransitivity - instance SingI d => - SingI (TransitivitySym1 (d :: Equal a b) :: (~>) (Equal b c) (Equal a c)) where - sing - = singFun1 - @(TransitivitySym1 (d :: Equal a b)) (sTransitivity (sing @d)) - instance SingI1 (TransitivitySym1 :: Equal a b - -> (~>) (Equal b c) (Equal a c)) where - liftSing (s :: Sing (d :: Equal a b)) - = singFun1 @(TransitivitySym1 (d :: Equal a b)) (sTransitivity s) - instance SingI (SymmetrySym0 :: (~>) (Equal a b) (Equal b a)) where - sing = singFun1 @SymmetrySym0 sSymmetry - instance SingI (MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b))) where - sing = singFun2 @MapVecSym0 sMapVec - instance SingI d => - SingI (MapVecSym1 (d :: (~>) a b) :: (~>) (Vec n a) (Vec n b)) where - sing = singFun1 @(MapVecSym1 (d :: (~>) a b)) (sMapVec (sing @d)) - instance SingI1 (MapVecSym1 :: (~>) a b - -> (~>) (Vec n a) (Vec n b)) where - liftSing (s :: Sing (d :: (~>) a b)) - = singFun1 @(MapVecSym1 (d :: (~>) a b)) (sMapVec s) - instance SingI ((!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a)) where - sing = singFun2 @(!@#@$) (%!) - instance SingI d => - SingI ((!@#@$$) (d :: Vec n a) :: (~>) (Fin n) a) where - sing = singFun1 @((!@#@$$) (d :: Vec n a)) ((%!) (sing @d)) - instance SingI1 ((!@#@$$) :: Vec n a -> (~>) (Fin n) a) where - liftSing (s :: Sing (d :: Vec n a)) - = singFun1 @((!@#@$$) (d :: Vec n a)) ((%!) s) - instance SingI (TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a)) where - sing = singFun1 @TailVecSym0 sTailVec - instance SingI (HeadVecSym0 :: (~>) (Vec ('Succ n) a) a) where - sing = singFun1 @HeadVecSym0 sHeadVec - data SFin :: forall (a :: Nat). Fin a -> Type - where - SFZ :: forall n. SFin (FZ :: Fin ('Succ n)) - SFS :: forall n (n :: Fin n). - (Sing n) -> SFin (FS n :: Fin ('Succ n)) - type instance Sing @(Fin a) = SFin - data SFoo :: forall (a :: Type). Foo a -> Type - where - SMkFoo1 :: SFoo (MkFoo1 :: Foo Bool) - SMkFoo2 :: SFoo (MkFoo2 :: Foo Ordering) - type instance Sing @(Foo a) = SFoo - data SVec :: forall (a :: Nat) (a :: Type). Vec a a -> Type - where - SVNil :: forall a. SVec (VNil :: Vec 'Zero a) - SVCons :: forall a n (n :: a) (n :: Vec n a). - (Sing n) -> (Sing n) -> SVec (VCons n n :: Vec ('Succ n) a) - type instance Sing @(Vec a a) = SVec - data SEqual :: forall (a :: Type) (a :: Type). Equal a a -> Type - where SReflexive :: forall a. SEqual (Reflexive :: Equal a a) - type instance Sing @(Equal a a) = SEqual - data SHList :: forall (a :: [Type]). HList a -> Type - where - SHNil :: SHList (HNil :: HList '[]) - SHCons :: forall x xs (n :: x) (n :: HList xs). - (Sing n) -> (Sing n) -> SHList (HCons n n :: HList ('(:) x xs)) - type instance Sing @(HList a) = SHList - data SObj :: Obj -> Type - where SObj :: forall a (n :: a). (Sing n) -> SObj (Obj n :: Obj) - type instance Sing @Obj = SObj - instance SingI FZ where - sing = SFZ - instance SingI n => SingI (FS (n :: Fin n)) where - sing = SFS sing - instance SingI1 FS where - liftSing = SFS - instance SingI (FSSym0 :: (~>) (Fin n) (Fin ('Succ n))) where - sing = singFun1 @FSSym0 SFS - instance SingI MkFoo1 where - sing = SMkFoo1 - instance SingI MkFoo2 where - sing = SMkFoo2 - instance SingI VNil where - sing = SVNil - instance (SingI n, SingI n) => - SingI (VCons (n :: a) (n :: Vec n a)) where - sing = SVCons sing sing - instance SingI n => SingI1 (VCons (n :: a)) where - liftSing = SVCons sing - instance SingI2 VCons where - liftSing2 = SVCons - instance SingI (VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a))) where - sing = singFun2 @VConsSym0 SVCons - instance SingI d => - SingI (VConsSym1 (d :: a) :: (~>) (Vec n a) (Vec ('Succ n) a)) where - sing = singFun1 @(VConsSym1 (d :: a)) (SVCons (sing @d)) - instance SingI1 (VConsSym1 :: a - -> (~>) (Vec n a) (Vec ('Succ n) a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(VConsSym1 (d :: a)) (SVCons s) - instance SingI Reflexive where - sing = SReflexive - instance SingI HNil where - sing = SHNil - instance (SingI n, SingI n) => - SingI (HCons (n :: x) (n :: HList xs)) where - sing = SHCons sing sing - instance SingI n => SingI1 (HCons (n :: x)) where - liftSing = SHCons sing - instance SingI2 HCons where - liftSing2 = SHCons - instance SingI (HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs)))) where - sing = singFun2 @HConsSym0 SHCons - instance SingI d => - SingI (HConsSym1 (d :: x) :: (~>) (HList xs) (HList ('(:) x xs))) where - sing = singFun1 @(HConsSym1 (d :: x)) (SHCons (sing @d)) - instance SingI1 (HConsSym1 :: x - -> (~>) (HList xs) (HList ('(:) x xs))) where - liftSing (s :: Sing (d :: x)) - = singFun1 @(HConsSym1 (d :: x)) (SHCons s) - instance SingI n => SingI (Obj (n :: a)) where - sing = SObj sing - instance SingI1 Obj where - liftSing = SObj - instance SingI (ObjSym0 :: (~>) a Obj) where - sing = singFun1 @ObjSym0 SObj +Singletons/T150.hs:(0,0)-(0,0): Splicing declarations+ withOptions defaultOptions {genSingKindInsts = False}+ $ singletons+ $ lift+ [d| headVec :: Vec (Succ n) a -> a+ headVec (VCons x _) = x+ tailVec :: Vec (Succ n) a -> Vec n a+ tailVec (VCons _ xs) = xs+ (!) :: Vec n a -> Fin n -> a+ VCons x _ ! FZ = x+ VCons _ xs ! FS n = xs ! n+ VNil ! n = case n of {}+ mapVec :: (a -> b) -> Vec n a -> Vec n b+ mapVec _ VNil = VNil+ mapVec f (VCons x xs) = VCons (f x) (mapVec f xs)+ symmetry :: Equal a b -> Equal b a+ symmetry Reflexive = Reflexive+ transitivity :: Equal a b -> Equal b c -> Equal a c+ transitivity Reflexive Reflexive = Reflexive+ + data Fin :: Nat -> Type+ where+ FZ :: Fin (Succ n)+ FS :: Fin n -> Fin (Succ n)+ data Foo :: Type -> Type+ where+ MkFoo1 :: Foo Bool+ MkFoo2 :: Foo Ordering+ data Vec :: Nat -> Type -> Type+ where+ VNil :: Vec Zero a+ VCons :: a -> Vec n a -> Vec (Succ n) a+ data Equal :: Type -> Type -> Type where Reflexive :: Equal a a+ data HList :: [Type] -> Type+ where+ HNil :: HList '[]+ HCons :: x -> HList xs -> HList (x : xs)+ data Obj :: Type where Obj :: a -> Obj |]+ ======>+ data Fin :: Nat -> Type+ where+ FZ :: Fin ('Succ n)+ FS :: (Fin n) -> Fin ('Succ n)+ data Foo :: Type -> Type+ where+ MkFoo1 :: Foo Bool+ MkFoo2 :: Foo Ordering+ data Vec :: Nat -> Type -> Type+ where+ VNil :: Vec 'Zero a+ VCons :: a -> (Vec n a) -> Vec ('Succ n) a+ headVec :: Vec ('Succ n) a -> a+ headVec (VCons x _) = x+ tailVec :: Vec ('Succ n) a -> Vec n a+ tailVec (VCons _ xs) = xs+ (!) :: Vec n a -> Fin n -> a+ (!) (VCons x _) FZ = x+ (!) (VCons _ xs) (FS n) = (xs ! n)+ (!) VNil n = case n of {}+ mapVec :: (a -> b) -> Vec n a -> Vec n b+ mapVec _ VNil = VNil+ mapVec f (VCons x xs) = VCons (f x) (mapVec f xs)+ data Equal :: Type -> Type -> Type where Reflexive :: Equal a a+ symmetry :: Equal a b -> Equal b a+ symmetry Reflexive = Reflexive+ transitivity :: Equal a b -> Equal b c -> Equal a c+ transitivity Reflexive Reflexive = Reflexive+ data HList :: [Type] -> Type+ where+ HNil :: HList '[]+ HCons :: x -> (HList xs) -> HList ('(:) x xs)+ data Obj :: Type where Obj :: a -> Obj+ type FZSym0 :: Fin ('Succ n)+ type family FZSym0 @n :: Fin ('Succ n) where+ FZSym0 = FZ+ type FSSym0 :: (~>) (Fin n) (Fin ('Succ n))+ data FSSym0 :: (~>) (Fin n) (Fin ('Succ n))+ where+ FSSym0KindInference :: SameKind (Apply FSSym0 arg) (FSSym1 arg) =>+ FSSym0 a0123456789876543210+ type instance Apply @(Fin n) @(Fin ('Succ n)) FSSym0 a0123456789876543210 = FS a0123456789876543210+ instance SuppressUnusedWarnings FSSym0 where+ suppressUnusedWarnings = snd ((,) FSSym0KindInference ())+ type FSSym1 :: Fin n -> Fin ('Succ n)+ type family FSSym1 @n (a0123456789876543210 :: Fin n) :: Fin ('Succ n) where+ FSSym1 a0123456789876543210 = FS a0123456789876543210+ type MkFoo1Sym0 :: Foo Bool+ type family MkFoo1Sym0 :: Foo Bool where+ MkFoo1Sym0 = MkFoo1+ type MkFoo2Sym0 :: Foo Ordering+ type family MkFoo2Sym0 :: Foo Ordering where+ MkFoo2Sym0 = MkFoo2+ type VNilSym0 :: Vec 'Zero a+ type family VNilSym0 @a :: Vec 'Zero a where+ VNilSym0 = VNil+ type VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a))+ data VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a))+ where+ VConsSym0KindInference :: SameKind (Apply VConsSym0 arg) (VConsSym1 arg) =>+ VConsSym0 a0123456789876543210+ type instance Apply @a @((~>) (Vec n a) (Vec ('Succ n) a)) VConsSym0 a0123456789876543210 = VConsSym1 a0123456789876543210+ instance SuppressUnusedWarnings VConsSym0 where+ suppressUnusedWarnings = snd ((,) VConsSym0KindInference ())+ type VConsSym1 :: a -> (~>) (Vec n a) (Vec ('Succ n) a)+ data VConsSym1 (a0123456789876543210 :: a) :: (~>) (Vec n a) (Vec ('Succ n) a)+ where+ VConsSym1KindInference :: SameKind (Apply (VConsSym1 a0123456789876543210) arg) (VConsSym2 a0123456789876543210 arg) =>+ VConsSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Vec n a) @(Vec ('Succ n) a) (VConsSym1 a0123456789876543210) a0123456789876543210 = VCons a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (VConsSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) VConsSym1KindInference ())+ type VConsSym2 :: a -> Vec n a -> Vec ('Succ n) a+ type family VConsSym2 @a @n (a0123456789876543210 :: a) (a0123456789876543210 :: Vec n a) :: Vec ('Succ n) a where+ VConsSym2 a0123456789876543210 a0123456789876543210 = VCons a0123456789876543210 a0123456789876543210+ type ReflexiveSym0 :: Equal a a+ type family ReflexiveSym0 @a :: Equal a a where+ ReflexiveSym0 = Reflexive+ type HNilSym0 :: HList '[]+ type family HNilSym0 :: HList '[] where+ HNilSym0 = HNil+ type HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs)))+ data HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs)))+ where+ HConsSym0KindInference :: SameKind (Apply HConsSym0 arg) (HConsSym1 arg) =>+ HConsSym0 a0123456789876543210+ type instance Apply @x @((~>) (HList xs) (HList ('(:) x xs))) HConsSym0 a0123456789876543210 = HConsSym1 a0123456789876543210+ instance SuppressUnusedWarnings HConsSym0 where+ suppressUnusedWarnings = snd ((,) HConsSym0KindInference ())+ type HConsSym1 :: x -> (~>) (HList xs) (HList ('(:) x xs))+ data HConsSym1 (a0123456789876543210 :: x) :: (~>) (HList xs) (HList ('(:) x xs))+ where+ HConsSym1KindInference :: SameKind (Apply (HConsSym1 a0123456789876543210) arg) (HConsSym2 a0123456789876543210 arg) =>+ HConsSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(HList xs) @(HList ('(:) x xs)) (HConsSym1 a0123456789876543210) a0123456789876543210 = HCons a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (HConsSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) HConsSym1KindInference ())+ type HConsSym2 :: x -> HList xs -> HList ('(:) x xs)+ type family HConsSym2 @x @xs (a0123456789876543210 :: x) (a0123456789876543210 :: HList xs) :: HList ('(:) x xs) where+ HConsSym2 a0123456789876543210 a0123456789876543210 = HCons a0123456789876543210 a0123456789876543210+ type ObjSym0 :: (~>) a Obj+ data ObjSym0 :: (~>) a Obj+ where+ ObjSym0KindInference :: SameKind (Apply ObjSym0 arg) (ObjSym1 arg) =>+ ObjSym0 a0123456789876543210+ type instance Apply @a @Obj ObjSym0 a0123456789876543210 = Obj a0123456789876543210+ instance SuppressUnusedWarnings ObjSym0 where+ suppressUnusedWarnings = snd ((,) ObjSym0KindInference ())+ type ObjSym1 :: a -> Obj+ type family ObjSym1 @a (a0123456789876543210 :: a) :: Obj where+ ObjSym1 a0123456789876543210 = Obj a0123456789876543210+ type family LamCases_0123456789876543210 (n0123456789876543210 :: Fin n0123456789876543210) a_0123456789876543210 where+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: Fin n0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: Fin n0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c))+ data TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c))+ where+ TransitivitySym0KindInference :: SameKind (Apply TransitivitySym0 arg) (TransitivitySym1 arg) =>+ TransitivitySym0 a0123456789876543210+ type instance Apply @(Equal a b) @((~>) (Equal b c) (Equal a c)) TransitivitySym0 a0123456789876543210 = TransitivitySym1 a0123456789876543210+ instance SuppressUnusedWarnings TransitivitySym0 where+ suppressUnusedWarnings = snd ((,) TransitivitySym0KindInference ())+ type TransitivitySym1 :: Equal a b -> (~>) (Equal b c) (Equal a c)+ data TransitivitySym1 (a0123456789876543210 :: Equal a b) :: (~>) (Equal b c) (Equal a c)+ where+ TransitivitySym1KindInference :: SameKind (Apply (TransitivitySym1 a0123456789876543210) arg) (TransitivitySym2 a0123456789876543210 arg) =>+ TransitivitySym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Equal b c) @(Equal a c) (TransitivitySym1 a0123456789876543210) a0123456789876543210 = Transitivity a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (TransitivitySym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) TransitivitySym1KindInference ())+ type TransitivitySym2 :: Equal a b -> Equal b c -> Equal a c+ type family TransitivitySym2 @a @b @c (a0123456789876543210 :: Equal a b) (a0123456789876543210 :: Equal b c) :: Equal a c where+ TransitivitySym2 a0123456789876543210 a0123456789876543210 = Transitivity a0123456789876543210 a0123456789876543210+ type SymmetrySym0 :: (~>) (Equal a b) (Equal b a)+ data SymmetrySym0 :: (~>) (Equal a b) (Equal b a)+ where+ SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) =>+ SymmetrySym0 a0123456789876543210+ type instance Apply @(Equal a b) @(Equal b a) SymmetrySym0 a0123456789876543210 = Symmetry a0123456789876543210+ instance SuppressUnusedWarnings SymmetrySym0 where+ suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ())+ type SymmetrySym1 :: Equal a b -> Equal b a+ type family SymmetrySym1 @a @b (a0123456789876543210 :: Equal a b) :: Equal b a where+ SymmetrySym1 a0123456789876543210 = Symmetry a0123456789876543210+ type MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b))+ data MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b))+ where+ MapVecSym0KindInference :: SameKind (Apply MapVecSym0 arg) (MapVecSym1 arg) =>+ MapVecSym0 a0123456789876543210+ type instance Apply @((~>) a b) @((~>) (Vec n a) (Vec n b)) MapVecSym0 a0123456789876543210 = MapVecSym1 a0123456789876543210+ instance SuppressUnusedWarnings MapVecSym0 where+ suppressUnusedWarnings = snd ((,) MapVecSym0KindInference ())+ type MapVecSym1 :: (~>) a b -> (~>) (Vec n a) (Vec n b)+ data MapVecSym1 (a0123456789876543210 :: (~>) a b) :: (~>) (Vec n a) (Vec n b)+ where+ MapVecSym1KindInference :: SameKind (Apply (MapVecSym1 a0123456789876543210) arg) (MapVecSym2 a0123456789876543210 arg) =>+ MapVecSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Vec n a) @(Vec n b) (MapVecSym1 a0123456789876543210) a0123456789876543210 = MapVec a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MapVecSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MapVecSym1KindInference ())+ type MapVecSym2 :: (~>) a b -> Vec n a -> Vec n b+ type family MapVecSym2 @a @b @n (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: Vec n a) :: Vec n b where+ MapVecSym2 a0123456789876543210 a0123456789876543210 = MapVec a0123456789876543210 a0123456789876543210+ type (!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a)+ data (!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a)+ where+ (:!@#@$###) :: SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) =>+ (!@#@$) a0123456789876543210+ type instance Apply @(Vec n a) @((~>) (Fin n) a) (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (!@#@$) where+ suppressUnusedWarnings = snd ((,) (:!@#@$###) ())+ type (!@#@$$) :: Vec n a -> (~>) (Fin n) a+ data (!@#@$$) (a0123456789876543210 :: Vec n a) :: (~>) (Fin n) a+ where+ (:!@#@$$###) :: SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) =>+ (!@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @(Fin n) @a ((!@#@$$) a0123456789876543210) a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:!@#@$$###) ())+ type (!@#@$$$) :: Vec n a -> Fin n -> a+ type family (!@#@$$$) @n @a (a0123456789876543210 :: Vec n a) (a0123456789876543210 :: Fin n) :: a where+ (!@#@$$$) a0123456789876543210 a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210+ type TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a)+ data TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a)+ where+ TailVecSym0KindInference :: SameKind (Apply TailVecSym0 arg) (TailVecSym1 arg) =>+ TailVecSym0 a0123456789876543210+ type instance Apply @(Vec ('Succ n) a) @(Vec n a) TailVecSym0 a0123456789876543210 = TailVec a0123456789876543210+ instance SuppressUnusedWarnings TailVecSym0 where+ suppressUnusedWarnings = snd ((,) TailVecSym0KindInference ())+ type TailVecSym1 :: Vec ('Succ n) a -> Vec n a+ type family TailVecSym1 @n @a (a0123456789876543210 :: Vec ('Succ n) a) :: Vec n a where+ TailVecSym1 a0123456789876543210 = TailVec a0123456789876543210+ type HeadVecSym0 :: (~>) (Vec ('Succ n) a) a+ data HeadVecSym0 :: (~>) (Vec ('Succ n) a) a+ where+ HeadVecSym0KindInference :: SameKind (Apply HeadVecSym0 arg) (HeadVecSym1 arg) =>+ HeadVecSym0 a0123456789876543210+ type instance Apply @(Vec ('Succ n) a) @a HeadVecSym0 a0123456789876543210 = HeadVec a0123456789876543210+ instance SuppressUnusedWarnings HeadVecSym0 where+ suppressUnusedWarnings = snd ((,) HeadVecSym0KindInference ())+ type HeadVecSym1 :: Vec ('Succ n) a -> a+ type family HeadVecSym1 @n @a (a0123456789876543210 :: Vec ('Succ n) a) :: a where+ HeadVecSym1 a0123456789876543210 = HeadVec a0123456789876543210+ type Transitivity :: Equal a b -> Equal b c -> Equal a c+ type family Transitivity @a @b @c (a :: Equal a b) (a :: Equal b c) :: Equal a c where+ Transitivity Reflexive Reflexive = ReflexiveSym0+ type Symmetry :: Equal a b -> Equal b a+ type family Symmetry @a @b (a :: Equal a b) :: Equal b a where+ Symmetry Reflexive = ReflexiveSym0+ type MapVec :: (~>) a b -> Vec n a -> Vec n b+ type family MapVec @a @b @n (a :: (~>) a b) (a :: Vec n a) :: Vec n b where+ MapVec _ VNil = VNilSym0+ MapVec f (VCons x xs) = Apply (Apply VConsSym0 (Apply f x)) (Apply (Apply MapVecSym0 f) xs)+ type (!) :: Vec n a -> Fin n -> a+ type family (!) @n @a (a :: Vec n a) (a :: Fin n) :: a where+ (!) (VCons x _) FZ = x+ (!) (VCons _ xs) (FS n) = Apply (Apply (!@#@$) xs) n+ (!) VNil n = Apply (LamCases_0123456789876543210Sym0 n) n+ type TailVec :: Vec ('Succ n) a -> Vec n a+ type family TailVec @n @a (a :: Vec ('Succ n) a) :: Vec n a where+ TailVec (VCons _ xs) = xs+ type HeadVec :: Vec ('Succ n) a -> a+ type family HeadVec @n @a (a :: Vec ('Succ n) a) :: a where+ HeadVec (VCons x _) = x+ sTransitivity ::+ (forall (t :: Equal a b) (t :: Equal b c).+ Sing t -> Sing t -> Sing (Transitivity t t :: Equal a c) :: Type)+ sSymmetry ::+ (forall (t :: Equal a b).+ Sing t -> Sing (Symmetry t :: Equal b a) :: Type)+ sMapVec ::+ (forall (t :: (~>) a b) (t :: Vec n a).+ Sing t -> Sing t -> Sing (MapVec t t :: Vec n b) :: Type)+ (%!) ::+ (forall (t :: Vec n a) (t :: Fin n).+ Sing t -> Sing t -> Sing ((!) t t :: a) :: Type)+ sTailVec ::+ (forall (t :: Vec ('Succ n) a).+ Sing t -> Sing (TailVec t :: Vec n a) :: Type)+ sHeadVec ::+ (forall (t :: Vec ('Succ n) a).+ Sing t -> Sing (HeadVec t :: a) :: Type)+ sTransitivity SReflexive SReflexive = SReflexive+ sSymmetry SReflexive = SReflexive+ sMapVec _ SVNil = SVNil+ sMapVec (sF :: Sing f) (SVCons (sX :: Sing x) (sXs :: Sing xs))+ = applySing+ (applySing (singFun2 @VConsSym0 SVCons) (applySing sF sX))+ (applySing (applySing (singFun2 @MapVecSym0 sMapVec) sF) sXs)+ (%!) (SVCons (sX :: Sing x) _) SFZ = sX+ (%!) (SVCons _ (sXs :: Sing xs)) (SFS (sN :: Sing n))+ = applySing (applySing (singFun2 @(!@#@$) (%!)) sXs) sN+ (%!) SVNil (sN :: Sing n)+ = applySing+ (singFun1 @(LamCases_0123456789876543210Sym0 n) (\case)) sN+ sTailVec (SVCons _ (sXs :: Sing xs)) = sXs+ sHeadVec (SVCons (sX :: Sing x) _) = sX+ instance SingI (TransitivitySym0 :: (~>) (Equal a b) ((~>) (Equal b c) (Equal a c))) where+ sing = singFun2 @TransitivitySym0 sTransitivity+ instance SingI d =>+ SingI (TransitivitySym1 (d :: Equal a b) :: (~>) (Equal b c) (Equal a c)) where+ sing+ = singFun1+ @(TransitivitySym1 (d :: Equal a b)) (sTransitivity (sing @d))+ instance SingI1 (TransitivitySym1 :: Equal a b+ -> (~>) (Equal b c) (Equal a c)) where+ liftSing (s :: Sing (d :: Equal a b))+ = singFun1 @(TransitivitySym1 (d :: Equal a b)) (sTransitivity s)+ instance SingI (SymmetrySym0 :: (~>) (Equal a b) (Equal b a)) where+ sing = singFun1 @SymmetrySym0 sSymmetry+ instance SingI (MapVecSym0 :: (~>) ((~>) a b) ((~>) (Vec n a) (Vec n b))) where+ sing = singFun2 @MapVecSym0 sMapVec+ instance SingI d =>+ SingI (MapVecSym1 (d :: (~>) a b) :: (~>) (Vec n a) (Vec n b)) where+ sing = singFun1 @(MapVecSym1 (d :: (~>) a b)) (sMapVec (sing @d))+ instance SingI1 (MapVecSym1 :: (~>) a b+ -> (~>) (Vec n a) (Vec n b)) where+ liftSing (s :: Sing (d :: (~>) a b))+ = singFun1 @(MapVecSym1 (d :: (~>) a b)) (sMapVec s)+ instance SingI ((!@#@$) :: (~>) (Vec n a) ((~>) (Fin n) a)) where+ sing = singFun2 @(!@#@$) (%!)+ instance SingI d =>+ SingI ((!@#@$$) (d :: Vec n a) :: (~>) (Fin n) a) where+ sing = singFun1 @((!@#@$$) (d :: Vec n a)) ((%!) (sing @d))+ instance SingI1 ((!@#@$$) :: Vec n a -> (~>) (Fin n) a) where+ liftSing (s :: Sing (d :: Vec n a))+ = singFun1 @((!@#@$$) (d :: Vec n a)) ((%!) s)+ instance SingI (TailVecSym0 :: (~>) (Vec ('Succ n) a) (Vec n a)) where+ sing = singFun1 @TailVecSym0 sTailVec+ instance SingI (HeadVecSym0 :: (~>) (Vec ('Succ n) a) a) where+ sing = singFun1 @HeadVecSym0 sHeadVec+ data SFin :: forall (a :: Nat). Fin a -> Type+ where+ SFZ :: forall n. SFin (FZ :: Fin ('Succ n))+ SFS :: forall n (n :: Fin n).+ (Sing n) -> SFin (FS n :: Fin ('Succ n))+ type instance Sing @(Fin a) = SFin+ data SFoo :: forall (a :: Type). Foo a -> Type+ where+ SMkFoo1 :: SFoo (MkFoo1 :: Foo Bool)+ SMkFoo2 :: SFoo (MkFoo2 :: Foo Ordering)+ type instance Sing @(Foo a) = SFoo+ data SVec :: forall (a :: Nat) (a :: Type). Vec a a -> Type+ where+ SVNil :: forall a. SVec (VNil :: Vec 'Zero a)+ SVCons :: forall a n (n :: a) (n :: Vec n a).+ (Sing n) -> (Sing n) -> SVec (VCons n n :: Vec ('Succ n) a)+ type instance Sing @(Vec a a) = SVec+ data SEqual :: forall (a :: Type) (a :: Type). Equal a a -> Type+ where SReflexive :: forall a. SEqual (Reflexive :: Equal a a)+ type instance Sing @(Equal a a) = SEqual+ data SHList :: forall (a :: [Type]). HList a -> Type+ where+ SHNil :: SHList (HNil :: HList '[])+ SHCons :: forall x xs (n :: x) (n :: HList xs).+ (Sing n) -> (Sing n) -> SHList (HCons n n :: HList ('(:) x xs))+ type instance Sing @(HList a) = SHList+ data SObj :: Obj -> Type+ where SObj :: forall a (n :: a). (Sing n) -> SObj (Obj n :: Obj)+ type instance Sing @Obj = SObj+ instance SingI FZ where+ sing = SFZ+ instance SingI n => SingI (FS (n :: Fin n)) where+ sing = SFS sing+ instance SingI1 FS where+ liftSing = SFS+ instance SingI (FSSym0 :: (~>) (Fin n) (Fin ('Succ n))) where+ sing = singFun1 @FSSym0 SFS+ instance SingI MkFoo1 where+ sing = SMkFoo1+ instance SingI MkFoo2 where+ sing = SMkFoo2+ instance SingI VNil where+ sing = SVNil+ instance (SingI n, SingI n) =>+ SingI (VCons (n :: a) (n :: Vec n a)) where+ sing = SVCons sing sing+ instance SingI n => SingI1 (VCons (n :: a)) where+ liftSing = SVCons sing+ instance SingI2 VCons where+ liftSing2 = SVCons+ instance SingI (VConsSym0 :: (~>) a ((~>) (Vec n a) (Vec ('Succ n) a))) where+ sing = singFun2 @VConsSym0 SVCons+ instance SingI d =>+ SingI (VConsSym1 (d :: a) :: (~>) (Vec n a) (Vec ('Succ n) a)) where+ sing = singFun1 @(VConsSym1 (d :: a)) (SVCons (sing @d))+ instance SingI1 (VConsSym1 :: a+ -> (~>) (Vec n a) (Vec ('Succ n) a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(VConsSym1 (d :: a)) (SVCons s)+ instance SingI Reflexive where+ sing = SReflexive+ instance SingI HNil where+ sing = SHNil+ instance (SingI n, SingI n) =>+ SingI (HCons (n :: x) (n :: HList xs)) where+ sing = SHCons sing sing+ instance SingI n => SingI1 (HCons (n :: x)) where+ liftSing = SHCons sing+ instance SingI2 HCons where+ liftSing2 = SHCons+ instance SingI (HConsSym0 :: (~>) x ((~>) (HList xs) (HList ('(:) x xs)))) where+ sing = singFun2 @HConsSym0 SHCons+ instance SingI d =>+ SingI (HConsSym1 (d :: x) :: (~>) (HList xs) (HList ('(:) x xs))) where+ sing = singFun1 @(HConsSym1 (d :: x)) (SHCons (sing @d))+ instance SingI1 (HConsSym1 :: x+ -> (~>) (HList xs) (HList ('(:) x xs))) where+ liftSing (s :: Sing (d :: x))+ = singFun1 @(HConsSym1 (d :: x)) (SHCons s)+ instance SingI n => SingI (Obj (n :: a)) where+ sing = SObj sing+ instance SingI1 Obj where+ liftSing = SObj+ instance SingI (ObjSym0 :: (~>) a Obj) where+ sing = singFun1 @ObjSym0 SObj
tests/compile-and-dump/Singletons/T150.hs view
@@ -1,53 +1,53 @@-module T150 where - -import Control.Monad.Trans.Class -import Data.Kind -import Data.Singletons.TH -import Data.Singletons.TH.Options -import Singletons.Nat - -$(withOptions defaultOptions{genSingKindInsts = False} $ - singletons $ lift - [d| data Fin :: Nat -> Type where - FZ :: Fin (Succ n) - FS :: Fin n -> Fin (Succ n) - - data Foo :: Type -> Type where - MkFoo1 :: Foo Bool - MkFoo2 :: Foo Ordering - - data Vec :: Nat -> Type -> Type where - VNil :: Vec Zero a - VCons :: a -> Vec n a -> Vec (Succ n) a - - headVec :: Vec (Succ n) a -> a - headVec (VCons x _) = x - - tailVec :: Vec (Succ n) a -> Vec n a - tailVec (VCons _ xs) = xs - - (!) :: Vec n a -> Fin n -> a - VCons x _ ! FZ = x - VCons _ xs ! FS n = xs ! n - VNil ! n = case n of {} - - mapVec :: (a -> b) -> Vec n a -> Vec n b - mapVec _ VNil = VNil - mapVec f (VCons x xs) = VCons (f x) (mapVec f xs) - - data Equal :: Type -> Type -> Type where - Reflexive :: Equal a a - - symmetry :: Equal a b -> Equal b a - symmetry Reflexive = Reflexive - - transitivity :: Equal a b -> Equal b c -> Equal a c - transitivity Reflexive Reflexive = Reflexive - - data HList :: [Type] -> Type where - HNil :: HList '[] - HCons :: x -> HList xs -> HList (x:xs) - - data Obj :: Type where - Obj :: a -> Obj - |]) +module T150 where++import Control.Monad.Trans.Class+import Data.Kind+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Singletons.Nat++$(withOptions defaultOptions{genSingKindInsts = False} $+ singletons $ lift+ [d| data Fin :: Nat -> Type where+ FZ :: Fin (Succ n)+ FS :: Fin n -> Fin (Succ n)++ data Foo :: Type -> Type where+ MkFoo1 :: Foo Bool+ MkFoo2 :: Foo Ordering++ data Vec :: Nat -> Type -> Type where+ VNil :: Vec Zero a+ VCons :: a -> Vec n a -> Vec (Succ n) a++ headVec :: Vec (Succ n) a -> a+ headVec (VCons x _) = x++ tailVec :: Vec (Succ n) a -> Vec n a+ tailVec (VCons _ xs) = xs++ (!) :: Vec n a -> Fin n -> a+ VCons x _ ! FZ = x+ VCons _ xs ! FS n = xs ! n+ VNil ! n = case n of {}++ mapVec :: (a -> b) -> Vec n a -> Vec n b+ mapVec _ VNil = VNil+ mapVec f (VCons x xs) = VCons (f x) (mapVec f xs)++ data Equal :: Type -> Type -> Type where+ Reflexive :: Equal a a++ symmetry :: Equal a b -> Equal b a+ symmetry Reflexive = Reflexive++ transitivity :: Equal a b -> Equal b c -> Equal a c+ transitivity Reflexive Reflexive = Reflexive++ data HList :: [Type] -> Type where+ HNil :: HList '[]+ HCons :: x -> HList xs -> HList (x:xs)++ data Obj :: Type where+ Obj :: a -> Obj+ |])
tests/compile-and-dump/Singletons/T153.hs view
@@ -1,10 +1,10 @@-module Singletons.T153 where - -import Data.Singletons -import Prelude.Singletons - -foo :: Int -foo = withSomeSing @(Maybe Bool) (Just True) $ \case - SJust STrue -> 0 - SJust SFalse -> 1 - SNothing -> 2 +module Singletons.T153 where++import Data.Singletons+import Prelude.Singletons++foo :: Int+foo = withSomeSing @(Maybe Bool) (Just True) $ \case+ SJust STrue -> 0+ SJust SFalse -> 1+ SNothing -> 2
tests/compile-and-dump/Singletons/T157.hs view
@@ -1,6 +1,6 @@-module T157 where - -import Prelude.Singletons - -foo :: SList '["a", "b", "c"] -foo = sing `SCons` sing `SCons` sing +module T157 where++import Prelude.Singletons++foo :: SList '["a", "b", "c"]+foo = sing `SCons` sing `SCons` sing
tests/compile-and-dump/Singletons/T159.golden view
@@ -1,267 +1,267 @@-Singletons/T159.hs:0:0:: Splicing declarations - genSingletons [''T0, ''T1] - ======> - type ASym0 :: T0 - type family ASym0 :: T0 where - ASym0 = 'A - type BSym0 :: T0 - type family BSym0 :: T0 where - BSym0 = 'B - type CSym0 :: T0 - type family CSym0 :: T0 where - CSym0 = 'C - type DSym0 :: T0 - type family DSym0 :: T0 where - DSym0 = 'D - type ESym0 :: T0 - type family ESym0 :: T0 where - ESym0 = 'E - type FSym0 :: T0 - type family FSym0 :: T0 where - FSym0 = 'F - type ST0 :: T0 -> Type - data ST0 :: T0 -> Type - where - SA :: ST0 ('A :: T0) - SB :: ST0 ('B :: T0) - SC :: ST0 ('C :: T0) - SD :: ST0 ('D :: T0) - SE :: ST0 ('E :: T0) - SF :: ST0 ('F :: T0) - type instance Sing @T0 = ST0 - 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 :: T1 - type family N1Sym0 :: T1 where - N1Sym0 = 'N1 - type C1Sym0 :: (~>) T0 ((~>) T1 T1) - data C1Sym0 :: (~>) T0 ((~>) T1 T1) - where - C1Sym0KindInference :: SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => - C1Sym0 a0123456789876543210 - type instance Apply C1Sym0 a0123456789876543210 = C1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings C1Sym0 where - suppressUnusedWarnings = snd ((,) C1Sym0KindInference ()) - infixr 5 `C1Sym0` - type C1Sym1 :: T0 -> (~>) T1 T1 - data C1Sym1 (a0123456789876543210 :: T0) :: (~>) T1 T1 - where - C1Sym1KindInference :: SameKind (Apply (C1Sym1 a0123456789876543210) arg) (C1Sym2 a0123456789876543210 arg) => - C1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (C1Sym1 a0123456789876543210) a0123456789876543210 = 'C1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (C1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) C1Sym1KindInference ()) - infixr 5 `C1Sym1` - type C1Sym2 :: T0 -> T1 -> T1 - type family C1Sym2 (a0123456789876543210 :: T0) (a0123456789876543210 :: T1) :: T1 where - C1Sym2 a0123456789876543210 a0123456789876543210 = 'C1 a0123456789876543210 a0123456789876543210 - infixr 5 `C1Sym2` - type (:&&@#@$) :: (~>) T0 ((~>) T1 T1) - data (:&&@#@$) :: (~>) T0 ((~>) T1 T1) - where - (::&&@#@$###) :: SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => - (:&&@#@$) a0123456789876543210 - type instance Apply (:&&@#@$) a0123456789876543210 = (:&&@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:&&@#@$) where - suppressUnusedWarnings = snd ((,) (::&&@#@$###) ()) - infixr 5 :&&@#@$ - type (:&&@#@$$) :: T0 -> (~>) T1 T1 - data (:&&@#@$$) (a0123456789876543210 :: T0) :: (~>) T1 T1 - where - (::&&@#@$$###) :: SameKind (Apply ((:&&@#@$$) a0123456789876543210) arg) ((:&&@#@$$$) a0123456789876543210 arg) => - (:&&@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:&&@#@$$) a0123456789876543210) a0123456789876543210 = '(:&&) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:&&@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::&&@#@$$###) ()) - infixr 5 :&&@#@$$ - type (:&&@#@$$$) :: T0 -> T1 -> T1 - type family (:&&@#@$$$) (a0123456789876543210 :: T0) (a0123456789876543210 :: T1) :: T1 where - (:&&@#@$$$) a0123456789876543210 a0123456789876543210 = '(:&&) a0123456789876543210 a0123456789876543210 - infixr 5 :&&@#@$$$ - type ST1 :: T1 -> Type - data ST1 :: T1 -> Type - where - SN1 :: ST1 ('N1 :: T1) - SC1 :: forall (n :: T0) (n :: T1). - (Sing n) -> (Sing n) -> ST1 ('C1 n n :: T1) - (:%&&) :: forall (n :: T0) (n :: T1). - (Sing n) -> (Sing n) -> ST1 ('(:&&) n n :: T1) - type instance Sing @T1 = ST1 - 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 n => SingI1 ('C1 (n :: T0)) where - liftSing = SC1 sing - instance SingI2 'C1 where - liftSing2 = SC1 - instance SingI (C1Sym0 :: (~>) T0 ((~>) T1 T1)) where - sing = singFun2 @C1Sym0 SC1 - instance SingI d => SingI (C1Sym1 (d :: T0) :: (~>) T1 T1) where - sing = singFun1 @(C1Sym1 (d :: T0)) (SC1 (sing @d)) - instance SingI1 (C1Sym1 :: T0 -> (~>) T1 T1) where - liftSing (s :: Sing (d :: T0)) - = singFun1 @(C1Sym1 (d :: T0)) (SC1 s) - instance (SingI n, SingI n) => - SingI ('(:&&) (n :: T0) (n :: T1)) where - sing = (:%&&) sing sing - instance SingI n => SingI1 ('(:&&) (n :: T0)) where - liftSing = (:%&&) sing - instance SingI2 '(:&&) where - liftSing2 = (:%&&) - instance SingI ((:&&@#@$) :: (~>) T0 ((~>) T1 T1)) where - sing = singFun2 @(:&&@#@$) (:%&&) - instance SingI d => - SingI ((:&&@#@$$) (d :: T0) :: (~>) T1 T1) where - sing = singFun1 @((:&&@#@$$) (d :: T0)) ((:%&&) (sing @d)) - instance SingI1 ((:&&@#@$$) :: T0 -> (~>) T1 T1) where - liftSing (s :: Sing (d :: T0)) - = singFun1 @((:&&@#@$$) (d :: T0)) ((:%&&) s) -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 :: T2 - type family N2Sym0 :: T2 where - N2Sym0 = N2 - type C2Sym0 :: (~>) T0 ((~>) T2 T2) - data C2Sym0 :: (~>) T0 ((~>) T2 T2) - where - C2Sym0KindInference :: SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => - C2Sym0 a0123456789876543210 - type instance Apply C2Sym0 a0123456789876543210 = C2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings C2Sym0 where - suppressUnusedWarnings = snd ((,) C2Sym0KindInference ()) - infixr 5 `C2Sym0` - type C2Sym1 :: T0 -> (~>) T2 T2 - data C2Sym1 (a0123456789876543210 :: T0) :: (~>) T2 T2 - where - C2Sym1KindInference :: SameKind (Apply (C2Sym1 a0123456789876543210) arg) (C2Sym2 a0123456789876543210 arg) => - C2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (C2Sym1 a0123456789876543210) a0123456789876543210 = C2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (C2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) C2Sym1KindInference ()) - infixr 5 `C2Sym1` - type C2Sym2 :: T0 -> T2 -> T2 - type family C2Sym2 (a0123456789876543210 :: T0) (a0123456789876543210 :: T2) :: T2 where - C2Sym2 a0123456789876543210 a0123456789876543210 = C2 a0123456789876543210 a0123456789876543210 - infixr 5 `C2Sym2` - type (:||@#@$) :: (~>) T0 ((~>) T2 T2) - data (:||@#@$) :: (~>) T0 ((~>) T2 T2) - where - (::||@#@$###) :: SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => - (:||@#@$) a0123456789876543210 - type instance Apply (:||@#@$) a0123456789876543210 = (:||@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:||@#@$) where - suppressUnusedWarnings = snd ((,) (::||@#@$###) ()) - infixr 5 :||@#@$ - type (:||@#@$$) :: T0 -> (~>) T2 T2 - data (:||@#@$$) (a0123456789876543210 :: T0) :: (~>) T2 T2 - where - (::||@#@$$###) :: SameKind (Apply ((:||@#@$$) a0123456789876543210) arg) ((:||@#@$$$) a0123456789876543210 arg) => - (:||@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:||@#@$$) a0123456789876543210) a0123456789876543210 = (:||) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:||@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::||@#@$$###) ()) - infixr 5 :||@#@$$ - type (:||@#@$$$) :: T0 -> T2 -> T2 - type family (:||@#@$$$) (a0123456789876543210 :: T0) (a0123456789876543210 :: T2) :: T2 where - (:||@#@$$$) a0123456789876543210 a0123456789876543210 = (:||) a0123456789876543210 a0123456789876543210 - infixr 5 :||@#@$$$ - infixr 5 :%|| - infixr 5 `SC2` - data ST2 :: T2 -> Type - where - SN2 :: ST2 (N2 :: T2) - SC2 :: forall (n :: T0) (n :: T2). - (Sing n) -> (Sing n) -> ST2 (C2 n n :: T2) - (:%||) :: forall (n :: T0) (n :: T2). - (Sing n) -> (Sing n) -> ST2 ((:||) n n :: T2) - type instance Sing @T2 = ST2 - 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 n => SingI1 (C2 (n :: T0)) where - liftSing = SC2 sing - instance SingI2 C2 where - liftSing2 = SC2 - instance SingI (C2Sym0 :: (~>) T0 ((~>) T2 T2)) where - sing = singFun2 @C2Sym0 SC2 - instance SingI d => SingI (C2Sym1 (d :: T0) :: (~>) T2 T2) where - sing = singFun1 @(C2Sym1 (d :: T0)) (SC2 (sing @d)) - instance SingI1 (C2Sym1 :: T0 -> (~>) T2 T2) where - liftSing (s :: Sing (d :: T0)) - = singFun1 @(C2Sym1 (d :: T0)) (SC2 s) - instance (SingI n, SingI n) => - SingI ((:||) (n :: T0) (n :: T2)) where - sing = (:%||) sing sing - instance SingI n => SingI1 ((:||) (n :: T0)) where - liftSing = (:%||) sing - instance SingI2 (:||) where - liftSing2 = (:%||) - instance SingI ((:||@#@$) :: (~>) T0 ((~>) T2 T2)) where - sing = singFun2 @(:||@#@$) (:%||) - instance SingI d => - SingI ((:||@#@$$) (d :: T0) :: (~>) T2 T2) where - sing = singFun1 @((:||@#@$$) (d :: T0)) ((:%||) (sing @d)) - instance SingI1 ((:||@#@$$) :: T0 -> (~>) T2 T2) where - liftSing (s :: Sing (d :: T0)) - = singFun1 @((:||@#@$$) (d :: T0)) ((:%||) s) +Singletons/T159.hs:0:0:: Splicing declarations+ genSingletons [''T0, ''T1]+ ======>+ type ASym0 :: T0+ type family ASym0 :: T0 where+ ASym0 = 'A+ type BSym0 :: T0+ type family BSym0 :: T0 where+ BSym0 = 'B+ type CSym0 :: T0+ type family CSym0 :: T0 where+ CSym0 = 'C+ type DSym0 :: T0+ type family DSym0 :: T0 where+ DSym0 = 'D+ type ESym0 :: T0+ type family ESym0 :: T0 where+ ESym0 = 'E+ type FSym0 :: T0+ type family FSym0 :: T0 where+ FSym0 = 'F+ type ST0 :: T0 -> Type+ data ST0 :: T0 -> Type+ where+ SA :: ST0 ('A :: T0)+ SB :: ST0 ('B :: T0)+ SC :: ST0 ('C :: T0)+ SD :: ST0 ('D :: T0)+ SE :: ST0 ('E :: T0)+ SF :: ST0 ('F :: T0)+ type instance Sing @T0 = ST0+ 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 :: T1+ type family N1Sym0 :: T1 where+ N1Sym0 = 'N1+ type C1Sym0 :: (~>) T0 ((~>) T1 T1)+ data C1Sym0 :: (~>) T0 ((~>) T1 T1)+ where+ C1Sym0KindInference :: SameKind (Apply C1Sym0 arg) (C1Sym1 arg) =>+ C1Sym0 a0123456789876543210+ type instance Apply @T0 @((~>) T1 T1) C1Sym0 a0123456789876543210 = C1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings C1Sym0 where+ suppressUnusedWarnings = snd ((,) C1Sym0KindInference ())+ infixr 5 type `C1Sym0`+ type C1Sym1 :: T0 -> (~>) T1 T1+ data C1Sym1 (a0123456789876543210 :: T0) :: (~>) T1 T1+ where+ C1Sym1KindInference :: SameKind (Apply (C1Sym1 a0123456789876543210) arg) (C1Sym2 a0123456789876543210 arg) =>+ C1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @T1 @T1 (C1Sym1 a0123456789876543210) a0123456789876543210 = 'C1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (C1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) C1Sym1KindInference ())+ infixr 5 type `C1Sym1`+ type C1Sym2 :: T0 -> T1 -> T1+ type family C1Sym2 (a0123456789876543210 :: T0) (a0123456789876543210 :: T1) :: T1 where+ C1Sym2 a0123456789876543210 a0123456789876543210 = 'C1 a0123456789876543210 a0123456789876543210+ infixr 5 type `C1Sym2`+ type (:&&@#@$) :: (~>) T0 ((~>) T1 T1)+ data (:&&@#@$) :: (~>) T0 ((~>) T1 T1)+ where+ (::&&@#@$###) :: SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) =>+ (:&&@#@$) a0123456789876543210+ type instance Apply @T0 @((~>) T1 T1) (:&&@#@$) a0123456789876543210 = (:&&@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:&&@#@$) where+ suppressUnusedWarnings = snd ((,) (::&&@#@$###) ())+ infixr 5 type :&&@#@$+ type (:&&@#@$$) :: T0 -> (~>) T1 T1+ data (:&&@#@$$) (a0123456789876543210 :: T0) :: (~>) T1 T1+ where+ (::&&@#@$$###) :: SameKind (Apply ((:&&@#@$$) a0123456789876543210) arg) ((:&&@#@$$$) a0123456789876543210 arg) =>+ (:&&@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @T1 @T1 ((:&&@#@$$) a0123456789876543210) a0123456789876543210 = '(:&&) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:&&@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::&&@#@$$###) ())+ infixr 5 type :&&@#@$$+ type (:&&@#@$$$) :: T0 -> T1 -> T1+ type family (:&&@#@$$$) (a0123456789876543210 :: T0) (a0123456789876543210 :: T1) :: T1 where+ (:&&@#@$$$) a0123456789876543210 a0123456789876543210 = '(:&&) a0123456789876543210 a0123456789876543210+ infixr 5 type :&&@#@$$$+ type ST1 :: T1 -> Type+ data ST1 :: T1 -> Type+ where+ SN1 :: ST1 ('N1 :: T1)+ SC1 :: forall (n :: T0) (n :: T1).+ (Sing n) -> (Sing n) -> ST1 ('C1 n n :: T1)+ (:%&&) :: forall (n :: T0) (n :: T1).+ (Sing n) -> (Sing n) -> ST1 ('(:&&) n n :: T1)+ type instance Sing @T1 = ST1+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SC1 c c))+ (toSing b :: SomeSing T0) (toSing b :: SomeSing T1)+ toSing ((:&&) (b :: Demote T0) (b :: Demote T1))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%&&) c c))+ (toSing b :: SomeSing T0) (toSing b :: SomeSing T1)+ infixr 5 data `SC1`+ infixr 5 data :%&&+ instance SingI 'N1 where+ sing = SN1+ instance (SingI n, SingI n) =>+ SingI ('C1 (n :: T0) (n :: T1)) where+ sing = SC1 sing sing+ instance SingI n => SingI1 ('C1 (n :: T0)) where+ liftSing = SC1 sing+ instance SingI2 'C1 where+ liftSing2 = SC1+ instance SingI (C1Sym0 :: (~>) T0 ((~>) T1 T1)) where+ sing = singFun2 @C1Sym0 SC1+ instance SingI d => SingI (C1Sym1 (d :: T0) :: (~>) T1 T1) where+ sing = singFun1 @(C1Sym1 (d :: T0)) (SC1 (sing @d))+ instance SingI1 (C1Sym1 :: T0 -> (~>) T1 T1) where+ liftSing (s :: Sing (d :: T0))+ = singFun1 @(C1Sym1 (d :: T0)) (SC1 s)+ instance (SingI n, SingI n) =>+ SingI ('(:&&) (n :: T0) (n :: T1)) where+ sing = (:%&&) sing sing+ instance SingI n => SingI1 ('(:&&) (n :: T0)) where+ liftSing = (:%&&) sing+ instance SingI2 '(:&&) where+ liftSing2 = (:%&&)+ instance SingI ((:&&@#@$) :: (~>) T0 ((~>) T1 T1)) where+ sing = singFun2 @(:&&@#@$) (:%&&)+ instance SingI d =>+ SingI ((:&&@#@$$) (d :: T0) :: (~>) T1 T1) where+ sing = singFun1 @((:&&@#@$$) (d :: T0)) ((:%&&) (sing @d))+ instance SingI1 ((:&&@#@$$) :: T0 -> (~>) T1 T1) where+ liftSing (s :: Sing (d :: T0))+ = singFun1 @((:&&@#@$$) (d :: T0)) ((:%&&) s)+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 :: T2+ type family N2Sym0 :: T2 where+ N2Sym0 = N2+ type C2Sym0 :: (~>) T0 ((~>) T2 T2)+ data C2Sym0 :: (~>) T0 ((~>) T2 T2)+ where+ C2Sym0KindInference :: SameKind (Apply C2Sym0 arg) (C2Sym1 arg) =>+ C2Sym0 a0123456789876543210+ type instance Apply @T0 @((~>) T2 T2) C2Sym0 a0123456789876543210 = C2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings C2Sym0 where+ suppressUnusedWarnings = snd ((,) C2Sym0KindInference ())+ infixr 5 type `C2Sym0`+ type C2Sym1 :: T0 -> (~>) T2 T2+ data C2Sym1 (a0123456789876543210 :: T0) :: (~>) T2 T2+ where+ C2Sym1KindInference :: SameKind (Apply (C2Sym1 a0123456789876543210) arg) (C2Sym2 a0123456789876543210 arg) =>+ C2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @T2 @T2 (C2Sym1 a0123456789876543210) a0123456789876543210 = C2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (C2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) C2Sym1KindInference ())+ infixr 5 type `C2Sym1`+ type C2Sym2 :: T0 -> T2 -> T2+ type family C2Sym2 (a0123456789876543210 :: T0) (a0123456789876543210 :: T2) :: T2 where+ C2Sym2 a0123456789876543210 a0123456789876543210 = C2 a0123456789876543210 a0123456789876543210+ infixr 5 type `C2Sym2`+ type (:||@#@$) :: (~>) T0 ((~>) T2 T2)+ data (:||@#@$) :: (~>) T0 ((~>) T2 T2)+ where+ (::||@#@$###) :: SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) =>+ (:||@#@$) a0123456789876543210+ type instance Apply @T0 @((~>) T2 T2) (:||@#@$) a0123456789876543210 = (:||@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:||@#@$) where+ suppressUnusedWarnings = snd ((,) (::||@#@$###) ())+ infixr 5 type :||@#@$+ type (:||@#@$$) :: T0 -> (~>) T2 T2+ data (:||@#@$$) (a0123456789876543210 :: T0) :: (~>) T2 T2+ where+ (::||@#@$$###) :: SameKind (Apply ((:||@#@$$) a0123456789876543210) arg) ((:||@#@$$$) a0123456789876543210 arg) =>+ (:||@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @T2 @T2 ((:||@#@$$) a0123456789876543210) a0123456789876543210 = (:||) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:||@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::||@#@$$###) ())+ infixr 5 type :||@#@$$+ type (:||@#@$$$) :: T0 -> T2 -> T2+ type family (:||@#@$$$) (a0123456789876543210 :: T0) (a0123456789876543210 :: T2) :: T2 where+ (:||@#@$$$) a0123456789876543210 a0123456789876543210 = (:||) a0123456789876543210 a0123456789876543210+ infixr 5 type :||@#@$$$+ infixr 5 data :%||+ infixr 5 data `SC2`+ data ST2 :: T2 -> Type+ where+ SN2 :: ST2 (N2 :: T2)+ SC2 :: forall (n :: T0) (n :: T2).+ (Sing n) -> (Sing n) -> ST2 (C2 n n :: T2)+ (:%||) :: forall (n :: T0) (n :: T2).+ (Sing n) -> (Sing n) -> ST2 ((:||) n n :: T2)+ type instance Sing @T2 = ST2+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SC2 c c))+ (toSing b :: SomeSing T0) (toSing b :: SomeSing T2)+ toSing ((:||) (b :: Demote T0) (b :: Demote T2))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%||) c c))+ (toSing b :: SomeSing T0) (toSing b :: SomeSing T2)+ instance SingI N2 where+ sing = SN2+ instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where+ sing = SC2 sing sing+ instance SingI n => SingI1 (C2 (n :: T0)) where+ liftSing = SC2 sing+ instance SingI2 C2 where+ liftSing2 = SC2+ instance SingI (C2Sym0 :: (~>) T0 ((~>) T2 T2)) where+ sing = singFun2 @C2Sym0 SC2+ instance SingI d => SingI (C2Sym1 (d :: T0) :: (~>) T2 T2) where+ sing = singFun1 @(C2Sym1 (d :: T0)) (SC2 (sing @d))+ instance SingI1 (C2Sym1 :: T0 -> (~>) T2 T2) where+ liftSing (s :: Sing (d :: T0))+ = singFun1 @(C2Sym1 (d :: T0)) (SC2 s)+ instance (SingI n, SingI n) =>+ SingI ((:||) (n :: T0) (n :: T2)) where+ sing = (:%||) sing sing+ instance SingI n => SingI1 ((:||) (n :: T0)) where+ liftSing = (:%||) sing+ instance SingI2 (:||) where+ liftSing2 = (:%||)+ instance SingI ((:||@#@$) :: (~>) T0 ((~>) T2 T2)) where+ sing = singFun2 @(:||@#@$) (:%||)+ instance SingI d =>+ SingI ((:||@#@$$) (d :: T0) :: (~>) T2 T2) where+ sing = singFun1 @((:||@#@$$) (d :: T0)) ((:%||) (sing @d))+ instance SingI1 ((:||@#@$$) :: T0 -> (~>) T2 T2) where+ liftSing (s :: Sing (d :: T0))+ = singFun1 @((:||@#@$$) (d :: T0)) ((:%||) s)
tests/compile-and-dump/Singletons/T159.hs view
@@ -1,27 +1,27 @@-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 +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.golden view
@@ -1,70 +1,61 @@-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) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1 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 FooSym0 :: (~>) a a - data FooSym0 :: (~>) a a - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: a -> a - type family FooSym1 (a0123456789876543210 :: a) :: a where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Foo :: a -> a - type family Foo (a :: a) :: a where - Foo x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) - sFoo :: - (forall (t :: a). - (SNum a, SEq a) => Sing t -> Sing (Apply FooSym0 t :: a) :: Type) - sFoo (sX :: Sing x) - = let - sScrutinee_0123456789876543210 :: - Sing @_ (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) - sScrutinee_0123456789876543210 - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sX) - (sFromInteger (sing :: Sing 0)) - in - id - @(Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x))) - (case sScrutinee_0123456789876543210 of - STrue -> sFromInteger (sing :: Sing 1) - SFalse - -> applySing - (applySing - (singFun2 @($@#@$) (%$)) (singFun1 @TypeErrorSym0 sTypeError)) - (applySing (singFun1 @ShowTypeSym0 SShowType) sX)) - instance (SNum a, SEq a) => SingI (FooSym0 :: (~>) a a) where - sing = singFun1 @FooSym0 sFoo - -Singletons/T160.hs:0:0: error: [GHC-64725] - • 1 - • In the expression: Refl - In an equation for ‘f’: f = Refl - | -13 | f = Refl - | ^^^^ +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 family LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x 'True = FromInteger 1+ LamCases_0123456789876543210 x 'False = Apply (Apply ($@#@$) TypeErrorSym0) (Apply ShowTypeSym0 x)+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type FooSym0 :: (~>) a a+ data FooSym0 :: (~>) a a+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @a @a FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: a -> a+ type family FooSym1 @a (a0123456789876543210 :: a) :: a where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Foo :: a -> a+ type family Foo @a (a :: a) :: a where+ Foo x = Apply (LamCases_0123456789876543210Sym0 x) (Apply (Apply (==@#@$) x) (FromInteger 0))+ sFoo ::+ (forall (t :: a).+ (SNum a, SEq a) => Sing t -> Sing (Foo t :: a) :: Type)+ sFoo (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases+ STrue -> sFromInteger (sing :: Sing 1)+ SFalse+ -> applySing+ (applySing+ (singFun2 @($@#@$) (%$)) (singFun1 @TypeErrorSym0 sTypeError))+ (applySing (singFun1 @ShowTypeSym0 SShowType) sX)))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sX)+ (sFromInteger (sing :: Sing 0)))+ instance (SNum a, SEq a) => SingI (FooSym0 :: (~>) a a) where+ sing = singFun1 @FooSym0 sFoo+Singletons/T160.hs:0:0: error: [GHC-64725]+ • 1+ • In the expression: Refl+ In an equation for ‘f’: f = Refl+ |+13 | f = Refl+ | ^^^^+
tests/compile-and-dump/Singletons/T160.hs view
@@ -1,13 +1,13 @@-module T160 where - -import Data.Singletons.Base.TypeError -import Data.Singletons.TH -import Prelude.Singletons - -$(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 +module T160 where++import Data.Singletons.Base.TypeError+import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,51 +1,51 @@-Singletons/T163.hs:0:0:: Splicing declarations - singletons [d| data a + b = L a | R b |] - ======> - data (+) a b = L a | R b - type LSym0 :: forall a b. (~>) a ((+) a b) - data LSym0 :: (~>) a ((+) a b) - where - LSym0KindInference :: SameKind (Apply LSym0 arg) (LSym1 arg) => - LSym0 a0123456789876543210 - type instance Apply LSym0 a0123456789876543210 = L a0123456789876543210 - instance SuppressUnusedWarnings LSym0 where - suppressUnusedWarnings = snd ((,) LSym0KindInference ()) - type LSym1 :: forall a b. a -> (+) a b - type family LSym1 (a0123456789876543210 :: a) :: (+) a b where - LSym1 a0123456789876543210 = L a0123456789876543210 - type RSym0 :: forall a b. (~>) b ((+) a b) - data RSym0 :: (~>) b ((+) a b) - where - RSym0KindInference :: SameKind (Apply RSym0 arg) (RSym1 arg) => - RSym0 a0123456789876543210 - type instance Apply RSym0 a0123456789876543210 = R a0123456789876543210 - instance SuppressUnusedWarnings RSym0 where - suppressUnusedWarnings = snd ((,) RSym0KindInference ()) - type RSym1 :: forall a b. b -> (+) a b - type family RSym1 (a0123456789876543210 :: b) :: (+) a b where - RSym1 a0123456789876543210 = R a0123456789876543210 - data (%+) :: forall a b. (+) a b -> Type - where - SL :: forall a b (n :: a). (Sing n) -> (%+) (L n :: (+) a b) - SR :: forall a b (n :: b). (Sing n) -> (%+) (R n :: (+) a b) - type instance Sing @((+) a b) = (%+) - 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 SingI1 L where - liftSing = SL - instance SingI (LSym0 :: (~>) a ((+) a b)) where - sing = singFun1 @LSym0 SL - instance SingI n => SingI (R (n :: b)) where - sing = SR sing - instance SingI1 R where - liftSing = SR - instance SingI (RSym0 :: (~>) b ((+) a b)) where - sing = singFun1 @RSym0 SR +Singletons/T163.hs:0:0:: Splicing declarations+ singletons [d| data a + b = L a | R b |]+ ======>+ data (+) a b = L a | R b+ type LSym0 :: forall a b. (~>) a ((+) a b)+ data LSym0 :: (~>) a ((+) a b)+ where+ LSym0KindInference :: SameKind (Apply LSym0 arg) (LSym1 arg) =>+ LSym0 a0123456789876543210+ type instance Apply @a @((+) a b) LSym0 a0123456789876543210 = L a0123456789876543210+ instance SuppressUnusedWarnings LSym0 where+ suppressUnusedWarnings = snd ((,) LSym0KindInference ())+ type LSym1 :: forall a b. a -> (+) a b+ type family LSym1 @a @b (a0123456789876543210 :: a) :: (+) a b where+ LSym1 a0123456789876543210 = L a0123456789876543210+ type RSym0 :: forall a b. (~>) b ((+) a b)+ data RSym0 :: (~>) b ((+) a b)+ where+ RSym0KindInference :: SameKind (Apply RSym0 arg) (RSym1 arg) =>+ RSym0 a0123456789876543210+ type instance Apply @b @((+) a b) RSym0 a0123456789876543210 = R a0123456789876543210+ instance SuppressUnusedWarnings RSym0 where+ suppressUnusedWarnings = snd ((,) RSym0KindInference ())+ type RSym1 :: forall a b. b -> (+) a b+ type family RSym1 @a @b (a0123456789876543210 :: b) :: (+) a b where+ RSym1 a0123456789876543210 = R a0123456789876543210+ data (%+) :: forall a b. (+) a b -> Type+ where+ SL :: forall a b (n :: a). (Sing n) -> (%+) (L n :: (+) a b)+ SR :: forall a b (n :: b). (Sing n) -> (%+) (R n :: (+) a b)+ type instance Sing @((+) a b) = (%+)+ 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))+ = (\cases (SomeSing c) -> SomeSing (SL c)) (toSing b :: SomeSing a)+ toSing (R (b :: Demote b))+ = (\cases (SomeSing c) -> SomeSing (SR c)) (toSing b :: SomeSing b)+ instance SingI n => SingI (L (n :: a)) where+ sing = SL sing+ instance SingI1 L where+ liftSing = SL+ instance SingI (LSym0 :: (~>) a ((+) a b)) where+ sing = singFun1 @LSym0 SL+ instance SingI n => SingI (R (n :: b)) where+ sing = SR sing+ instance SingI1 R where+ liftSing = SR+ instance SingI (RSym0 :: (~>) b ((+) a b)) where+ sing = singFun1 @RSym0 SR
tests/compile-and-dump/Singletons/T163.hs view
@@ -1,5 +1,5 @@-module T163 where - -import Data.Singletons.TH - -$(singletons [d| data a + b = L a | R b |]) +module T163 where++import Data.Singletons.TH++$(singletons [d| data a + b = L a | R b |])
tests/compile-and-dump/Singletons/T166.golden view
@@ -1,154 +1,128 @@-Singletons/T166.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| class Foo a where - foosPrec :: Natural -> a -> [Bool] -> [Bool] - foo :: a -> [Bool] - foo x s = foosPrec 0 x s |] - ======> - type FoosPrecSym0 :: forall a. (~>) Natural ((~>) a ((~>) [Bool] [Bool])) - data FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool])) - where - FoosPrecSym0KindInference :: SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => - FoosPrecSym0 a0123456789876543210 - type instance Apply FoosPrecSym0 a0123456789876543210 = FoosPrecSym1 a0123456789876543210 - instance SuppressUnusedWarnings FoosPrecSym0 where - suppressUnusedWarnings = snd ((,) FoosPrecSym0KindInference ()) - type FoosPrecSym1 :: forall a. Natural - -> (~>) a ((~>) [Bool] [Bool]) - data FoosPrecSym1 (a0123456789876543210 :: Natural) :: (~>) a ((~>) [Bool] [Bool]) - where - FoosPrecSym1KindInference :: SameKind (Apply (FoosPrecSym1 a0123456789876543210) arg) (FoosPrecSym2 a0123456789876543210 arg) => - FoosPrecSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FoosPrecSym1 a0123456789876543210) a0123456789876543210 = FoosPrecSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FoosPrecSym1KindInference ()) - type FoosPrecSym2 :: forall a. Natural -> a -> (~>) [Bool] [Bool] - data FoosPrecSym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) :: (~>) [Bool] [Bool] - where - FoosPrecSym2KindInference :: SameKind (Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrecSym3 a0123456789876543210 a0123456789876543210 arg) => - FoosPrecSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FoosPrecSym2KindInference ()) - type FoosPrecSym3 :: forall a. Natural -> a -> [Bool] -> [Bool] - type family FoosPrecSym3 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where - FoosPrecSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210 - type FooSym0 :: forall a. (~>) a [Bool] - data FooSym0 :: (~>) a [Bool] - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: forall a. a -> [Bool] - type family FooSym1 (a0123456789876543210 :: a) :: [Bool] where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type family Lambda_0123456789876543210 x s where - Lambda_0123456789876543210 x s = Apply (Apply (Apply FoosPrecSym0 (FromInteger 0)) x) s - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 s0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 s0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) s0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 s0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 x0123456789876543210 s0123456789876543210 where - Lambda_0123456789876543210Sym2 x0123456789876543210 s0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 s0123456789876543210 - type Foo_0123456789876543210 :: a -> [Bool] - type family Foo_0123456789876543210 (a :: a) :: [Bool] where - Foo_0123456789876543210 x = Apply Lambda_0123456789876543210Sym0 x - type Foo_0123456789876543210Sym0 :: (~>) a [Bool] - data Foo_0123456789876543210Sym0 :: (~>) a [Bool] - where - Foo_0123456789876543210Sym0KindInference :: SameKind (Apply Foo_0123456789876543210Sym0 arg) (Foo_0123456789876543210Sym1 arg) => - Foo_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Foo_0123456789876543210Sym0 a0123456789876543210 = Foo_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Foo_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Foo_0123456789876543210Sym0KindInference ()) - type Foo_0123456789876543210Sym1 :: a -> [Bool] - type family Foo_0123456789876543210Sym1 (a0123456789876543210 :: a) :: [Bool] where - Foo_0123456789876543210Sym1 a0123456789876543210 = Foo_0123456789876543210 a0123456789876543210 - class PFoo a where - type family FoosPrec (arg :: Natural) (arg :: a) (arg :: [Bool]) :: [Bool] - type family Foo (arg :: a) :: [Bool] - type Foo a = Apply Foo_0123456789876543210Sym0 a - class SFoo a where - sFoosPrec :: - (forall (t :: Natural) (t :: a) (t :: [Bool]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) :: Type) - sFoo :: - (forall (t :: a). - Sing t -> Sing (Apply FooSym0 t :: [Bool]) :: Type) - default sFoo :: - (forall (t :: a). - ((Apply FooSym0 t :: [Bool]) - ~ Apply Foo_0123456789876543210Sym0 t) => - Sing t -> Sing (Apply FooSym0 t :: [Bool]) :: Type) - sFoo (sX :: Sing x) - = singFun1 - @(Apply Lambda_0123456789876543210Sym0 x) - (\ sS - -> case sS of - (_ :: Sing s) - -> applySing - (applySing - (applySing - (singFun3 @FoosPrecSym0 sFoosPrec) (sFromInteger (sing :: Sing 0))) - sX) - sS) - instance SFoo a => - SingI (FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))) where - sing = singFun3 @FoosPrecSym0 sFoosPrec - instance (SFoo a, SingI d) => - SingI (FoosPrecSym1 (d :: Natural) :: (~>) a ((~>) [Bool] [Bool])) where - sing - = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec (sing @d)) - instance SFoo a => - SingI1 (FoosPrecSym1 :: Natural - -> (~>) a ((~>) [Bool] [Bool])) where - liftSing (s :: Sing (d :: Natural)) - = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec s) - instance (SFoo a, SingI d, SingI d) => - SingI (FoosPrecSym2 (d :: Natural) (d :: a) :: (~>) [Bool] [Bool]) where - sing - = singFun1 - @(FoosPrecSym2 (d :: Natural) (d :: a)) - (sFoosPrec (sing @d) (sing @d)) - instance (SFoo a, SingI d) => - SingI1 (FoosPrecSym2 (d :: Natural) :: a - -> (~>) [Bool] [Bool]) where - liftSing (s :: Sing (d :: a)) - = singFun1 - @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec (sing @d) s) - instance SFoo a => - SingI2 (FoosPrecSym2 :: Natural -> a -> (~>) [Bool] [Bool]) where - liftSing2 (s :: Sing (d :: Natural)) (s :: Sing (d :: a)) - = singFun1 @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec s s) - instance SFoo a => SingI (FooSym0 :: (~>) a [Bool]) where - sing = singFun1 @FooSym0 sFoo - -Singletons/T166.hs:0:0: error: [GHC-83865] - • 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’ - | -6 | $(singletonsOnly [d| - | ^^^^^^^^^^^^^^^^^^^... +Singletons/T166.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| class Foo a where+ foosPrec :: Natural -> a -> [Bool] -> [Bool]+ foo :: a -> [Bool]+ foo x s = foosPrec 0 x s |]+ ======>+ type FoosPrecSym0 :: forall a. (~>) Natural ((~>) a ((~>) [Bool] [Bool]))+ data FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))+ where+ FoosPrecSym0KindInference :: SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) =>+ FoosPrecSym0 a0123456789876543210+ type instance Apply @Natural @((~>) a ((~>) [Bool] [Bool])) FoosPrecSym0 a0123456789876543210 = FoosPrecSym1 a0123456789876543210+ instance SuppressUnusedWarnings FoosPrecSym0 where+ suppressUnusedWarnings = snd ((,) FoosPrecSym0KindInference ())+ type FoosPrecSym1 :: forall a. Natural+ -> (~>) a ((~>) [Bool] [Bool])+ data FoosPrecSym1 (a0123456789876543210 :: Natural) :: (~>) a ((~>) [Bool] [Bool])+ where+ FoosPrecSym1KindInference :: SameKind (Apply (FoosPrecSym1 a0123456789876543210) arg) (FoosPrecSym2 a0123456789876543210 arg) =>+ FoosPrecSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @((~>) [Bool] [Bool]) (FoosPrecSym1 a0123456789876543210) a0123456789876543210 = FoosPrecSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FoosPrecSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FoosPrecSym1KindInference ())+ type FoosPrecSym2 :: forall a. Natural -> a -> (~>) [Bool] [Bool]+ data FoosPrecSym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) :: (~>) [Bool] [Bool]+ where+ FoosPrecSym2KindInference :: SameKind (Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrecSym3 a0123456789876543210 a0123456789876543210 arg) =>+ FoosPrecSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @[Bool] @[Bool] (FoosPrecSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FoosPrecSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FoosPrecSym2KindInference ())+ type FoosPrecSym3 :: forall a. Natural -> a -> [Bool] -> [Bool]+ type family FoosPrecSym3 @a (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where+ FoosPrecSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210+ type FooSym0 :: forall a. (~>) a [Bool]+ data FooSym0 :: (~>) a [Bool]+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @a @[Bool] FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: forall a. a -> [Bool]+ type family FooSym1 @a (a0123456789876543210 :: a) :: [Bool] where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type family LamCases_0123456789876543210 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a x s = Apply (Apply (Apply FoosPrecSym0 (FromInteger 0)) x) s+ data LamCases_0123456789876543210Sym0 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type Foo_0123456789876543210 :: forall a. a -> [Bool]+ type family Foo_0123456789876543210 @a (a :: a) :: [Bool] where+ Foo_0123456789876543210 @a (x :: a) = LamCases_0123456789876543210Sym0 a x+ class PFoo a where+ type family FoosPrec (arg :: Natural) (arg :: a) (arg :: [Bool]) :: [Bool]+ type family Foo (arg :: a) :: [Bool]+ type Foo a = Foo_0123456789876543210 a+ class SFoo a where+ sFoosPrec ::+ (forall (t :: Natural) (t :: a) (t :: [Bool]).+ Sing t+ -> Sing t -> Sing t -> Sing (FoosPrec t t t :: [Bool]) :: Type)+ sFoo :: (forall (t :: a). Sing t -> Sing (Foo t :: [Bool]) :: Type)+ default sFoo ::+ (forall (t :: a).+ ((Foo t :: [Bool]) ~ Foo_0123456789876543210 t) =>+ Sing t -> Sing (Foo t :: [Bool]) :: Type)+ sFoo (sX :: Sing x)+ = singFun1+ @(LamCases_0123456789876543210Sym0 a x)+ (\cases+ (sS :: Sing s)+ -> applySing+ (applySing+ (applySing+ (singFun3 @FoosPrecSym0 sFoosPrec) (sFromInteger (sing :: Sing 0)))+ sX)+ sS)+ instance SFoo a =>+ SingI (FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))) where+ sing = singFun3 @FoosPrecSym0 sFoosPrec+ instance (SFoo a, SingI d) =>+ SingI (FoosPrecSym1 (d :: Natural) :: (~>) a ((~>) [Bool] [Bool])) where+ sing+ = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec (sing @d))+ instance SFoo a =>+ SingI1 (FoosPrecSym1 :: Natural+ -> (~>) a ((~>) [Bool] [Bool])) where+ liftSing (s :: Sing (d :: Natural))+ = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec s)+ instance (SFoo a, SingI d, SingI d) =>+ SingI (FoosPrecSym2 (d :: Natural) (d :: a) :: (~>) [Bool] [Bool]) where+ sing+ = singFun1+ @(FoosPrecSym2 (d :: Natural) (d :: a))+ (sFoosPrec (sing @d) (sing @d))+ instance (SFoo a, SingI d) =>+ SingI1 (FoosPrecSym2 (d :: Natural) :: a+ -> (~>) [Bool] [Bool]) where+ liftSing (s :: Sing (d :: a))+ = singFun1+ @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec (sing @d) s)+ instance SFoo a =>+ SingI2 (FoosPrecSym2 :: Natural -> a -> (~>) [Bool] [Bool]) where+ liftSing2 (s :: Sing (d :: Natural)) (s :: Sing (d :: a))+ = singFun1 @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec s s)+ instance SFoo a => SingI (FooSym0 :: (~>) a [Bool]) where+ sing = singFun1 @FooSym0 sFoo+Singletons/T166.hs:0:0: error: [GHC-83865]+ • Expecting one more argument to ‘LamCases_0123456789876543210Sym0 a x’+ Expected kind ‘[Bool]’,+ but ‘LamCases_0123456789876543210Sym0 a x’ has kind ‘TyFun+ [Bool] [Bool]+ -> Type’+ • In the type ‘LamCases_0123456789876543210Sym0 a x’+ In the type family declaration for ‘Foo_0123456789876543210’+ |+6 | $(singletonsOnly [d|+ | ^^^^^^^^^^^^^^^^^^^...+
tests/compile-and-dump/Singletons/T166.hs view
@@ -1,12 +1,12 @@-module SingletonsBug where - -import Data.Singletons.Base.TH -import GHC.TypeLits - -$(singletonsOnly [d| - class Foo a where - foosPrec :: Natural -> a -> [Bool] -> [Bool] - foo :: a -> [Bool] - - foo x s = foosPrec 0 x s - |]) +module SingletonsBug where++import Data.Singletons.Base.TH+import GHC.TypeLits++$(singletonsOnly [d|+ class Foo a where+ foosPrec :: Natural -> a -> [Bool] -> [Bool]+ foo :: a -> [Bool]++ foo x s = foosPrec 0 x s+ |])
tests/compile-and-dump/Singletons/T167.golden view
@@ -1,199 +1,134 @@-Singletons/T167.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| class Foo a where - foosPrec :: Natural -> a -> DiffList - fooList :: a -> DiffList - fooList = undefined - - instance Foo a => Foo [a] where - foosPrec _ = fooList |] - ======> - type FoosPrecSym0 :: forall a. (~>) Natural ((~>) a ((~>) [Bool] [Bool])) - data FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool])) - where - FoosPrecSym0KindInference :: SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => - FoosPrecSym0 a0123456789876543210 - type instance Apply FoosPrecSym0 a0123456789876543210 = FoosPrecSym1 a0123456789876543210 - instance SuppressUnusedWarnings FoosPrecSym0 where - suppressUnusedWarnings = snd ((,) FoosPrecSym0KindInference ()) - type FoosPrecSym1 :: forall a. Natural - -> (~>) a ((~>) [Bool] [Bool]) - data FoosPrecSym1 (a0123456789876543210 :: Natural) :: (~>) a ((~>) [Bool] [Bool]) - where - FoosPrecSym1KindInference :: SameKind (Apply (FoosPrecSym1 a0123456789876543210) arg) (FoosPrecSym2 a0123456789876543210 arg) => - FoosPrecSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FoosPrecSym1 a0123456789876543210) a0123456789876543210 = FoosPrecSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FoosPrecSym1KindInference ()) - type FoosPrecSym2 :: forall a. Natural -> a -> (~>) [Bool] [Bool] - data FoosPrecSym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) :: (~>) [Bool] [Bool] - where - FoosPrecSym2KindInference :: SameKind (Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrecSym3 a0123456789876543210 a0123456789876543210 arg) => - FoosPrecSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FoosPrecSym2KindInference ()) - type FoosPrecSym3 :: forall a. Natural -> a -> [Bool] -> [Bool] - type family FoosPrecSym3 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where - FoosPrecSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210 - type FooListSym0 :: forall a. (~>) a ((~>) [Bool] [Bool]) - data FooListSym0 :: (~>) a ((~>) [Bool] [Bool]) - where - FooListSym0KindInference :: SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => - FooListSym0 a0123456789876543210 - type instance Apply FooListSym0 a0123456789876543210 = FooListSym1 a0123456789876543210 - instance SuppressUnusedWarnings FooListSym0 where - suppressUnusedWarnings = snd ((,) FooListSym0KindInference ()) - type FooListSym1 :: forall a. a -> (~>) [Bool] [Bool] - data FooListSym1 (a0123456789876543210 :: a) :: (~>) [Bool] [Bool] - where - FooListSym1KindInference :: SameKind (Apply (FooListSym1 a0123456789876543210) arg) (FooListSym2 a0123456789876543210 arg) => - FooListSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooListSym1 a0123456789876543210) a0123456789876543210 = FooList a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooListSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FooListSym1KindInference ()) - type FooListSym2 :: forall a. a -> [Bool] -> [Bool] - type family FooListSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where - FooListSym2 a0123456789876543210 a0123456789876543210 = FooList a0123456789876543210 a0123456789876543210 - type FooList_0123456789876543210 :: a -> [Bool] -> [Bool] - 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_0123456789876543210Sym0 :: (~>) a ((~>) [Bool] [Bool]) - data FooList_0123456789876543210Sym0 :: (~>) a ((~>) [Bool] [Bool]) - where - FooList_0123456789876543210Sym0KindInference :: SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => - FooList_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FooList_0123456789876543210Sym0 a0123456789876543210 = FooList_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FooList_0123456789876543210Sym0KindInference ()) - type FooList_0123456789876543210Sym1 :: a -> (~>) [Bool] [Bool] - data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) [Bool] [Bool] - where - FooList_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) FooList_0123456789876543210Sym1KindInference ()) - type FooList_0123456789876543210Sym2 :: a -> [Bool] -> [Bool] - type family FooList_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where - FooList_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 - class PFoo a where - type family FoosPrec (arg :: Natural) (arg :: a) (arg :: [Bool]) :: [Bool] - type family FooList (arg :: a) (arg :: [Bool]) :: [Bool] - type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a - type FoosPrec_0123456789876543210 :: Natural - -> [a] -> [Bool] -> [Bool] - type family FoosPrec_0123456789876543210 (a :: Natural) (a :: [a]) (a :: [Bool]) :: [Bool] where - FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 - type FoosPrec_0123456789876543210Sym0 :: (~>) Natural ((~>) [a] ((~>) [Bool] [Bool])) - data FoosPrec_0123456789876543210Sym0 :: (~>) Natural ((~>) [a] ((~>) [Bool] [Bool])) - where - FoosPrec_0123456789876543210Sym0KindInference :: SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => - FoosPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FoosPrec_0123456789876543210Sym0KindInference ()) - type FoosPrec_0123456789876543210Sym1 :: Natural - -> (~>) [a] ((~>) [Bool] [Bool]) - data FoosPrec_0123456789876543210Sym1 (a0123456789876543210 :: Natural) :: (~>) [a] ((~>) [Bool] [Bool]) - where - FoosPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) FoosPrec_0123456789876543210Sym1KindInference ()) - type FoosPrec_0123456789876543210Sym2 :: Natural - -> [a] -> (~>) [Bool] [Bool] - data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: [a]) :: (~>) [Bool] [Bool] - where - FoosPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) FoosPrec_0123456789876543210Sym2KindInference ()) - type FoosPrec_0123456789876543210Sym3 :: Natural - -> [a] -> [Bool] -> [Bool] - type family FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Natural) (a0123456789876543210 :: [a]) (a0123456789876543210 :: [Bool]) :: [Bool] where - FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 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 :: Natural) (t :: a) (t :: [Bool]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) :: Type) - sFooList :: - (forall (t :: a) (t :: [Bool]). - Sing t - -> Sing t - -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) :: Type) - 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]) :: Type) - 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 :: Natural) (t :: [a]) (t :: [Bool]). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) :: Type) - 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 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))) where - sing = singFun3 @FoosPrecSym0 sFoosPrec - instance (SFoo a, SingI d) => - SingI (FoosPrecSym1 (d :: Natural) :: (~>) a ((~>) [Bool] [Bool])) where - sing - = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec (sing @d)) - instance SFoo a => - SingI1 (FoosPrecSym1 :: Natural - -> (~>) a ((~>) [Bool] [Bool])) where - liftSing (s :: Sing (d :: Natural)) - = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec s) - instance (SFoo a, SingI d, SingI d) => - SingI (FoosPrecSym2 (d :: Natural) (d :: a) :: (~>) [Bool] [Bool]) where - sing - = singFun1 - @(FoosPrecSym2 (d :: Natural) (d :: a)) - (sFoosPrec (sing @d) (sing @d)) - instance (SFoo a, SingI d) => - SingI1 (FoosPrecSym2 (d :: Natural) :: a - -> (~>) [Bool] [Bool]) where - liftSing (s :: Sing (d :: a)) - = singFun1 - @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec (sing @d) s) - instance SFoo a => - SingI2 (FoosPrecSym2 :: Natural -> a -> (~>) [Bool] [Bool]) where - liftSing2 (s :: Sing (d :: Natural)) (s :: Sing (d :: a)) - = singFun1 @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec s s) - 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)) - instance SFoo a => - SingI1 (FooListSym1 :: a -> (~>) [Bool] [Bool]) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(FooListSym1 (d :: a)) (sFooList s) +Singletons/T167.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| class Foo a where+ foosPrec :: Natural -> a -> DiffList+ fooList :: a -> DiffList+ fooList = undefined+ + instance Foo a => Foo [a] where+ foosPrec _ = fooList |]+ ======>+ type FoosPrecSym0 :: forall a. (~>) Natural ((~>) a ((~>) [Bool] [Bool]))+ data FoosPrecSym0 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))+ where+ FoosPrecSym0KindInference :: SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) =>+ FoosPrecSym0 a0123456789876543210+ type instance Apply @Natural @((~>) a ((~>) [Bool] [Bool])) FoosPrecSym0 a0123456789876543210 = FoosPrecSym1 a0123456789876543210+ instance SuppressUnusedWarnings FoosPrecSym0 where+ suppressUnusedWarnings = snd ((,) FoosPrecSym0KindInference ())+ type FoosPrecSym1 :: forall a. Natural+ -> (~>) a ((~>) [Bool] [Bool])+ data FoosPrecSym1 (a0123456789876543210 :: Natural) :: (~>) a ((~>) [Bool] [Bool])+ where+ FoosPrecSym1KindInference :: SameKind (Apply (FoosPrecSym1 a0123456789876543210) arg) (FoosPrecSym2 a0123456789876543210 arg) =>+ FoosPrecSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @((~>) [Bool] [Bool]) (FoosPrecSym1 a0123456789876543210) a0123456789876543210 = FoosPrecSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FoosPrecSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FoosPrecSym1KindInference ())+ type FoosPrecSym2 :: forall a. Natural -> a -> (~>) [Bool] [Bool]+ data FoosPrecSym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) :: (~>) [Bool] [Bool]+ where+ FoosPrecSym2KindInference :: SameKind (Apply (FoosPrecSym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrecSym3 a0123456789876543210 a0123456789876543210 arg) =>+ FoosPrecSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @[Bool] @[Bool] (FoosPrecSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FoosPrecSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FoosPrecSym2KindInference ())+ type FoosPrecSym3 :: forall a. Natural -> a -> [Bool] -> [Bool]+ type family FoosPrecSym3 @a (a0123456789876543210 :: Natural) (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where+ FoosPrecSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = FoosPrec a0123456789876543210 a0123456789876543210 a0123456789876543210+ type FooListSym0 :: forall a. (~>) a ((~>) [Bool] [Bool])+ data FooListSym0 :: (~>) a ((~>) [Bool] [Bool])+ where+ FooListSym0KindInference :: SameKind (Apply FooListSym0 arg) (FooListSym1 arg) =>+ FooListSym0 a0123456789876543210+ type instance Apply @a @((~>) [Bool] [Bool]) FooListSym0 a0123456789876543210 = FooListSym1 a0123456789876543210+ instance SuppressUnusedWarnings FooListSym0 where+ suppressUnusedWarnings = snd ((,) FooListSym0KindInference ())+ type FooListSym1 :: forall a. a -> (~>) [Bool] [Bool]+ data FooListSym1 (a0123456789876543210 :: a) :: (~>) [Bool] [Bool]+ where+ FooListSym1KindInference :: SameKind (Apply (FooListSym1 a0123456789876543210) arg) (FooListSym2 a0123456789876543210 arg) =>+ FooListSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[Bool] @[Bool] (FooListSym1 a0123456789876543210) a0123456789876543210 = FooList a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooListSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooListSym1KindInference ())+ type FooListSym2 :: forall a. a -> [Bool] -> [Bool]+ type family FooListSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: [Bool]) :: [Bool] where+ FooListSym2 a0123456789876543210 a0123456789876543210 = FooList a0123456789876543210 a0123456789876543210+ type FooList_0123456789876543210 :: forall a. a -> [Bool] -> [Bool]+ type family FooList_0123456789876543210 @a (a :: a) (a :: [Bool]) :: [Bool] where+ FooList_0123456789876543210 @a (a_0123456789876543210 :: a) (a_0123456789876543210 :: [Bool]) = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210+ class PFoo a where+ type family FoosPrec (arg :: Natural) (arg :: a) (arg :: [Bool]) :: [Bool]+ type family FooList (arg :: a) (arg :: [Bool]) :: [Bool]+ type FooList a a = FooList_0123456789876543210 a a+ type FoosPrec_0123456789876543210 :: forall a. Natural+ -> [a] -> [Bool] -> [Bool]+ type family FoosPrec_0123456789876543210 @a (a :: Natural) (a :: [a]) (a :: [Bool]) :: [Bool] where+ FoosPrec_0123456789876543210 @a (_ :: Natural) (a_0123456789876543210 :: [a]) (a_0123456789876543210 :: [Bool]) = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210+ instance PFoo [a] where+ type FoosPrec a a a = FoosPrec_0123456789876543210 a a a+ class SFoo a where+ sFoosPrec ::+ (forall (t :: Natural) (t :: a) (t :: [Bool]).+ Sing t+ -> Sing t -> Sing t -> Sing (FoosPrec t t t :: [Bool]) :: Type)+ sFooList ::+ (forall (t :: a) (t :: [Bool]).+ Sing t -> Sing t -> Sing (FooList t t :: [Bool]) :: Type)+ default sFooList ::+ (forall (t :: a) (t :: [Bool]).+ ((FooList t t :: [Bool]) ~ FooList_0123456789876543210 t t) =>+ Sing t -> Sing t -> Sing (FooList t t :: [Bool]) :: Type)+ sFooList+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing sUndefined sA_0123456789876543210)+ sA_0123456789876543210+ instance SFoo a => SFoo [a] where+ 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 :: (~>) Natural ((~>) a ((~>) [Bool] [Bool]))) where+ sing = singFun3 @FoosPrecSym0 sFoosPrec+ instance (SFoo a, SingI d) =>+ SingI (FoosPrecSym1 (d :: Natural) :: (~>) a ((~>) [Bool] [Bool])) where+ sing+ = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec (sing @d))+ instance SFoo a =>+ SingI1 (FoosPrecSym1 :: Natural+ -> (~>) a ((~>) [Bool] [Bool])) where+ liftSing (s :: Sing (d :: Natural))+ = singFun2 @(FoosPrecSym1 (d :: Natural)) (sFoosPrec s)+ instance (SFoo a, SingI d, SingI d) =>+ SingI (FoosPrecSym2 (d :: Natural) (d :: a) :: (~>) [Bool] [Bool]) where+ sing+ = singFun1+ @(FoosPrecSym2 (d :: Natural) (d :: a))+ (sFoosPrec (sing @d) (sing @d))+ instance (SFoo a, SingI d) =>+ SingI1 (FoosPrecSym2 (d :: Natural) :: a+ -> (~>) [Bool] [Bool]) where+ liftSing (s :: Sing (d :: a))+ = singFun1+ @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec (sing @d) s)+ instance SFoo a =>+ SingI2 (FoosPrecSym2 :: Natural -> a -> (~>) [Bool] [Bool]) where+ liftSing2 (s :: Sing (d :: Natural)) (s :: Sing (d :: a))+ = singFun1 @(FoosPrecSym2 (d :: Natural) (d :: a)) (sFoosPrec s s)+ 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))+ instance SFoo a =>+ SingI1 (FooListSym1 :: a -> (~>) [Bool] [Bool]) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(FooListSym1 (d :: a)) (sFooList s)
tests/compile-and-dump/Singletons/T167.hs view
@@ -1,16 +1,16 @@-module Singletons.T167 where - -import Data.Singletons.Base.TH -import GHC.TypeLits - -type DiffList = [Bool] -> [Bool] - -$(singletonsOnly [d| - class Foo a where - foosPrec :: Natural -> a -> DiffList - fooList :: a -> DiffList - fooList = undefined - - instance Foo a => Foo [a] where - foosPrec _ = fooList - |]) +module Singletons.T167 where++import Data.Singletons.Base.TH+import GHC.TypeLits++type DiffList = [Bool] -> [Bool]++$(singletonsOnly [d|+ class Foo a where+ foosPrec :: Natural -> a -> DiffList+ fooList :: a -> DiffList+ fooList = undefined++ instance Foo a => Foo [a] where+ foosPrec _ = fooList+ |])
tests/compile-and-dump/Singletons/T172.golden view
@@ -1,46 +1,45 @@-Singletons/T172.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| ($>) :: Natural -> Natural -> Natural - ($>) = (+) |] - ======> - type ($>@#@$) :: (~>) Natural ((~>) Natural Natural) - data ($>@#@$) :: (~>) Natural ((~>) Natural Natural) - where - (:$>@#@$###) :: SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => - ($>@#@$) a0123456789876543210 - type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings ($>@#@$) where - suppressUnusedWarnings = snd ((,) (:$>@#@$###) ()) - type ($>@#@$$) :: Natural -> (~>) Natural Natural - data ($>@#@$$) (a0123456789876543210 :: Natural) :: (~>) Natural Natural - where - (:$>@#@$$###) :: SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) => - ($>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:$>@#@$$###) ()) - type ($>@#@$$$) :: Natural -> Natural -> Natural - type family ($>@#@$$$) (a0123456789876543210 :: Natural) (a0123456789876543210 :: Natural) :: Natural where - ($>@#@$$$) a0123456789876543210 a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210 - type ($>) :: Natural -> Natural -> Natural - type family ($>) (a :: Natural) (a :: Natural) :: Natural where - ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 - (%$>) :: - (forall (t :: Natural) (t :: Natural). - Sing t - -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Natural) :: Type) - (%$>) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (applySing (singFun2 @(+@#@$) (%+)) sA_0123456789876543210) - sA_0123456789876543210 - instance SingI (($>@#@$) :: (~>) Natural ((~>) Natural Natural)) where - sing = singFun2 @($>@#@$) (%$>) - instance SingI d => - SingI (($>@#@$$) (d :: Natural) :: (~>) Natural Natural) where - sing = singFun1 @(($>@#@$$) (d :: Natural)) ((%$>) (sing @d)) - instance SingI1 (($>@#@$$) :: Natural - -> (~>) Natural Natural) where - liftSing (s :: Sing (d :: Natural)) - = singFun1 @(($>@#@$$) (d :: Natural)) ((%$>) s) +Singletons/T172.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| ($>) :: Natural -> Natural -> Natural+ ($>) = (+) |]+ ======>+ type ($>@#@$) :: (~>) Natural ((~>) Natural Natural)+ data ($>@#@$) :: (~>) Natural ((~>) Natural Natural)+ where+ (:$>@#@$###) :: SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) =>+ ($>@#@$) a0123456789876543210+ type instance Apply @Natural @((~>) Natural Natural) ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings ($>@#@$) where+ suppressUnusedWarnings = snd ((,) (:$>@#@$###) ())+ type ($>@#@$$) :: Natural -> (~>) Natural Natural+ data ($>@#@$$) (a0123456789876543210 :: Natural) :: (~>) Natural Natural+ where+ (:$>@#@$$###) :: SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) =>+ ($>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Natural @Natural (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:$>@#@$$###) ())+ type ($>@#@$$$) :: Natural -> Natural -> Natural+ type family ($>@#@$$$) (a0123456789876543210 :: Natural) (a0123456789876543210 :: Natural) :: Natural where+ ($>@#@$$$) a0123456789876543210 a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210+ type ($>) :: Natural -> Natural -> Natural+ type family ($>) (a :: Natural) (a :: Natural) :: Natural where+ ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210+ (%$>) ::+ (forall (t :: Natural) (t :: Natural).+ Sing t -> Sing t -> Sing (($>) t t :: Natural) :: Type)+ (%$>)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing (singFun2 @(+@#@$) (%+)) sA_0123456789876543210)+ sA_0123456789876543210+ instance SingI (($>@#@$) :: (~>) Natural ((~>) Natural Natural)) where+ sing = singFun2 @($>@#@$) (%$>)+ instance SingI d =>+ SingI (($>@#@$$) (d :: Natural) :: (~>) Natural Natural) where+ sing = singFun1 @(($>@#@$$) (d :: Natural)) ((%$>) (sing @d))+ instance SingI1 (($>@#@$$) :: Natural+ -> (~>) Natural Natural) where+ liftSing (s :: Sing (d :: Natural))+ = singFun1 @(($>@#@$$) (d :: Natural)) ((%$>) s)
tests/compile-and-dump/Singletons/T172.hs view
@@ -1,10 +1,10 @@-module T172 where - -import Data.Singletons.TH -import GHC.TypeLits.Singletons -import Prelude.Singletons - -$(singletonsOnly [d| - ($>) :: Natural -> Natural -> Natural - ($>) = (+) - |]) +module T172 where++import Data.Singletons.TH+import GHC.TypeLits.Singletons+import Prelude.Singletons++$(singletonsOnly [d|+ ($>) :: Natural -> Natural -> Natural+ ($>) = (+)+ |])
tests/compile-and-dump/Singletons/T175.golden view
@@ -1,55 +1,52 @@-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 :: a - type family Quux2Sym0 :: a where - Quux2Sym0 = Quux2 - type Quux2 :: a - type family Quux2 :: a where - Quux2 = BazSym0 - type BazSym0 :: forall a. a - type family BazSym0 :: a where - BazSym0 = Baz - class PFoo a where - type family Baz :: a - type Quux1Sym0 :: forall a. a - type family Quux1Sym0 :: a where - Quux1Sym0 = Quux1 - type Quux1_0123456789876543210 :: a - type family Quux1_0123456789876543210 :: a where - Quux1_0123456789876543210 = BazSym0 - type Quux1_0123456789876543210Sym0 :: a - type family Quux1_0123456789876543210Sym0 :: a where - Quux1_0123456789876543210Sym0 = Quux1_0123456789876543210 - class PBar1 a where - type family Quux1 :: a - type Quux1 = Quux1_0123456789876543210Sym0 - class PBar2 a - sQuux2 :: (SBar2 a => Sing (Quux2Sym0 :: a) :: Type) - sQuux2 = sBaz - class SFoo a where - sBaz :: (Sing (BazSym0 :: a) :: Type) - class SFoo a => SBar1 a where - sQuux1 :: (Sing (Quux1Sym0 :: a) :: Type) - default sQuux1 :: - (((Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0) => - Sing (Quux1Sym0 :: a) :: Type) - sQuux1 = sBaz - class SFoo a => SBar2 a +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 :: a+ type family Quux2Sym0 @a :: a where+ Quux2Sym0 = Quux2+ type Quux2 :: a+ type family Quux2 @a :: a where+ Quux2 = BazSym0+ type BazSym0 :: forall a. a+ type family BazSym0 @a :: a where+ BazSym0 = Baz+ class PFoo a where+ type family Baz :: a+ type Quux1Sym0 :: forall a. a+ type family Quux1Sym0 @a :: a where+ Quux1Sym0 = Quux1+ type Quux1_0123456789876543210 :: forall a. a+ type family Quux1_0123456789876543210 @a :: a where+ Quux1_0123456789876543210 @a = BazSym0+ class PBar1 a where+ type family Quux1 :: a+ type Quux1 = Quux1_0123456789876543210+ class PBar2 a+ sQuux2 :: (SBar2 a => Sing (Quux2 :: a) :: Type)+ sQuux2 = sBaz+ class SFoo a where+ sBaz :: (Sing (Baz :: a) :: Type)+ class SFoo a => SBar1 a where+ sQuux1 :: (Sing (Quux1 :: a) :: Type)+ default sQuux1 ::+ (((Quux1 :: a) ~ Quux1_0123456789876543210) =>+ Sing (Quux1 :: a) :: Type)+ sQuux1 = sBaz+ class SFoo a => SBar2 a
tests/compile-and-dump/Singletons/T175.hs view
@@ -1,18 +1,18 @@-module T175 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(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 - |]) +module T175 where++import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,175 +1,157 @@-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 arg_0123456789876543210 x t where - Case_0123456789876543210 arg_0123456789876543210 x _ = Baz1Sym0 - type family Lambda_0123456789876543210 x arg_0123456789876543210 where - Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 x0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2 x0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 arg_01234567898765432100123456789876543210 - type Quux2Sym0 :: (~>) a a - data Quux2Sym0 :: (~>) a a - where - Quux2Sym0KindInference :: SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => - Quux2Sym0 a0123456789876543210 - type instance Apply Quux2Sym0 a0123456789876543210 = Quux2 a0123456789876543210 - instance SuppressUnusedWarnings Quux2Sym0 where - suppressUnusedWarnings = snd ((,) Quux2Sym0KindInference ()) - type Quux2Sym1 :: a -> a - type family Quux2Sym1 (a0123456789876543210 :: a) :: a where - Quux2Sym1 a0123456789876543210 = Quux2 a0123456789876543210 - type Quux1Sym0 :: (~>) a a - data Quux1Sym0 :: (~>) a a - where - Quux1Sym0KindInference :: SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => - Quux1Sym0 a0123456789876543210 - type instance Apply Quux1Sym0 a0123456789876543210 = Quux1 a0123456789876543210 - instance SuppressUnusedWarnings Quux1Sym0 where - suppressUnusedWarnings = snd ((,) Quux1Sym0KindInference ()) - type Quux1Sym1 :: a -> a - type family Quux1Sym1 (a0123456789876543210 :: a) :: a where - Quux1Sym1 a0123456789876543210 = Quux1 a0123456789876543210 - type Quux2 :: a -> a - type family Quux2 (a :: a) :: a where - Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 - type Quux1 :: a -> a - type family Quux1 (a :: a) :: a where - Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) - type Bar1Sym0 :: forall a b. (~>) a ((~>) ((~>) a b) b) - data Bar1Sym0 :: (~>) a ((~>) ((~>) a b) b) - where - Bar1Sym0KindInference :: SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => - Bar1Sym0 a0123456789876543210 - type instance Apply Bar1Sym0 a0123456789876543210 = Bar1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Bar1Sym0 where - suppressUnusedWarnings = snd ((,) Bar1Sym0KindInference ()) - type Bar1Sym1 :: forall a b. a -> (~>) ((~>) a b) b - data Bar1Sym1 (a0123456789876543210 :: a) :: (~>) ((~>) a b) b - where - Bar1Sym1KindInference :: SameKind (Apply (Bar1Sym1 a0123456789876543210) arg) (Bar1Sym2 a0123456789876543210 arg) => - Bar1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Bar1Sym1 a0123456789876543210) a0123456789876543210 = Bar1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Bar1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Bar1Sym1KindInference ()) - type Bar1Sym2 :: forall a b. a -> (~>) a b -> b - type family Bar1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: (~>) a b) :: b where - Bar1Sym2 a0123456789876543210 a0123456789876543210 = Bar1 a0123456789876543210 a0123456789876543210 - type Baz1Sym0 :: forall a. a - type family Baz1Sym0 :: a where - Baz1Sym0 = Baz1 - class PFoo1 a where - type family Bar1 (arg :: a) (arg :: (~>) a b) :: b - type family Baz1 :: a - type Bar2Sym0 :: forall a b. (~>) a ((~>) b b) - data Bar2Sym0 :: (~>) a ((~>) b b) - where - Bar2Sym0KindInference :: SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => - Bar2Sym0 a0123456789876543210 - type instance Apply Bar2Sym0 a0123456789876543210 = Bar2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Bar2Sym0 where - suppressUnusedWarnings = snd ((,) Bar2Sym0KindInference ()) - type Bar2Sym1 :: forall a b. a -> (~>) b b - data Bar2Sym1 (a0123456789876543210 :: a) :: (~>) b b - where - Bar2Sym1KindInference :: SameKind (Apply (Bar2Sym1 a0123456789876543210) arg) (Bar2Sym2 a0123456789876543210 arg) => - Bar2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Bar2Sym1 a0123456789876543210) a0123456789876543210 = Bar2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Bar2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Bar2Sym1KindInference ()) - type Bar2Sym2 :: forall a b. a -> b -> b - type family Bar2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - Bar2Sym2 a0123456789876543210 a0123456789876543210 = Bar2 a0123456789876543210 a0123456789876543210 - type Baz2Sym0 :: forall a. a - type family Baz2Sym0 :: a where - Baz2Sym0 = Baz2 - class PFoo2 a where - type family Bar2 (arg :: a) (arg :: b) :: b - type family Baz2 :: a - sQuux2 :: - (forall (t :: a). - SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a) :: Type) - sQuux1 :: - (forall (t :: a). - SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a) :: Type) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210)) - (case sArg_0123456789876543210 of _ -> sBaz1))) - 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 (t :: a) (t :: (~>) a b). - Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b) :: Type) - sBaz1 :: (Sing (Baz1Sym0 :: a) :: Type) - class SFoo2 a where - sBar2 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b) :: Type) - sBaz2 :: (Sing (Baz2Sym0 :: a) :: Type) - 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 SFoo1 a => - SingI1 (Bar1Sym1 :: a -> (~>) ((~>) a b) b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Bar1Sym1 (d :: a)) (sBar1 s) - 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)) - instance SFoo2 a => SingI1 (Bar2Sym1 :: a -> (~>) b b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Bar2Sym1 (d :: a)) (sBar2 s) +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 LamCases_0123456789876543210 (x0123456789876543210 :: a0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 x _ = Baz1Sym0+ data LamCases_0123456789876543210Sym0 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (x0123456789876543210 :: a0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type Quux2Sym0 :: (~>) a a+ data Quux2Sym0 :: (~>) a a+ where+ Quux2Sym0KindInference :: SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) =>+ Quux2Sym0 a0123456789876543210+ type instance Apply @a @a Quux2Sym0 a0123456789876543210 = Quux2 a0123456789876543210+ instance SuppressUnusedWarnings Quux2Sym0 where+ suppressUnusedWarnings = snd ((,) Quux2Sym0KindInference ())+ type Quux2Sym1 :: a -> a+ type family Quux2Sym1 @a (a0123456789876543210 :: a) :: a where+ Quux2Sym1 a0123456789876543210 = Quux2 a0123456789876543210+ type Quux1Sym0 :: (~>) a a+ data Quux1Sym0 :: (~>) a a+ where+ Quux1Sym0KindInference :: SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) =>+ Quux1Sym0 a0123456789876543210+ type instance Apply @a @a Quux1Sym0 a0123456789876543210 = Quux1 a0123456789876543210+ instance SuppressUnusedWarnings Quux1Sym0 where+ suppressUnusedWarnings = snd ((,) Quux1Sym0KindInference ())+ type Quux1Sym1 :: a -> a+ type family Quux1Sym1 @a (a0123456789876543210 :: a) :: a where+ Quux1Sym1 a0123456789876543210 = Quux1 a0123456789876543210+ type Quux2 :: a -> a+ type family Quux2 @a (a :: a) :: a where+ Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0+ type Quux1 :: a -> a+ type family Quux1 @a (a :: a) :: a where+ Quux1 x = Apply (Apply Bar1Sym0 x) (LamCases_0123456789876543210Sym0 x)+ type Bar1Sym0 :: forall a b. (~>) a ((~>) ((~>) a b) b)+ data Bar1Sym0 :: (~>) a ((~>) ((~>) a b) b)+ where+ Bar1Sym0KindInference :: SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) =>+ Bar1Sym0 a0123456789876543210+ type instance Apply @a @((~>) ((~>) a b) b) Bar1Sym0 a0123456789876543210 = Bar1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Bar1Sym0 where+ suppressUnusedWarnings = snd ((,) Bar1Sym0KindInference ())+ type Bar1Sym1 :: forall a b. a -> (~>) ((~>) a b) b+ data Bar1Sym1 (a0123456789876543210 :: a) :: (~>) ((~>) a b) b+ where+ Bar1Sym1KindInference :: SameKind (Apply (Bar1Sym1 a0123456789876543210) arg) (Bar1Sym2 a0123456789876543210 arg) =>+ Bar1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @((~>) a b) @b (Bar1Sym1 a0123456789876543210) a0123456789876543210 = Bar1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Bar1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Bar1Sym1KindInference ())+ type Bar1Sym2 :: forall a b. a -> (~>) a b -> b+ type family Bar1Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: (~>) a b) :: b where+ Bar1Sym2 a0123456789876543210 a0123456789876543210 = Bar1 a0123456789876543210 a0123456789876543210+ type Baz1Sym0 :: forall a. a+ type family Baz1Sym0 @a :: a where+ Baz1Sym0 = Baz1+ class PFoo1 a where+ type family Bar1 (arg :: a) (arg :: (~>) a b) :: b+ type family Baz1 :: a+ type Bar2Sym0 :: forall a b. (~>) a ((~>) b b)+ data Bar2Sym0 :: (~>) a ((~>) b b)+ where+ Bar2Sym0KindInference :: SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) =>+ Bar2Sym0 a0123456789876543210+ type instance Apply @a @((~>) b b) Bar2Sym0 a0123456789876543210 = Bar2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Bar2Sym0 where+ suppressUnusedWarnings = snd ((,) Bar2Sym0KindInference ())+ type Bar2Sym1 :: forall a b. a -> (~>) b b+ data Bar2Sym1 (a0123456789876543210 :: a) :: (~>) b b+ where+ Bar2Sym1KindInference :: SameKind (Apply (Bar2Sym1 a0123456789876543210) arg) (Bar2Sym2 a0123456789876543210 arg) =>+ Bar2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @b (Bar2Sym1 a0123456789876543210) a0123456789876543210 = Bar2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Bar2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Bar2Sym1KindInference ())+ type Bar2Sym2 :: forall a b. a -> b -> b+ type family Bar2Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where+ Bar2Sym2 a0123456789876543210 a0123456789876543210 = Bar2 a0123456789876543210 a0123456789876543210+ type Baz2Sym0 :: forall a. a+ type family Baz2Sym0 @a :: a where+ Baz2Sym0 = Baz2+ class PFoo2 a where+ type family Bar2 (arg :: a) (arg :: b) :: b+ type family Baz2 :: a+ sQuux2 ::+ (forall (t :: a). SFoo2 a => Sing t -> Sing (Quux2 t :: a) :: Type)+ sQuux1 ::+ (forall (t :: a). SFoo1 a => Sing t -> Sing (Quux1 t :: a) :: Type)+ sQuux2 (sX :: Sing x)+ = applySing (applySing (singFun2 @Bar2Sym0 sBar2) sX) sBaz2+ sQuux1 (sX :: Sing x)+ = applySing+ (applySing (singFun2 @Bar1Sym0 sBar1) sX)+ (singFun1+ @(LamCases_0123456789876543210Sym0 x) (\cases _ -> sBaz1))+ 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 (t :: a) (t :: (~>) a b).+ Sing t -> Sing t -> Sing (Bar1 t t :: b) :: Type)+ sBaz1 :: (Sing (Baz1 :: a) :: Type)+ class SFoo2 a where+ sBar2 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Bar2 t t :: b) :: Type)+ sBaz2 :: (Sing (Baz2 :: a) :: Type)+ 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 SFoo1 a =>+ SingI1 (Bar1Sym1 :: a -> (~>) ((~>) a b) b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Bar1Sym1 (d :: a)) (sBar1 s)+ 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))+ instance SFoo2 a => SingI1 (Bar2Sym1 :: a -> (~>) b b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Bar2Sym1 (d :: a)) (sBar2 s)
tests/compile-and-dump/Singletons/T176.hs view
@@ -1,21 +1,21 @@-module T176 where - -import Data.Kind (Type) -import Data.Singletons.TH -import Prelude.Singletons - -$(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 - |]) +module T176 where++import Data.Kind (Type)+import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,259 +1,172 @@-Singletons/T178.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| empty :: U - empty = [] - - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] |] - ======> - data Occ - = Str | Opt | Many - deriving (Eq, Ord, Show) - type U = [(Symbol, Occ)] - empty :: U - empty = [] - type family USym0 where - USym0 = U - type StrSym0 :: Occ - type family StrSym0 :: Occ where - StrSym0 = Str - type OptSym0 :: Occ - type family OptSym0 :: Occ where - OptSym0 = Opt - type ManySym0 :: Occ - type family ManySym0 :: Occ where - ManySym0 = Many - type EmptySym0 :: [(Symbol, Occ)] - type family EmptySym0 :: [(Symbol, Occ)] where - EmptySym0 = Empty - type Empty :: [(Symbol, Occ)] - type family Empty :: [(Symbol, Occ)] where - Empty = NilSym0 - type TFHelper_0123456789876543210 :: Occ -> Occ -> Bool - type family TFHelper_0123456789876543210 (a :: Occ) (a :: Occ) :: Bool where - TFHelper_0123456789876543210 Str Str = TrueSym0 - TFHelper_0123456789876543210 Str Opt = FalseSym0 - TFHelper_0123456789876543210 Str Many = FalseSym0 - TFHelper_0123456789876543210 Opt Str = FalseSym0 - TFHelper_0123456789876543210 Opt Opt = TrueSym0 - TFHelper_0123456789876543210 Opt Many = FalseSym0 - TFHelper_0123456789876543210 Many Str = FalseSym0 - TFHelper_0123456789876543210 Many Opt = FalseSym0 - TFHelper_0123456789876543210 Many Many = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Occ -> (~>) Occ Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Occ) :: (~>) Occ Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Occ -> Occ -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Occ where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Occ -> Occ -> Ordering - type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where - Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - 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_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Occ -> (~>) Occ Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Occ) :: (~>) Occ Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Occ -> Occ -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Occ where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: Natural - -> Occ -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: Natural) (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_0123456789876543210Sym0 :: (~>) Natural ((~>) Occ ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) Natural ((~>) Occ ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: Natural - -> (~>) Occ ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: Natural) :: (~>) Occ ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: Natural - -> Occ -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Natural) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: Natural - -> Occ -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Natural) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow Occ where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - sEmpty :: (Sing (EmptySym0 :: [(Symbol, Occ)]) :: Type) - sEmpty = SNil - data SOcc :: Occ -> Type - where - SStr :: SOcc (Str :: Occ) - SOpt :: SOcc (Opt :: Occ) - SMany :: SOcc (Many :: Occ) - type instance Sing @Occ = SOcc - instance SingKind Occ where - type Demote Occ = Occ - fromSing SStr = Str - fromSing SOpt = Opt - fromSing SMany = Many - toSing Str = SomeSing SStr - toSing Opt = SomeSing SOpt - toSing Many = SomeSing SMany - instance SEq Occ where - (%==) :: - forall (t1 :: Occ) (t2 :: Occ). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Occ ((~>) Occ Bool) - -> Type) t1) t2) - (%==) 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 SOrd Occ where - sCompare :: - forall (t1 :: Occ) (t2 :: Occ). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ ((~>) Occ Ordering) - -> Type) t1) t2) - sCompare SStr SStr - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SOpt SOpt - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SMany SMany - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SStr SOpt = SLT - sCompare SStr SMany = SLT - sCompare SOpt SStr = SGT - sCompare SOpt SMany = SLT - sCompare SMany SStr = SGT - sCompare SMany SOpt = SGT - instance SShow Occ where - sShowsPrec :: - forall (t1 :: Natural) (t2 :: Occ) (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Natural ((~>) Occ ((~>) Symbol Symbol)) - -> 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 SDecide Occ where - (%~) SStr SStr = Proved Refl - (%~) SStr SOpt = Disproved (\ x -> case x of {}) - (%~) SStr SMany = Disproved (\ x -> case x of {}) - (%~) SOpt SStr = Disproved (\ x -> case x of {}) - (%~) SOpt SOpt = Proved Refl - (%~) SOpt SMany = Disproved (\ x -> case x of {}) - (%~) SMany SStr = Disproved (\ x -> case x of {}) - (%~) SMany SOpt = Disproved (\ x -> case x of {}) - (%~) SMany SMany = Proved Refl - instance Data.Type.Equality.TestEquality (SOcc :: Occ - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (SOcc :: Occ - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Show (SOcc (z :: Occ)) - instance SingI Str where - sing = SStr - instance SingI Opt where - sing = SOpt - instance SingI Many where - sing = SMany +Singletons/T178.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| empty :: U+ empty = []+ + data Occ+ = Str | Opt | Many+ deriving (Eq, Ord, Show)+ type U = [(Symbol, Occ)] |]+ ======>+ data Occ+ = Str | Opt | Many+ deriving (Eq, Ord, Show)+ type U = [(Symbol, Occ)]+ empty :: U+ empty = []+ type family USym0 where+ USym0 = U+ type StrSym0 :: Occ+ type family StrSym0 :: Occ where+ StrSym0 = Str+ type OptSym0 :: Occ+ type family OptSym0 :: Occ where+ OptSym0 = Opt+ type ManySym0 :: Occ+ type family ManySym0 :: Occ where+ ManySym0 = Many+ type EmptySym0 :: [(Symbol, Occ)]+ type family EmptySym0 :: [(Symbol, Occ)] where+ EmptySym0 = Empty+ type Empty :: [(Symbol, Occ)]+ type family Empty :: [(Symbol, Occ)] where+ Empty = NilSym0+ type TFHelper_0123456789876543210 :: Occ -> Occ -> Bool+ type family TFHelper_0123456789876543210 (a :: Occ) (a :: Occ) :: Bool where+ TFHelper_0123456789876543210 Str Str = TrueSym0+ TFHelper_0123456789876543210 Str Opt = FalseSym0+ TFHelper_0123456789876543210 Str Many = FalseSym0+ TFHelper_0123456789876543210 Opt Str = FalseSym0+ TFHelper_0123456789876543210 Opt Opt = TrueSym0+ TFHelper_0123456789876543210 Opt Many = FalseSym0+ TFHelper_0123456789876543210 Many Str = FalseSym0+ TFHelper_0123456789876543210 Many Opt = FalseSym0+ TFHelper_0123456789876543210 Many Many = TrueSym0+ instance PEq Occ where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: Occ -> Occ -> Ordering+ type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where+ Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ 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+ instance POrd Occ where+ type Compare a a = Compare_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: Natural+ -> Occ -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: Natural) (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+ instance PShow Occ where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ sEmpty :: (Sing (Empty :: [(Symbol, Occ)]) :: Type)+ sEmpty = SNil+ data SOcc :: Occ -> Type+ where+ SStr :: SOcc (Str :: Occ)+ SOpt :: SOcc (Opt :: Occ)+ SMany :: SOcc (Many :: Occ)+ type instance Sing @Occ = SOcc+ instance SingKind Occ where+ type Demote Occ = Occ+ fromSing SStr = Str+ fromSing SOpt = Opt+ fromSing SMany = Many+ toSing Str = SomeSing SStr+ toSing Opt = SomeSing SOpt+ toSing Many = SomeSing SMany+ instance SEq Occ where+ (%==) SStr SStr = STrue+ (%==) SStr SOpt = SFalse+ (%==) SStr SMany = SFalse+ (%==) SOpt SStr = SFalse+ (%==) SOpt SOpt = STrue+ (%==) SOpt SMany = SFalse+ (%==) SMany SStr = SFalse+ (%==) SMany SOpt = SFalse+ (%==) SMany SMany = STrue+ instance SOrd Occ where+ sCompare SStr SStr+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SOpt SOpt+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SMany SMany+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SStr SOpt = SLT+ sCompare SStr SMany = SLT+ sCompare SOpt SStr = SGT+ sCompare SOpt SMany = SLT+ sCompare SMany SStr = SGT+ sCompare SMany SOpt = SGT+ instance SShow Occ where+ 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 SDecide Occ where+ (%~) SStr SStr = Proved Refl+ (%~) SStr SOpt = Disproved (\case)+ (%~) SStr SMany = Disproved (\case)+ (%~) SOpt SStr = Disproved (\case)+ (%~) SOpt SOpt = Proved Refl+ (%~) SOpt SMany = Disproved (\case)+ (%~) SMany SStr = Disproved (\case)+ (%~) SMany SOpt = Disproved (\case)+ (%~) SMany SMany = Proved Refl+ instance Eq (SOcc (z :: Occ)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (SOcc :: Occ+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (SOcc :: Occ+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SOcc (z :: Occ)) where+ compare _ _ = EQ+ deriving instance Show (SOcc (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 view
@@ -1,15 +1,15 @@-module T178 where - -import GHC.TypeLits -import Data.Singletons.Base.TH - -$(singletons [d| - - -- Note: Ord automatically defines "max" - data Occ = Str | Opt | Many deriving (Eq, Ord, Show) - - type U = [(Symbol,Occ)] - - empty :: U - empty = [] - |]) +module T178 where++import GHC.TypeLits+import Data.Singletons.Base.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.golden view
@@ -1,532 +1,480 @@-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 - foo8 x@(Nothing :: 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 - foo8 x@(Nothing :: Maybe a) = x - foo9 :: a -> a - foo9 (x :: a) - = let - g :: a -> b -> a - g y _ = y - in g x () - data Let0123456789876543210GSym0 x0123456789876543210 - where - Let0123456789876543210GSym0KindInference :: SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) => - Let0123456789876543210GSym0 x0123456789876543210 - type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210GSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210GSym0KindInference ()) - data Let0123456789876543210GSym1 x0123456789876543210 :: (~>) a ((~>) b0123456789876543210 a) - where - Let0123456789876543210GSym1KindInference :: SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 arg) => - Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210GSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210GSym1KindInference ()) - data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: (~>) b0123456789876543210 a - where - Let0123456789876543210GSym2KindInference :: SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) => - Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210GSym2KindInference ()) - type family Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) :: a where - Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 a0123456789876543210 = Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 - type family Let0123456789876543210G x (a :: a) (a :: b) :: a where - Let0123456789876543210G x y _ = y - data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210XSym0KindInference :: SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => - Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210XSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210XSym0KindInference ()) - type family Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 where - Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 - type family Let0123456789876543210X wild_0123456789876543210 where - Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a - type family Let0123456789876543210XSym0 where - Let0123456789876543210XSym0 = Let0123456789876543210X - type family Let0123456789876543210X where - Let0123456789876543210X = NothingSym0 :: Maybe a - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1 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 arg_0123456789876543210 where - Lambda_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 arg_01234567898765432100123456789876543210 - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1 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 Foo9Sym0 :: (~>) a a - data Foo9Sym0 :: (~>) a a - where - Foo9Sym0KindInference :: SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => - Foo9Sym0 a0123456789876543210 - type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 - instance SuppressUnusedWarnings Foo9Sym0 where - suppressUnusedWarnings = snd ((,) Foo9Sym0KindInference ()) - type Foo9Sym1 :: a -> a - type family Foo9Sym1 (a0123456789876543210 :: a) :: a where - Foo9Sym1 a0123456789876543210 = Foo9 a0123456789876543210 - type Foo8Sym0 :: forall a. (~>) (Maybe a) (Maybe a) - data Foo8Sym0 :: (~>) (Maybe a) (Maybe a) - where - Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => - Foo8Sym0 a0123456789876543210 - type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 - instance SuppressUnusedWarnings Foo8Sym0 where - suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ()) - type Foo8Sym1 :: forall a. Maybe a -> Maybe a - type family Foo8Sym1 (a0123456789876543210 :: Maybe a) :: Maybe a where - Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210 - type Foo7Sym0 :: (~>) a ((~>) b a) - data Foo7Sym0 :: (~>) a ((~>) b a) - where - Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0 a0123456789876543210 - type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ()) - type Foo7Sym1 :: a -> (~>) b a - data Foo7Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Foo7Sym1KindInference :: SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => - Foo7Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Foo7Sym1KindInference ()) - type Foo7Sym2 :: a -> b -> a - type family Foo7Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Foo7Sym2 a0123456789876543210 a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 - type Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a)) - data Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a)) - where - Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => - Foo6Sym0 a0123456789876543210 - type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 - instance SuppressUnusedWarnings Foo6Sym0 where - suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ()) - type Foo6Sym1 :: Maybe (Maybe a) -> Maybe (Maybe a) - type family Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a)) :: Maybe (Maybe a) where - Foo6Sym1 a0123456789876543210 = Foo6 a0123456789876543210 - type Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a)) - data Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a)) - where - Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => - Foo5Sym0 a0123456789876543210 - type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 - instance SuppressUnusedWarnings Foo5Sym0 where - suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ()) - type Foo5Sym1 :: Maybe (Maybe a) -> Maybe (Maybe a) - type family Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a)) :: Maybe (Maybe a) where - Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210 - type Foo4Sym0 :: (~>) (a, b) (b, a) - data Foo4Sym0 :: (~>) (a, b) (b, a) - where - Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => - Foo4Sym0 a0123456789876543210 - type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 - instance SuppressUnusedWarnings Foo4Sym0 where - suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ()) - type Foo4Sym1 :: (a, b) -> (b, a) - type family Foo4Sym1 (a0123456789876543210 :: (a, b)) :: (b, - a) where - Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210 - type Foo3Sym0 :: forall a. (~>) (Maybe a) a - data Foo3Sym0 :: (~>) (Maybe a) a - where - Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => - Foo3Sym0 a0123456789876543210 - type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 - instance SuppressUnusedWarnings Foo3Sym0 where - suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ()) - type Foo3Sym1 :: forall a. Maybe a -> a - type family Foo3Sym1 (a0123456789876543210 :: Maybe a) :: a where - Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210 - type Foo2Sym0 :: forall a. (~>) (Maybe a) a - data Foo2Sym0 :: (~>) (Maybe a) a - where - Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => - Foo2Sym0 a0123456789876543210 - type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ()) - type Foo2Sym1 :: forall a. Maybe a -> a - type family Foo2Sym1 (a0123456789876543210 :: Maybe a) :: a where - Foo2Sym1 a0123456789876543210 = Foo2 a0123456789876543210 - type Foo1Sym0 :: (~>) (Maybe a) a - data Foo1Sym0 :: (~>) (Maybe a) a - where - Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => - Foo1Sym0 a0123456789876543210 - type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ()) - type Foo1Sym1 :: Maybe a -> a - type family Foo1Sym1 (a0123456789876543210 :: Maybe a) :: a where - Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210 - data GSym0 a0123456789876543210 - where - GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0 a0123456789876543210 - type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings = snd ((,) GSym0KindInference ()) - type family GSym1 a0123456789876543210 where - GSym1 a0123456789876543210 = G a0123456789876543210 - data F3Sym0 a0123456789876543210 - where - F3Sym0KindInference :: SameKind (Apply F3Sym0 arg) (F3Sym1 arg) => - F3Sym0 a0123456789876543210 - type instance Apply F3Sym0 a0123456789876543210 = F3 a0123456789876543210 - instance SuppressUnusedWarnings F3Sym0 where - suppressUnusedWarnings = snd ((,) F3Sym0KindInference ()) - type family F3Sym1 a0123456789876543210 where - F3Sym1 a0123456789876543210 = F3 a0123456789876543210 - data F2Sym0 a0123456789876543210 - where - F2Sym0KindInference :: SameKind (Apply F2Sym0 arg) (F2Sym1 arg) => - F2Sym0 a0123456789876543210 - type instance Apply F2Sym0 a0123456789876543210 = F2 a0123456789876543210 - instance SuppressUnusedWarnings F2Sym0 where - suppressUnusedWarnings = snd ((,) F2Sym0KindInference ()) - type family F2Sym1 a0123456789876543210 where - F2Sym1 a0123456789876543210 = F2 a0123456789876543210 - data F1Sym0 a0123456789876543210 - where - F1Sym0KindInference :: SameKind (Apply F1Sym0 arg) (F1Sym1 arg) => - F1Sym0 a0123456789876543210 - type instance Apply F1Sym0 a0123456789876543210 = F1 a0123456789876543210 - instance SuppressUnusedWarnings F1Sym0 where - suppressUnusedWarnings = snd ((,) F1Sym0KindInference ()) - type family F1Sym1 a0123456789876543210 where - F1Sym1 a0123456789876543210 = F1 a0123456789876543210 - type Foo9 :: a -> a - type family Foo9 (a :: a) :: a where - Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym1 x) x) Tuple0Sym0 - type Foo8 :: forall a. Maybe a -> Maybe a - type family Foo8 (a :: Maybe a) :: Maybe a where - Foo8 ('Just (wild_0123456789876543210 :: a) :: Maybe a) = Let0123456789876543210XSym1 wild_0123456789876543210 - Foo8 ('Nothing :: Maybe a) = Let0123456789876543210XSym0 - type Foo7 :: a -> b -> a - type family Foo7 (a :: a) (a :: b) :: a where - Foo7 (x :: a) (wild_0123456789876543210 :: b) = x :: a - type Foo6 :: Maybe (Maybe a) -> Maybe (Maybe 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 Foo5 :: Maybe (Maybe a) -> Maybe (Maybe a) - 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 Foo4 :: (a, b) -> (b, a) - type family Foo4 (a :: (a, b)) :: (b, a) where - Foo4 a_0123456789876543210 = Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210 - type Foo3 :: forall a. Maybe a -> a - type family Foo3 (a :: Maybe a) :: a where - Foo3 ('Just x) = x :: a - type Foo2 :: forall a. Maybe a -> a - type family Foo2 (a :: Maybe a) :: a where - Foo2 ('Just x :: Maybe a) = x :: a - type Foo1 :: Maybe a -> 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 (t :: a). Sing t -> Sing (Apply Foo9Sym0 t :: a) :: Type) - sFoo8 :: - forall a (t :: Maybe a). Sing t - -> Sing (Apply Foo8Sym0 t :: Maybe a) - sFoo7 :: - (forall (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: a) :: Type) - sFoo6 :: - (forall (t :: Maybe (Maybe a)). - Sing t -> Sing (Apply Foo6Sym0 t :: Maybe (Maybe a)) :: Type) - sFoo5 :: - (forall (t :: Maybe (Maybe a)). - Sing t -> Sing (Apply Foo5Sym0 t :: Maybe (Maybe a)) :: Type) - sFoo4 :: - (forall (t :: (a, b)). - Sing t -> Sing (Apply Foo4Sym0 t :: (b, a)) :: Type) - 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 (t :: Maybe a). - Sing t -> Sing (Apply Foo1Sym0 t :: a) :: Type) - 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 (t :: a) (t :: b). - Sing t - -> Sing t - -> Sing (Apply (Apply (Let0123456789876543210GSym1 x) t) t :: a) :: Type) - 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 - sFoo8 SNothing - = case SNothing of - (_ :: Sing ('Nothing :: Maybe a)) - -> let - sX :: Sing @_ Let0123456789876543210XSym0 - sX = SNothing :: Sing (NothingSym0 :: 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 - id - @(Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x))) - (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))) - 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 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))))) - 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 - id - @(Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x))) - (case sScrutinee_0123456789876543210 of - SJust (sY :: Sing y) - -> case SJust (sY :: Sing y) of - (_ :: Sing ('Just y :: Maybe Bool)) -> sY :: Sing (y :: Bool)) - 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 SingI1 (Foo7Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Foo7Sym1 (d :: a)) (sFoo7 s) - 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 +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+ foo8 x@(Nothing :: 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+ foo8 x@(Nothing :: Maybe a) = x+ foo9 :: a -> a+ foo9 (x :: a)+ = let+ g :: a -> b -> a+ g y _ = y+ in g x ()+ data Let0123456789876543210GSym0 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210)+ where+ Let0123456789876543210GSym0KindInference :: SameKind (Apply (Let0123456789876543210GSym0 a0123456789876543210 x0123456789876543210) arg) (Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 arg) =>+ Let0123456789876543210GSym0 a0123456789876543210 x0123456789876543210 a0123456789876543210+ type instance Apply @a0123456789876543210 @((~>) b0123456789876543210 a0123456789876543210) (Let0123456789876543210GSym0 a0123456789876543210 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210GSym0 a0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210GSym0KindInference ())+ data Let0123456789876543210GSym1 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) :: (~>) b0123456789876543210 a0123456789876543210+ where+ Let0123456789876543210GSym1KindInference :: SameKind (Apply (Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210 a0123456789876543210 arg) =>+ Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @b0123456789876543210 @a0123456789876543210 (Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210G a0123456789876543210 x0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210GSym1 a0123456789876543210 x0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210GSym1KindInference ())+ type family Let0123456789876543210GSym2 a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210 a0123456789876543210 a0123456789876543210 = Let0123456789876543210G a0123456789876543210 x0123456789876543210 a0123456789876543210 a0123456789876543210+ type family Let0123456789876543210G a0123456789876543210 (x0123456789876543210 :: a0123456789876543210) (a :: a0123456789876543210) (a :: b) :: a0123456789876543210 where+ Let0123456789876543210G a x y _ = y+ type family Let0123456789876543210XSym0 a0123456789876543210 (wild_01234567898765432100123456789876543210 :: a0123456789876543210) where+ Let0123456789876543210XSym0 a0123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210X a0123456789876543210 wild_01234567898765432100123456789876543210+ type family Let0123456789876543210X a0123456789876543210 (wild_01234567898765432100123456789876543210 :: a0123456789876543210) where+ Let0123456789876543210X a wild_0123456789876543210 = Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a+ type family Let0123456789876543210XSym0 a0123456789876543210 where+ Let0123456789876543210XSym0 a0123456789876543210 = Let0123456789876543210X a0123456789876543210+ type family Let0123456789876543210X a0123456789876543210 where+ Let0123456789876543210X a = NothingSym0 :: Maybe a+ type family LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 a x ('Just (y :: a) :: Maybe a) = Apply JustSym0 (Apply JustSym0 (y :: a) :: Maybe a)+ data LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: (a0123456789876543210,+ b0123456789876543210)) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 '(x :: a,+ y :: b) = Apply (Apply Tuple2Sym0 (y :: b)) (x :: a)+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: (a0123456789876543210,+ b0123456789876543210)) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: (a0123456789876543210,+ b0123456789876543210)) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 x ('Just y :: Maybe Bool) = y :: Bool+ data LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210+ type Foo9Sym0 :: (~>) a a+ data Foo9Sym0 :: (~>) a a+ where+ Foo9Sym0KindInference :: SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) =>+ Foo9Sym0 a0123456789876543210+ type instance Apply @a @a Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210+ instance SuppressUnusedWarnings Foo9Sym0 where+ suppressUnusedWarnings = snd ((,) Foo9Sym0KindInference ())+ type Foo9Sym1 :: a -> a+ type family Foo9Sym1 @a (a0123456789876543210 :: a) :: a where+ Foo9Sym1 a0123456789876543210 = Foo9 a0123456789876543210+ type Foo8Sym0 :: forall a. (~>) (Maybe a) (Maybe a)+ data Foo8Sym0 :: (~>) (Maybe a) (Maybe a)+ where+ Foo8Sym0KindInference :: SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>+ Foo8Sym0 a0123456789876543210+ type instance Apply @(Maybe a) @(Maybe a) Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210+ instance SuppressUnusedWarnings Foo8Sym0 where+ suppressUnusedWarnings = snd ((,) Foo8Sym0KindInference ())+ type Foo8Sym1 :: forall a. Maybe a -> Maybe a+ type family Foo8Sym1 @a (a0123456789876543210 :: Maybe a) :: Maybe a where+ Foo8Sym1 a0123456789876543210 = Foo8 a0123456789876543210+ type Foo7Sym0 :: (~>) a ((~>) b a)+ data Foo7Sym0 :: (~>) a ((~>) b a)+ where+ Foo7Sym0KindInference :: SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>+ Foo7Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Foo7Sym0 where+ suppressUnusedWarnings = snd ((,) Foo7Sym0KindInference ())+ type Foo7Sym1 :: a -> (~>) b a+ data Foo7Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Foo7Sym1KindInference :: SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) =>+ Foo7Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Foo7Sym1KindInference ())+ type Foo7Sym2 :: a -> b -> a+ type family Foo7Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Foo7Sym2 a0123456789876543210 a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210+ type Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))+ data Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))+ where+ Foo6Sym0KindInference :: SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>+ Foo6Sym0 a0123456789876543210+ type instance Apply @(Maybe (Maybe a)) @(Maybe (Maybe a)) Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210+ instance SuppressUnusedWarnings Foo6Sym0 where+ suppressUnusedWarnings = snd ((,) Foo6Sym0KindInference ())+ type Foo6Sym1 :: Maybe (Maybe a) -> Maybe (Maybe a)+ type family Foo6Sym1 @a (a0123456789876543210 :: Maybe (Maybe a)) :: Maybe (Maybe a) where+ Foo6Sym1 a0123456789876543210 = Foo6 a0123456789876543210+ type Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))+ data Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))+ where+ Foo5Sym0KindInference :: SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>+ Foo5Sym0 a0123456789876543210+ type instance Apply @(Maybe (Maybe a)) @(Maybe (Maybe a)) Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210+ instance SuppressUnusedWarnings Foo5Sym0 where+ suppressUnusedWarnings = snd ((,) Foo5Sym0KindInference ())+ type Foo5Sym1 :: Maybe (Maybe a) -> Maybe (Maybe a)+ type family Foo5Sym1 @a (a0123456789876543210 :: Maybe (Maybe a)) :: Maybe (Maybe a) where+ Foo5Sym1 a0123456789876543210 = Foo5 a0123456789876543210+ type Foo4Sym0 :: (~>) (a, b) (b, a)+ data Foo4Sym0 :: (~>) (a, b) (b, a)+ where+ Foo4Sym0KindInference :: SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>+ Foo4Sym0 a0123456789876543210+ type instance Apply @(a, b) @(b,+ a) Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210+ instance SuppressUnusedWarnings Foo4Sym0 where+ suppressUnusedWarnings = snd ((,) Foo4Sym0KindInference ())+ type Foo4Sym1 :: (a, b) -> (b, a)+ type family Foo4Sym1 @a @b (a0123456789876543210 :: (a, b)) :: (b,+ a) where+ Foo4Sym1 a0123456789876543210 = Foo4 a0123456789876543210+ type Foo3Sym0 :: forall a. (~>) (Maybe a) a+ data Foo3Sym0 :: (~>) (Maybe a) a+ where+ Foo3Sym0KindInference :: SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>+ Foo3Sym0 a0123456789876543210+ type instance Apply @(Maybe a) @a Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210+ instance SuppressUnusedWarnings Foo3Sym0 where+ suppressUnusedWarnings = snd ((,) Foo3Sym0KindInference ())+ type Foo3Sym1 :: forall a. Maybe a -> a+ type family Foo3Sym1 @a (a0123456789876543210 :: Maybe a) :: a where+ Foo3Sym1 a0123456789876543210 = Foo3 a0123456789876543210+ type Foo2Sym0 :: forall a. (~>) (Maybe a) a+ data Foo2Sym0 :: (~>) (Maybe a) a+ where+ Foo2Sym0KindInference :: SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>+ Foo2Sym0 a0123456789876543210+ type instance Apply @(Maybe a) @a Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210+ instance SuppressUnusedWarnings Foo2Sym0 where+ suppressUnusedWarnings = snd ((,) Foo2Sym0KindInference ())+ type Foo2Sym1 :: forall a. Maybe a -> a+ type family Foo2Sym1 @a (a0123456789876543210 :: Maybe a) :: a where+ Foo2Sym1 a0123456789876543210 = Foo2 a0123456789876543210+ type Foo1Sym0 :: (~>) (Maybe a) a+ data Foo1Sym0 :: (~>) (Maybe a) a+ where+ Foo1Sym0KindInference :: SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>+ Foo1Sym0 a0123456789876543210+ type instance Apply @(Maybe a) @a Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210+ instance SuppressUnusedWarnings Foo1Sym0 where+ suppressUnusedWarnings = snd ((,) Foo1Sym0KindInference ())+ type Foo1Sym1 :: Maybe a -> a+ type family Foo1Sym1 @a (a0123456789876543210 :: Maybe a) :: a where+ Foo1Sym1 a0123456789876543210 = Foo1 a0123456789876543210+ data GSym0 a0123456789876543210+ where+ GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) =>+ GSym0 a0123456789876543210+ type instance Apply @_ @_ GSym0 a0123456789876543210 = G a0123456789876543210+ instance SuppressUnusedWarnings GSym0 where+ suppressUnusedWarnings = snd ((,) GSym0KindInference ())+ type family GSym1 a0123456789876543210 where+ GSym1 a0123456789876543210 = G a0123456789876543210+ data F3Sym0 a0123456789876543210+ where+ F3Sym0KindInference :: SameKind (Apply F3Sym0 arg) (F3Sym1 arg) =>+ F3Sym0 a0123456789876543210+ type instance Apply @_ @_ F3Sym0 a0123456789876543210 = F3 a0123456789876543210+ instance SuppressUnusedWarnings F3Sym0 where+ suppressUnusedWarnings = snd ((,) F3Sym0KindInference ())+ type family F3Sym1 a0123456789876543210 where+ F3Sym1 a0123456789876543210 = F3 a0123456789876543210+ data F2Sym0 a0123456789876543210+ where+ F2Sym0KindInference :: SameKind (Apply F2Sym0 arg) (F2Sym1 arg) =>+ F2Sym0 a0123456789876543210+ type instance Apply @_ @_ F2Sym0 a0123456789876543210 = F2 a0123456789876543210+ instance SuppressUnusedWarnings F2Sym0 where+ suppressUnusedWarnings = snd ((,) F2Sym0KindInference ())+ type family F2Sym1 a0123456789876543210 where+ F2Sym1 a0123456789876543210 = F2 a0123456789876543210+ data F1Sym0 a0123456789876543210+ where+ F1Sym0KindInference :: SameKind (Apply F1Sym0 arg) (F1Sym1 arg) =>+ F1Sym0 a0123456789876543210+ type instance Apply @_ @_ F1Sym0 a0123456789876543210 = F1 a0123456789876543210+ instance SuppressUnusedWarnings F1Sym0 where+ suppressUnusedWarnings = snd ((,) F1Sym0KindInference ())+ type family F1Sym1 a0123456789876543210 where+ F1Sym1 a0123456789876543210 = F1 a0123456789876543210+ type Foo9 :: a -> a+ type family Foo9 @a (a :: a) :: a where+ Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym0 a x) x) Tuple0Sym0+ type Foo8 :: forall a. Maybe a -> Maybe a+ type family Foo8 @a (a :: Maybe a) :: Maybe a where+ Foo8 @a ('Just (wild_0123456789876543210 :: a) :: Maybe a :: Maybe a) = Let0123456789876543210XSym0 a wild_0123456789876543210+ Foo8 @a ('Nothing :: Maybe a :: Maybe a) = Let0123456789876543210XSym0 a+ type Foo7 :: a -> b -> a+ type family Foo7 @a @b (a :: a) (a :: b) :: a where+ Foo7 (x :: a) (wild_0123456789876543210 :: b) = x :: a+ type Foo6 :: Maybe (Maybe a) -> Maybe (Maybe a)+ type family Foo6 @a (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where+ Foo6 ('Just x :: Maybe (Maybe a)) = Apply (LamCases_0123456789876543210Sym0 a x) (x :: Maybe a)+ type Foo5 :: Maybe (Maybe a) -> Maybe (Maybe a)+ type family Foo5 @a (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 Foo4 :: (a, b) -> (b, a)+ type family Foo4 @a @b (a :: (a, b)) :: (b, a) where+ Foo4 a_0123456789876543210 = Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210+ type Foo3 :: forall a. Maybe a -> a+ type family Foo3 @a (a :: Maybe a) :: a where+ Foo3 @a ('Just x :: Maybe a) = x :: a+ type Foo2 :: forall a. Maybe a -> a+ type family Foo2 @a (a :: Maybe a) :: a where+ Foo2 @a ('Just x :: Maybe a :: Maybe a) = x :: a+ type Foo1 :: Maybe a -> a+ type family Foo1 @a (a :: Maybe a) :: a where+ Foo1 ('Just x :: Maybe a) = x :: a+ type family G a where+ G x = Apply (LamCases_0123456789876543210Sym0 x) (Apply JustSym0 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 (t :: a). Sing t -> Sing (Foo9 t :: a) :: Type)+ sFoo8 ::+ forall a (t :: Maybe a). Sing t -> Sing (Foo8 t :: Maybe a)+ sFoo7 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Foo7 t t :: a) :: Type)+ sFoo6 ::+ (forall (t :: Maybe (Maybe a)).+ Sing t -> Sing (Foo6 t :: Maybe (Maybe a)) :: Type)+ sFoo5 ::+ (forall (t :: Maybe (Maybe a)).+ Sing t -> Sing (Foo5 t :: Maybe (Maybe a)) :: Type)+ sFoo4 ::+ (forall (t :: (a, b)). Sing t -> Sing (Foo4 t :: (b, a)) :: Type)+ sFoo3 :: forall a (t :: Maybe a). Sing t -> Sing (Foo3 t :: a)+ sFoo2 :: forall a (t :: Maybe a). Sing t -> Sing (Foo2 t :: a)+ sFoo1 ::+ (forall (t :: Maybe a). Sing t -> Sing (Foo1 t :: a) :: Type)+ sG :: forall arg. Sing arg -> Sing (G arg)+ sF3 :: forall arg. Sing arg -> Sing (F3 arg)+ sF2 :: forall arg. Sing arg -> Sing (F2 arg)+ sF1 :: forall arg. Sing arg -> Sing (F1 arg)+ sFoo9 (sX :: Sing x)+ = (\cases+ (_ :: Sing (x :: a))+ -> let+ sG ::+ (forall (t :: a) (t :: b).+ Sing t+ -> Sing t -> Sing (Let0123456789876543210G a x t t :: a) :: Type)+ sG (sY :: Sing y) _ = sY+ in+ applySing+ (applySing (singFun2 @(Let0123456789876543210GSym0 a x) sG) sX)+ STuple0)+ (sX :: Sing x)+ sFoo8+ (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210))+ = (\cases+ (_ :: Sing (wild_0123456789876543210 :: a))+ (_ :: Sing ('Just (wild_0123456789876543210 :: a) :: Maybe a))+ -> let+ sX :: Sing @_ (Let0123456789876543210X a wild_0123456789876543210)+ sX+ = applySing+ (singFun1 @JustSym0 SJust)+ (sWild_0123456789876543210 ::+ Sing (wild_0123456789876543210 :: a)) ::+ Sing (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a)+ in sX)+ (sWild_0123456789876543210 :: Sing wild_0123456789876543210)+ (SJust+ (sWild_0123456789876543210 :: Sing wild_0123456789876543210))+ sFoo8 SNothing+ = (\cases+ (_ :: Sing ('Nothing :: Maybe a))+ -> let+ sX :: Sing @_ (Let0123456789876543210X a)+ sX = SNothing :: Sing (NothingSym0 :: Maybe a)+ in sX)+ SNothing+ sFoo7+ (sX :: Sing x)+ (sWild_0123456789876543210 :: Sing wild_0123456789876543210)+ = (\cases+ (_ :: Sing (x :: a)) (_ :: Sing (wild_0123456789876543210 :: b))+ -> sX :: Sing (x :: a))+ (sX :: Sing x)+ (sWild_0123456789876543210 :: Sing wild_0123456789876543210)+ sFoo6 (SJust (sX :: Sing x))+ = (\cases+ (_ :: Sing ('Just x :: Maybe (Maybe a)))+ -> applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a x)+ (\cases+ (SJust (sY :: Sing y))+ -> (\cases+ (_ :: 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)))+ (sY :: Sing y) (SJust (sY :: Sing y))))+ (sX :: Sing (x :: Maybe a)))+ (SJust (sX :: Sing x))+ sFoo5 (SJust (SJust (sX :: Sing x)))+ = (\cases+ (_ :: 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)))+ (sX :: Sing x) (SJust (sX :: Sing x))+ (SJust (SJust (sX :: Sing x)))+ sFoo4 (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210)+ (\cases+ (STuple2 (sX :: Sing x) (sY :: Sing y))+ -> (\cases+ (_ :: Sing (x :: a)) (_ :: Sing (y :: b))+ -> applySing+ (applySing (singFun2 @Tuple2Sym0 STuple2) (sY :: Sing (y :: b)))+ (sX :: Sing (x :: a)))+ (sX :: Sing x) (sY :: Sing y)))+ sA_0123456789876543210+ sFoo3 (SJust (sX :: Sing x)) = sX :: Sing (x :: a)+ sFoo2 (SJust (sX :: Sing x))+ = (\cases (_ :: Sing ('Just x :: Maybe a)) -> sX :: Sing (x :: a))+ (SJust (sX :: Sing x))+ sFoo1 (SJust (sX :: Sing x))+ = (\cases (_ :: Sing ('Just x :: Maybe a)) -> sX :: Sing (x :: a))+ (SJust (sX :: Sing x))+ sG (sX :: Sing x)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 x)+ (\cases+ (SJust (sY :: Sing y))+ -> (\cases+ (_ :: Sing ('Just y :: Maybe Bool)) -> sY :: Sing (y :: Bool))+ (SJust (sY :: Sing y))))+ (applySing (singFun1 @JustSym0 SJust) sX)+ sF3 (SJust (sA :: Sing a))+ = (\cases (_ :: Sing ('Just a :: Maybe Bool)) -> sing :: Sing "hi")+ (SJust (sA :: Sing a))+ sF2 (sX :: Sing x)+ = (\cases (_ :: Sing (x :: Maybe a)) -> sX :: Sing (x :: Maybe a))+ (sX :: Sing x)+ sF1 (sX :: Sing x)+ = (\cases+ (_ :: Sing (x :: Maybe Bool)) -> sX :: Sing (x :: Maybe Bool))+ (sX :: Sing x)+ 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 SingI1 (Foo7Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Foo7Sym1 (d :: a)) (sFoo7 s)+ 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 view
@@ -1,65 +1,65 @@-module T183 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(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 - - ----- - -- Type variable scoping (vis-à-vis #297) - ----- - - foo9 :: a -> a - foo9 (x :: a) - = let g :: a -> b -> a - g y _ = y - in g x () - |]) +module T183 where++import Data.Singletons.TH+import Prelude.Singletons++$(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++ -----+ -- 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.golden view
@@ -1,476 +1,321 @@-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 x where - Lambda_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 xs0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 xs0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym2 xs0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 x0123456789876543210 - type family Lambda_0123456789876543210 x xs ys y where - Lambda_0123456789876543210 x xs ys y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) - data Lambda_0123456789876543210Sym0 x0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) xs0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - type family Lambda_0123456789876543210 xs ys x where - Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) xs) ys) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - type family Lambda_0123456789876543210 xs ys x where - Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - type family Lambda_0123456789876543210 xs ys y where - Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 y0123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 xs ys t where - Case_0123456789876543210 arg_0123456789876543210 xs ys '(x, - y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) - type family Lambda_0123456789876543210 xs ys arg_0123456789876543210 where - Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 xs ys arg_0123456789876543210 - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 xs0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 a ma mb b where - Lambda_0123456789876543210 a ma mb b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) - data Lambda_0123456789876543210Sym0 a0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) ma0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - data Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym3KindInference ()) - type family Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 where - Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 b0123456789876543210 - type family Lambda_0123456789876543210 ma mb a where - Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) ma) mb) - data Lambda_0123456789876543210Sym0 ma0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 ma0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 ma0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 where - Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 = Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 - type TruesSym0 :: (~>) [Bool] [Bool] - data TruesSym0 :: (~>) [Bool] [Bool] - where - TruesSym0KindInference :: SameKind (Apply TruesSym0 arg) (TruesSym1 arg) => - TruesSym0 a0123456789876543210 - type instance Apply TruesSym0 a0123456789876543210 = Trues a0123456789876543210 - instance SuppressUnusedWarnings TruesSym0 where - suppressUnusedWarnings = snd ((,) TruesSym0KindInference ()) - type TruesSym1 :: [Bool] -> [Bool] - type family TruesSym1 (a0123456789876543210 :: [Bool]) :: [Bool] where - TruesSym1 a0123456789876543210 = Trues a0123456789876543210 - type CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)]) - data CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)]) - where - CartProdSym0KindInference :: SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) => - CartProdSym0 a0123456789876543210 - type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210 - instance SuppressUnusedWarnings CartProdSym0 where - suppressUnusedWarnings = snd ((,) CartProdSym0KindInference ()) - type CartProdSym1 :: [a] -> (~>) [b] [(a, b)] - data CartProdSym1 (a0123456789876543210 :: [a]) :: (~>) [b] [(a, - b)] - where - CartProdSym1KindInference :: SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) => - CartProdSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) CartProdSym1KindInference ()) - type CartProdSym2 :: [a] -> [b] -> [(a, b)] - type family CartProdSym2 (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [(a, - b)] where - CartProdSym2 a0123456789876543210 a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210 - type Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)]) - data Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)]) - where - Zip'Sym0KindInference :: SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) => - Zip'Sym0 a0123456789876543210 - type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Zip'Sym0 where - suppressUnusedWarnings = snd ((,) Zip'Sym0KindInference ()) - type Zip'Sym1 :: [a] -> (~>) [b] [(a, b)] - data Zip'Sym1 (a0123456789876543210 :: [a]) :: (~>) [b] [(a, b)] - where - Zip'Sym1KindInference :: 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'Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) Zip'Sym1KindInference ()) - type Zip'Sym2 :: [a] -> [b] -> [(a, b)] - type family Zip'Sym2 (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [(a, - b)] where - Zip'Sym2 a0123456789876543210 a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210 - type BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a)) - data BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a)) - where - BoogieSym0KindInference :: SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) => - BoogieSym0 a0123456789876543210 - type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210 - instance SuppressUnusedWarnings BoogieSym0 where - suppressUnusedWarnings = snd ((,) BoogieSym0KindInference ()) - type BoogieSym1 :: Maybe a -> (~>) (Maybe Bool) (Maybe a) - data BoogieSym1 (a0123456789876543210 :: Maybe a) :: (~>) (Maybe Bool) (Maybe a) - where - BoogieSym1KindInference :: SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) => - BoogieSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BoogieSym1 a0123456789876543210) a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BoogieSym1KindInference ()) - type BoogieSym2 :: Maybe a -> Maybe Bool -> Maybe a - type family BoogieSym2 (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: Maybe Bool) :: Maybe a where - BoogieSym2 a0123456789876543210 a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210 - type Trues :: [Bool] -> [Bool] - type family Trues (a :: [Bool]) :: [Bool] where - Trues xs = Apply (Apply (>>=@#@$) xs) (Apply Lambda_0123456789876543210Sym0 xs) - type CartProd :: [a] -> [b] -> [(a, b)] - type family CartProd (a :: [a]) (a :: [b]) :: [(a, b)] where - CartProd xs ys = Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) - type Zip' :: [a] -> [b] -> [(a, b)] - 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 Boogie :: Maybe a -> Maybe Bool -> Maybe a - 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]) :: Type) - sCartProd :: - (forall (t :: [a]) (t :: [b]). - Sing t - -> Sing t - -> Sing (Apply (Apply CartProdSym0 t) t :: [(a, b)]) :: Type) - sZip' :: - (forall (t :: [a]) (t :: [b]). - Sing t - -> Sing t -> Sing (Apply (Apply Zip'Sym0 t) t :: [(a, b)]) :: Type) - sBoogie :: - (forall (t :: Maybe a) (t :: Maybe Bool). - Sing t - -> Sing t - -> Sing (Apply (Apply BoogieSym0 t) t :: Maybe a) :: Type) - 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 x) xs) ys) - (\ 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) - -> id - @(Sing (Case_0123456789876543210 arg_0123456789876543210 xs ys arg_0123456789876543210)) - (case sArg_0123456789876543210 of - STuple2 (sX :: Sing x) (sY :: Sing y) - -> applySing - (singFun1 @ReturnSym0 sReturn) - (applySing - (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY)))) - 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 a) ma) mb) - (\ 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 SingI1 (CartProdSym1 :: [a] -> (~>) [b] [(a, b)]) where - liftSing (s :: Sing (d :: [a])) - = singFun1 @(CartProdSym1 (d :: [a])) (sCartProd s) - 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 SingI1 (Zip'Sym1 :: [a] -> (~>) [b] [(a, b)]) where - liftSing (s :: Sing (d :: [a])) - = singFun1 @(Zip'Sym1 (d :: [a])) (sZip' s) - 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)) - instance SingI1 (BoogieSym1 :: Maybe a - -> (~>) (Maybe Bool) (Maybe a)) where - liftSing (s :: Sing (d :: Maybe a)) - = singFun1 @(BoogieSym1 (d :: Maybe a)) (sBoogie s) +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 LamCases_0123456789876543210 (xs0123456789876543210 :: [Bool]) a_0123456789876543210 where+ LamCases_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x)+ data LamCases_0123456789876543210Sym0 (xs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 xs0123456789876543210) arg) (LamCases_0123456789876543210Sym1 xs0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 xs0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 xs0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 xs0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (xs0123456789876543210 :: [Bool]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 xs0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 x0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_0123456789876543210 where+ LamCases_0123456789876543210 x xs ys y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y)+ data LamCases_0123456789876543210Sym0 x0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) arg) (LamCases_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 x0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_0123456789876543210 where+ LamCases_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (LamCases_0123456789876543210Sym0 x xs ys)+ data LamCases_0123456789876543210Sym0 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) arg) (LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_0123456789876543210 where+ LamCases_0123456789876543210 xs ys x = Apply ReturnSym0 x+ data LamCases_0123456789876543210Sym0 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) arg) (LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_0123456789876543210 where+ LamCases_0123456789876543210 xs ys y = Apply ReturnSym0 y+ data LamCases_0123456789876543210Sym0 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) arg) (LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_0123456789876543210 where+ LamCases_0123456789876543210 xs ys '(x,+ y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y)+ data LamCases_0123456789876543210Sym0 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) arg) (LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 xs0123456789876543210 ys0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (xs0123456789876543210 :: [a0123456789876543210]) (ys0123456789876543210 :: [b0123456789876543210]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 xs0123456789876543210 ys0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a0123456789876543210 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 a ma mb b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a)+ data LamCases_0123456789876543210Sym0 a0123456789876543210 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (LamCases_0123456789876543210Sym0 a ma mb)+ data LamCases_0123456789876543210Sym0 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 ma0123456789876543210 mb0123456789876543210) arg) (LamCases_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 ma0123456789876543210 mb0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 ma0123456789876543210 mb0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (ma0123456789876543210 :: Maybe a0123456789876543210) (mb0123456789876543210 :: Maybe Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a_01234567898765432100123456789876543210+ type TruesSym0 :: (~>) [Bool] [Bool]+ data TruesSym0 :: (~>) [Bool] [Bool]+ where+ TruesSym0KindInference :: SameKind (Apply TruesSym0 arg) (TruesSym1 arg) =>+ TruesSym0 a0123456789876543210+ type instance Apply @[Bool] @[Bool] TruesSym0 a0123456789876543210 = Trues a0123456789876543210+ instance SuppressUnusedWarnings TruesSym0 where+ suppressUnusedWarnings = snd ((,) TruesSym0KindInference ())+ type TruesSym1 :: [Bool] -> [Bool]+ type family TruesSym1 (a0123456789876543210 :: [Bool]) :: [Bool] where+ TruesSym1 a0123456789876543210 = Trues a0123456789876543210+ type CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)])+ data CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)])+ where+ CartProdSym0KindInference :: SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) =>+ CartProdSym0 a0123456789876543210+ type instance Apply @[a] @((~>) [b] [(a,+ b)]) CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210+ instance SuppressUnusedWarnings CartProdSym0 where+ suppressUnusedWarnings = snd ((,) CartProdSym0KindInference ())+ type CartProdSym1 :: [a] -> (~>) [b] [(a, b)]+ data CartProdSym1 (a0123456789876543210 :: [a]) :: (~>) [b] [(a,+ b)]+ where+ CartProdSym1KindInference :: SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) =>+ CartProdSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[b] @[(a,+ b)] (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) CartProdSym1KindInference ())+ type CartProdSym2 :: [a] -> [b] -> [(a, b)]+ type family CartProdSym2 @a @b (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [(a,+ b)] where+ CartProdSym2 a0123456789876543210 a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210+ type Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)])+ data Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)])+ where+ Zip'Sym0KindInference :: SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) =>+ Zip'Sym0 a0123456789876543210+ type instance Apply @[a] @((~>) [b] [(a,+ b)]) Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Zip'Sym0 where+ suppressUnusedWarnings = snd ((,) Zip'Sym0KindInference ())+ type Zip'Sym1 :: [a] -> (~>) [b] [(a, b)]+ data Zip'Sym1 (a0123456789876543210 :: [a]) :: (~>) [b] [(a, b)]+ where+ Zip'Sym1KindInference :: SameKind (Apply (Zip'Sym1 a0123456789876543210) arg) (Zip'Sym2 a0123456789876543210 arg) =>+ Zip'Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[b] @[(a,+ b)] (Zip'Sym1 a0123456789876543210) a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Zip'Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Zip'Sym1KindInference ())+ type Zip'Sym2 :: [a] -> [b] -> [(a, b)]+ type family Zip'Sym2 @a @b (a0123456789876543210 :: [a]) (a0123456789876543210 :: [b]) :: [(a,+ b)] where+ Zip'Sym2 a0123456789876543210 a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210+ type BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a))+ data BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a))+ where+ BoogieSym0KindInference :: SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) =>+ BoogieSym0 a0123456789876543210+ type instance Apply @(Maybe a) @((~>) (Maybe Bool) (Maybe a)) BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210+ instance SuppressUnusedWarnings BoogieSym0 where+ suppressUnusedWarnings = snd ((,) BoogieSym0KindInference ())+ type BoogieSym1 :: Maybe a -> (~>) (Maybe Bool) (Maybe a)+ data BoogieSym1 (a0123456789876543210 :: Maybe a) :: (~>) (Maybe Bool) (Maybe a)+ where+ BoogieSym1KindInference :: SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) =>+ BoogieSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe Bool) @(Maybe a) (BoogieSym1 a0123456789876543210) a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BoogieSym1KindInference ())+ type BoogieSym2 :: Maybe a -> Maybe Bool -> Maybe a+ type family BoogieSym2 @a (a0123456789876543210 :: Maybe a) (a0123456789876543210 :: Maybe Bool) :: Maybe a where+ BoogieSym2 a0123456789876543210 a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210+ type Trues :: [Bool] -> [Bool]+ type family Trues (a :: [Bool]) :: [Bool] where+ Trues xs = Apply (Apply (>>=@#@$) xs) (LamCases_0123456789876543210Sym0 xs)+ type CartProd :: [a] -> [b] -> [(a, b)]+ type family CartProd @a @b (a :: [a]) (a :: [b]) :: [(a, b)] where+ CartProd xs ys = Apply (Apply (>>=@#@$) xs) (LamCases_0123456789876543210Sym0 xs ys)+ type Zip' :: [a] -> [b] -> [(a, b)]+ type family Zip' @a @b (a :: [a]) (a :: [b]) :: [(a, b)] where+ Zip' xs ys = Apply (Apply (>>=@#@$) (Apply (Apply MzipSym0 (Apply (Apply (>>=@#@$) xs) (LamCases_0123456789876543210Sym0 xs ys))) (Apply (Apply (>>=@#@$) ys) (LamCases_0123456789876543210Sym0 xs ys)))) (LamCases_0123456789876543210Sym0 xs ys)+ type Boogie :: Maybe a -> Maybe Bool -> Maybe a+ type family Boogie @a (a :: Maybe a) (a :: Maybe Bool) :: Maybe a where+ Boogie ma mb = Apply (Apply (>>=@#@$) ma) (LamCases_0123456789876543210Sym0 ma mb)+ sTrues ::+ (forall (t :: [Bool]). Sing t -> Sing (Trues t :: [Bool]) :: Type)+ sCartProd ::+ (forall (t :: [a]) (t :: [b]).+ Sing t -> Sing t -> Sing (CartProd t t :: [(a, b)]) :: Type)+ sZip' ::+ (forall (t :: [a]) (t :: [b]).+ Sing t -> Sing t -> Sing (Zip' t t :: [(a, b)]) :: Type)+ sBoogie ::+ (forall (t :: Maybe a) (t :: Maybe Bool).+ Sing t -> Sing t -> Sing (Boogie t t :: Maybe a) :: Type)+ sTrues (sXs :: Sing xs)+ = applySing+ (applySing (singFun2 @(>>=@#@$) (%>>=)) sXs)+ (singFun1+ @(LamCases_0123456789876543210Sym0 xs)+ (\cases+ (sX :: 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+ @(LamCases_0123456789876543210Sym0 xs ys)+ (\cases+ (sX :: Sing x)+ -> applySing+ (applySing (singFun2 @(>>=@#@$) (%>>=)) sYs)+ (singFun1+ @(LamCases_0123456789876543210Sym0 x xs ys)+ (\cases+ (sY :: 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+ @(LamCases_0123456789876543210Sym0 xs ys)+ (\cases+ (sX :: Sing x) -> applySing (singFun1 @ReturnSym0 sReturn) sX))))+ (applySing+ (applySing (singFun2 @(>>=@#@$) (%>>=)) sYs)+ (singFun1+ @(LamCases_0123456789876543210Sym0 xs ys)+ (\cases+ (sY :: Sing y) -> applySing (singFun1 @ReturnSym0 sReturn) sY)))))+ (singFun1+ @(LamCases_0123456789876543210Sym0 xs ys)+ (\cases+ (STuple2 (sX :: Sing x) (sY :: Sing y))+ -> applySing+ (singFun1 @ReturnSym0 sReturn)+ (applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY)))+ sBoogie (sMa :: Sing ma) (sMb :: Sing mb)+ = applySing+ (applySing (singFun2 @(>>=@#@$) (%>>=)) sMa)+ (singFun1+ @(LamCases_0123456789876543210Sym0 ma mb)+ (\cases+ (sA :: Sing a)+ -> applySing+ (applySing (singFun2 @(>>=@#@$) (%>>=)) sMb)+ (singFun1+ @(LamCases_0123456789876543210Sym0 a ma mb)+ (\cases+ (sB :: 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 SingI1 (CartProdSym1 :: [a] -> (~>) [b] [(a, b)]) where+ liftSing (s :: Sing (d :: [a]))+ = singFun1 @(CartProdSym1 (d :: [a])) (sCartProd s)+ 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 SingI1 (Zip'Sym1 :: [a] -> (~>) [b] [(a, b)]) where+ liftSing (s :: Sing (d :: [a]))+ = singFun1 @(Zip'Sym1 (d :: [a])) (sZip' s)+ 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))+ instance SingI1 (BoogieSym1 :: Maybe a+ -> (~>) (Maybe Bool) (Maybe a)) where+ liftSing (s :: Sing (d :: Maybe a))+ = singFun1 @(BoogieSym1 (d :: Maybe a)) (sBoogie s)
tests/compile-and-dump/Singletons/T184.hs view
@@ -1,27 +1,27 @@-{-# LANGUAGE ParallelListComp #-} - -module T184 where - -import Control.Monad -import Control.Monad.Singletons -import Control.Monad.Zip.Singletons -import Data.Singletons.TH -import Prelude.Singletons - -$(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] - |]) +{-# LANGUAGE ParallelListComp #-}++module T184 where++import Control.Monad+import Control.Monad.Singletons+import Control.Monad.Zip.Singletons+import Data.Singletons.TH+import Prelude.Singletons++$(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.golden view
@@ -1,93 +1,44 @@-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 TFHelper_0123456789876543210 :: Empty -> Empty -> Bool - type family TFHelper_0123456789876543210 (a :: Empty) (a :: Empty) :: Bool where - TFHelper_0123456789876543210 _ _ = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Empty -> (~>) Empty Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Empty -> Empty -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq Empty where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Empty -> Empty -> Ordering - type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where - Compare_0123456789876543210 _ _ = EQSym0 - type Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) - data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Empty - -> (~>) Empty Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Empty -> Empty -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd Empty where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - data SEmpty :: Empty -> Type - type instance Sing @Empty = SEmpty - instance SingKind Empty where - type Demote Empty = Empty - fromSing x = case x of {} - toSing x = SomeSing (case x of {}) - instance SEq Empty where - (%==) :: - forall (t1 :: Empty) (t2 :: Empty). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun Empty ((~>) Empty Bool) - -> Type) t1) t2) - (%==) _ _ = STrue - instance SOrd Empty where - sCompare :: - forall (t1 :: Empty) (t2 :: Empty). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty ((~>) Empty Ordering) - -> Type) t1) t2) - sCompare _ _ = SEQ - instance SDecide Empty where - (%~) x _ = Proved (case x of {}) - instance Data.Type.Equality.TestEquality (SEmpty :: Empty - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (SEmpty :: Empty - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion +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 TFHelper_0123456789876543210 :: Empty -> Empty -> Bool+ type family TFHelper_0123456789876543210 (a :: Empty) (a :: Empty) :: Bool where+ TFHelper_0123456789876543210 _ _ = TrueSym0+ instance PEq Empty where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: Empty -> Empty -> Ordering+ type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where+ Compare_0123456789876543210 _ _ = EQSym0+ instance POrd Empty where+ type Compare a a = Compare_0123456789876543210 a a+ data SEmpty :: Empty -> Type+ type instance Sing @Empty = SEmpty+ instance SingKind Empty where+ type Demote Empty = Empty+ fromSing x = (\case) x+ toSing x = SomeSing ((\case) x)+ instance SEq Empty where+ (%==) _ _ = STrue+ instance SOrd Empty where+ sCompare _ _ = SEQ+ instance SDecide Empty where+ (%~) x _ = Proved ((\case) x)+ instance Eq (SEmpty (z :: Empty)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (SEmpty :: Empty+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (SEmpty :: Empty+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SEmpty (z :: Empty)) where+ compare _ _ = EQ
tests/compile-and-dump/Singletons/T187.hs view
@@ -1,8 +1,8 @@-module T187 where - -import Data.Singletons.Base.TH - -$(singletons[d| data Empty - deriving instance Eq Empty - deriving instance Ord Empty - |]) +module T187 where++import Data.Singletons.Base.TH++$(singletons[d| data Empty+ deriving instance Eq Empty+ deriving instance Ord Empty+ |])
tests/compile-and-dump/Singletons/T190.golden view
@@ -1,233 +1,122 @@-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 TSym0 :: T where - TSym0 = T - type TFHelper_0123456789876543210 :: T -> T -> Bool - type family TFHelper_0123456789876543210 (a :: T) (a :: T) :: Bool where - TFHelper_0123456789876543210 T T = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) T ((~>) T Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) T ((~>) T Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: T -> (~>) T Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: T) :: (~>) T Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: T -> T -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq T where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: T -> T -> Ordering - type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where - Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - type Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) - data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: T -> (~>) T Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T) :: (~>) T Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: T -> T -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 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 ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural -> T - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: T where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural T - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural T - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural -> T - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: T where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: T -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: T) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210 T = FromInteger 0 - type FromEnum_0123456789876543210Sym0 :: (~>) T GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) T GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: T - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance PEnum T where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - type MinBound_0123456789876543210 :: T - type family MinBound_0123456789876543210 :: T where - MinBound_0123456789876543210 = TSym0 - type MinBound_0123456789876543210Sym0 :: T - type family MinBound_0123456789876543210Sym0 :: T where - MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 - type MaxBound_0123456789876543210 :: T - type family MaxBound_0123456789876543210 :: T where - MaxBound_0123456789876543210 = TSym0 - type MaxBound_0123456789876543210Sym0 :: T - type family MaxBound_0123456789876543210Sym0 :: T where - MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 - instance PBounded T where - type MinBound = MinBound_0123456789876543210Sym0 - type MaxBound = MaxBound_0123456789876543210Sym0 - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> T -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> T -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> T -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow T where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data ST :: T -> Type where ST :: ST (T :: T) - type instance Sing @T = ST - instance SingKind T where - type Demote T = T - fromSing ST = T - toSing T = SomeSing ST - instance SEq T where - (%==) :: - forall (t1 :: T) (t2 :: T). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun T ((~>) T Bool) - -> Type) t1) t2) - (%==) ST ST = STrue - instance SOrd T where - sCompare :: - forall (t1 :: T) (t2 :: T). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun T ((~>) T Ordering) - -> Type) t1) t2) - sCompare ST ST - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - instance SEnum T where - sToEnum :: - forall (t :: GHC.Num.Natural.Natural). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.ToEnumSym0 :: TyFun GHC.Num.Natural.Natural T - -> Type) t) - sFromEnum :: - forall (t :: T). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.FromEnumSym0 :: TyFun T GHC.Num.Natural.Natural - -> Type) t) - sToEnum (sN :: Sing n) - = id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 0)) - of - STrue -> ST - SFalse -> sError (sing :: Sing "toEnum: bad argument")) - sFromEnum ST = 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.Num.Natural.Natural) - (t2 :: T) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - -> Type) t1) t2) t3) - sShowsPrec - _ - ST - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "T")) - sA_0123456789876543210 - instance SDecide T where - (%~) ST ST = Proved Refl - instance Data.Type.Equality.TestEquality (ST :: T -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (ST :: T -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Show (ST (z :: T)) - instance SingI T where - sing = ST +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 TSym0 :: T where+ TSym0 = T+ type TFHelper_0123456789876543210 :: T -> T -> Bool+ type family TFHelper_0123456789876543210 (a :: T) (a :: T) :: Bool where+ TFHelper_0123456789876543210 T T = TrueSym0+ instance PEq T where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: T -> T -> Ordering+ type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where+ Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ instance POrd T where+ type Compare a a = Compare_0123456789876543210 a a+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = TSym0+ LamCases_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument"+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> T+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: T where+ ToEnum_0123456789876543210 n = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 0))+ type FromEnum_0123456789876543210 :: T+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: T) :: GHC.Internal.Bignum.Natural.Natural where+ FromEnum_0123456789876543210 T = FromInteger 0+ instance PEnum T where+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ type MinBound_0123456789876543210 :: T+ type family MinBound_0123456789876543210 :: T where+ MinBound_0123456789876543210 = TSym0+ type MaxBound_0123456789876543210 :: T+ type family MaxBound_0123456789876543210 :: T where+ MaxBound_0123456789876543210 = TSym0+ instance PBounded T where+ type MinBound = MinBound_0123456789876543210+ type MaxBound = MaxBound_0123456789876543210+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> T+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (a :: T) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.Types.Symbol where+ ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210+ instance PShow T where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data ST :: T -> Type where ST :: ST (T :: T)+ type instance Sing @T = ST+ instance SingKind T where+ type Demote T = T+ fromSing ST = T+ toSing T = SomeSing ST+ instance SEq T where+ (%==) ST ST = STrue+ instance SOrd T where+ sCompare ST ST+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ instance SEnum T where+ sToEnum (sN :: Sing n)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> ST+ SFalse+ -> applySing+ (singFun1 @ErrorSym0 sError)+ (sing :: Sing "toEnum: bad argument")))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 0)))+ sFromEnum ST = sFromInteger (sing :: Sing 0)+ instance SBounded T where+ sMinBound = ST+ sMaxBound = ST+ instance SShow T where+ sShowsPrec+ _+ ST+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "T"))+ sA_0123456789876543210+ instance SDecide T where+ (%~) ST ST = Proved Refl+ instance Eq (ST (z :: T)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (ST :: T+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (ST :: T+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (ST (z :: T)) where+ compare _ _ = EQ+ deriving instance Show (ST (z :: T))+ instance SingI T where+ sing = ST
tests/compile-and-dump/Singletons/T190.hs view
@@ -1,5 +1,5 @@-module T190 where - -import Data.Singletons.Base.TH - -$(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |]) +module T190 where++import Data.Singletons.Base.TH++$(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |])
tests/compile-and-dump/Singletons/T197.golden view
@@ -1,49 +1,48 @@-Singletons/T197.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixl 5 $$: - - ($$:) :: Bool -> Bool -> Bool - _ $$: _ = False |] - ======> - infixl 5 $$: - ($$:) :: Bool -> Bool -> Bool - ($$:) _ _ = False - type ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) - data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) - where - (:$$:@#@$###) :: SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - ($$:@#@$) a0123456789876543210 - type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings = snd ((,) (:$$:@#@$###) ()) - infixl 5 $$:@#@$ - type ($$:@#@$$) :: Bool -> (~>) Bool Bool - data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool - where - (:$$:@#@$$###) :: SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => - ($$:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:$$:@#@$$###) ()) - infixl 5 $$:@#@$$ - type ($$:@#@$$$) :: Bool -> Bool -> Bool - type family ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Bool where - ($$:@#@$$$) a0123456789876543210 a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 - infixl 5 $$:@#@$$$ - type ($$:) :: Bool -> Bool -> Bool - 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) :: Type) - (%$$:) _ _ = SFalse - instance SingI (($$:@#@$) :: (~>) Bool ((~>) Bool Bool)) where - sing = singFun2 @($$:@#@$) (%$$:) - instance SingI d => - SingI (($$:@#@$$) (d :: Bool) :: (~>) Bool Bool) where - sing = singFun1 @(($$:@#@$$) (d :: Bool)) ((%$$:) (sing @d)) - instance SingI1 (($$:@#@$$) :: Bool -> (~>) Bool Bool) where - liftSing (s :: Sing (d :: Bool)) - = singFun1 @(($$:@#@$$) (d :: Bool)) ((%$$:) s) +Singletons/T197.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| infixl 5 $$:+ + ($$:) :: Bool -> Bool -> Bool+ _ $$: _ = False |]+ ======>+ infixl 5 $$:+ ($$:) :: Bool -> Bool -> Bool+ ($$:) _ _ = False+ type ($$:@#@$) :: (~>) Bool ((~>) Bool Bool)+ data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool)+ where+ (:$$:@#@$###) :: SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>+ ($$:@#@$) a0123456789876543210+ type instance Apply @Bool @((~>) Bool Bool) ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings ($$:@#@$) where+ suppressUnusedWarnings = snd ((,) (:$$:@#@$###) ())+ infixl 5 type $$:@#@$+ type ($$:@#@$$) :: Bool -> (~>) Bool Bool+ data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool+ where+ (:$$:@#@$$###) :: SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) =>+ ($$:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Bool (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:$$:@#@$$###) ())+ infixl 5 type $$:@#@$$+ type ($$:@#@$$$) :: Bool -> Bool -> Bool+ type family ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Bool where+ ($$:@#@$$$) a0123456789876543210 a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210+ infixl 5 type $$:@#@$$$+ type ($$:) :: Bool -> Bool -> Bool+ type family ($$:) (a :: Bool) (a :: Bool) :: Bool where+ ($$:) _ _ = FalseSym0+ infixl 5 data %$$:+ (%$$:) ::+ (forall (t :: Bool) (t :: Bool).+ Sing t -> Sing t -> Sing (($$:) t t :: Bool) :: Type)+ (%$$:) _ _ = SFalse+ instance SingI (($$:@#@$) :: (~>) Bool ((~>) Bool Bool)) where+ sing = singFun2 @($$:@#@$) (%$$:)+ instance SingI d =>+ SingI (($$:@#@$$) (d :: Bool) :: (~>) Bool Bool) where+ sing = singFun1 @(($$:@#@$$) (d :: Bool)) ((%$$:) (sing @d))+ instance SingI1 (($$:@#@$$) :: Bool -> (~>) Bool Bool) where+ liftSing (s :: Sing (d :: Bool))+ = singFun1 @(($$:@#@$$) (d :: Bool)) ((%$$:) s)
tests/compile-and-dump/Singletons/T197.hs view
@@ -1,10 +1,10 @@-module T197 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - infixl 5 $$: - ($$:) :: Bool -> Bool -> Bool - _ $$: _ = False - |]) +module T197 where++import Data.Singletons.TH+import Prelude.Singletons++$(singletons [d|+ infixl 5 $$:+ ($$:) :: Bool -> Bool -> Bool+ _ $$: _ = False+ |])
tests/compile-and-dump/Singletons/T197b.golden view
@@ -1,105 +1,105 @@-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 (:*:@#@$) :: forall a b. (~>) a ((~>) b ((:*:) a b)) - data (:*:@#@$) :: (~>) a ((~>) b ((:*:) a b)) - where - (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) a0123456789876543210 - type instance Apply (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd ((,) (::*:@#@$###) ()) - type (:*:@#@$$) :: forall a b. a -> (~>) b ((:*:) a b) - data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) b ((:*:) a b) - where - (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) => - (:*:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ()) - type (:*:@#@$$$) :: forall a b. a -> b -> (:*:) a b - type family (:*:@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (:*:) a b where - (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210 - type MkPairSym0 :: forall a b. (~>) a ((~>) b (Pair a b)) - data MkPairSym0 :: (~>) a ((~>) b (Pair a b)) - where - MkPairSym0KindInference :: SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => - MkPairSym0 a0123456789876543210 - type instance Apply MkPairSym0 a0123456789876543210 = MkPairSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkPairSym0 where - suppressUnusedWarnings = snd ((,) MkPairSym0KindInference ()) - infixr 9 `MkPairSym0` - type MkPairSym1 :: forall a b. a -> (~>) b (Pair a b) - data MkPairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b) - where - MkPairSym1KindInference :: SameKind (Apply (MkPairSym1 a0123456789876543210) arg) (MkPairSym2 a0123456789876543210 arg) => - MkPairSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkPairSym1 a0123456789876543210) a0123456789876543210 = MkPair a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkPairSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkPairSym1KindInference ()) - infixr 9 `MkPairSym1` - type MkPairSym2 :: forall a b. a -> b -> Pair a b - type family MkPairSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where - MkPairSym2 a0123456789876543210 a0123456789876543210 = MkPair a0123456789876543210 a0123456789876543210 - infixr 9 `MkPairSym2` - infixr 9 `SMkPair` - data (%:*:) :: forall a b. (:*:) a b -> Type - where - (:%*:) :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> (%:*:) ((:*:) n n :: (:*:) a b) - type instance Sing @((:*:) a b) = (%:*:) - 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 SPair :: forall a b. Pair a b -> Type - where - SMkPair :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> SPair (MkPair n n :: Pair a b) - type instance Sing @(Pair a b) = SPair - 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 n => SingI1 ((:*:) (n :: a)) where - liftSing = (:%*:) sing - instance SingI2 (:*:) where - liftSing2 = (:%*:) - instance SingI ((:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))) where - sing = singFun2 @(:*:@#@$) (:%*:) - instance SingI d => - SingI ((:*:@#@$$) (d :: a) :: (~>) b ((:*:) a b)) where - sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d)) - instance SingI1 ((:*:@#@$$) :: a -> (~>) b ((:*:) a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s) - instance (SingI n, SingI n) => - SingI (MkPair (n :: a) (n :: b)) where - sing = SMkPair sing sing - instance SingI n => SingI1 (MkPair (n :: a)) where - liftSing = SMkPair sing - instance SingI2 MkPair where - liftSing2 = SMkPair - instance SingI (MkPairSym0 :: (~>) a ((~>) b (Pair a b))) where - sing = singFun2 @MkPairSym0 SMkPair - instance SingI d => - SingI (MkPairSym1 (d :: a) :: (~>) b (Pair a b)) where - sing = singFun1 @(MkPairSym1 (d :: a)) (SMkPair (sing @d)) - instance SingI1 (MkPairSym1 :: a -> (~>) b (Pair a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkPairSym1 (d :: a)) (SMkPair s) +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 (:*:@#@$) :: forall a b. (~>) a ((~>) b ((:*:) a b))+ data (:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))+ where+ (::*:@#@$###) :: SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>+ (:*:@#@$) a0123456789876543210+ type instance Apply @a @((~>) b ((:*:) a b)) (:*:@#@$) a0123456789876543210 = (:*:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:*:@#@$) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$###) ())+ type (:*:@#@$$) :: forall a b. a -> (~>) b ((:*:) a b)+ data (:*:@#@$$) (a0123456789876543210 :: a) :: (~>) b ((:*:) a b)+ where+ (::*:@#@$$###) :: SameKind (Apply ((:*:@#@$$) a0123456789876543210) arg) ((:*:@#@$$$) a0123456789876543210 arg) =>+ (:*:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @b @((:*:) a b) ((:*:@#@$$) a0123456789876543210) a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:*:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::*:@#@$$###) ())+ type (:*:@#@$$$) :: forall a b. a -> b -> (:*:) a b+ type family (:*:@#@$$$) @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (:*:) a b where+ (:*:@#@$$$) a0123456789876543210 a0123456789876543210 = (:*:) a0123456789876543210 a0123456789876543210+ type MkPairSym0 :: forall a b. (~>) a ((~>) b (Pair a b))+ data MkPairSym0 :: (~>) a ((~>) b (Pair a b))+ where+ MkPairSym0KindInference :: SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) =>+ MkPairSym0 a0123456789876543210+ type instance Apply @a @((~>) b (Pair a b)) MkPairSym0 a0123456789876543210 = MkPairSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkPairSym0 where+ suppressUnusedWarnings = snd ((,) MkPairSym0KindInference ())+ infixr 9 type `MkPairSym0`+ type MkPairSym1 :: forall a b. a -> (~>) b (Pair a b)+ data MkPairSym1 (a0123456789876543210 :: a) :: (~>) b (Pair a b)+ where+ MkPairSym1KindInference :: SameKind (Apply (MkPairSym1 a0123456789876543210) arg) (MkPairSym2 a0123456789876543210 arg) =>+ MkPairSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(Pair a b) (MkPairSym1 a0123456789876543210) a0123456789876543210 = MkPair a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkPairSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkPairSym1KindInference ())+ infixr 9 type `MkPairSym1`+ type MkPairSym2 :: forall a b. a -> b -> Pair a b+ type family MkPairSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Pair a b where+ MkPairSym2 a0123456789876543210 a0123456789876543210 = MkPair a0123456789876543210 a0123456789876543210+ infixr 9 type `MkPairSym2`+ infixr 9 data `SMkPair`+ data (%:*:) :: forall a b. (:*:) a b -> Type+ where+ (:%*:) :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> (%:*:) ((:*:) n n :: (:*:) a b)+ type instance Sing @((:*:) a b) = (%:*:)+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%*:) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ data SPair :: forall a b. Pair a b -> Type+ where+ SMkPair :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SPair (MkPair n n :: Pair a b)+ type instance Sing @(Pair a b) = SPair+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkPair c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ instance (SingI n, SingI n) =>+ SingI ((:*:) (n :: a) (n :: b)) where+ sing = (:%*:) sing sing+ instance SingI n => SingI1 ((:*:) (n :: a)) where+ liftSing = (:%*:) sing+ instance SingI2 (:*:) where+ liftSing2 = (:%*:)+ instance SingI ((:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))) where+ sing = singFun2 @(:*:@#@$) (:%*:)+ instance SingI d =>+ SingI ((:*:@#@$$) (d :: a) :: (~>) b ((:*:) a b)) where+ sing = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) (sing @d))+ instance SingI1 ((:*:@#@$$) :: a -> (~>) b ((:*:) a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:*:@#@$$) (d :: a)) ((:%*:) s)+ instance (SingI n, SingI n) =>+ SingI (MkPair (n :: a) (n :: b)) where+ sing = SMkPair sing sing+ instance SingI n => SingI1 (MkPair (n :: a)) where+ liftSing = SMkPair sing+ instance SingI2 MkPair where+ liftSing2 = SMkPair+ instance SingI (MkPairSym0 :: (~>) a ((~>) b (Pair a b))) where+ sing = singFun2 @MkPairSym0 SMkPair+ instance SingI d =>+ SingI (MkPairSym1 (d :: a) :: (~>) b (Pair a b)) where+ sing = singFun1 @(MkPairSym1 (d :: a)) (SMkPair (sing @d))+ instance SingI1 (MkPairSym1 :: a -> (~>) b (Pair a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkPairSym1 (d :: a)) (SMkPair s)
tests/compile-and-dump/Singletons/T197b.hs view
@@ -1,10 +1,10 @@-module T197b where - -import Data.Singletons.TH - -$(singletons - [d| data a :*: b = a :*: b - - data Pair a b = MkPair a b - infixr 9 `Pair`, `MkPair` - |]) +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.golden view
@@ -1,220 +1,210 @@-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 (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (::$$:@#@$###) :: SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => - (:$$:@#@$) a0123456789876543210 - type instance Apply (:$$:@#@$) a0123456789876543210 = (:$$:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:$$:@#@$) where - suppressUnusedWarnings = snd ((,) (::$$:@#@$###) ()) - type (:$$:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage - data (:$$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage - where - (::$$:@#@$$###) :: SameKind (Apply ((:$$:@#@$$) a0123456789876543210) arg) ((:$$:@#@$$$) a0123456789876543210 arg) => - (:$$:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:$$:@#@$$) a0123456789876543210) a0123456789876543210 = (:$$:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:$$:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::$$:@#@$$###) ()) - type (:$$:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage - type family (:$$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where - (:$$:@#@$$$) a0123456789876543210 a0123456789876543210 = (:$$:) a0123456789876543210 a0123456789876543210 - type (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (::<>:@#@$###) :: SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => - (:<>:@#@$) a0123456789876543210 - type instance Apply (:<>:@#@$) a0123456789876543210 = (:<>:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:<>:@#@$) where - suppressUnusedWarnings = snd ((,) (::<>:@#@$###) ()) - type (:<>:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage - data (:<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage - where - (::<>:@#@$$###) :: SameKind (Apply ((:<>:@#@$$) a0123456789876543210) arg) ((:<>:@#@$$$) a0123456789876543210 arg) => - (:<>:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:<>:@#@$$) a0123456789876543210) a0123456789876543210 = (:<>:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:<>:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::<>:@#@$$###) ()) - type (:<>:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage - type family (:<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where - (:<>:@#@$$$) a0123456789876543210 a0123456789876543210 = (:<>:) a0123456789876543210 a0123456789876543210 - type EMSym0 :: (~>) [Bool] ErrorMessage - data EMSym0 :: (~>) [Bool] ErrorMessage - where - EMSym0KindInference :: SameKind (Apply EMSym0 arg) (EMSym1 arg) => - EMSym0 a0123456789876543210 - type instance Apply EMSym0 a0123456789876543210 = EM a0123456789876543210 - instance SuppressUnusedWarnings EMSym0 where - suppressUnusedWarnings = snd ((,) EMSym0KindInference ()) - type EMSym1 :: [Bool] -> ErrorMessage - type family EMSym1 (a0123456789876543210 :: [Bool]) :: ErrorMessage where - EMSym1 a0123456789876543210 = EM a0123456789876543210 - type (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (:<>:@#@$###) :: SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => - (<>:@#@$) a0123456789876543210 - type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<>:@#@$) where - suppressUnusedWarnings = snd ((,) (:<>:@#@$###) ()) - type (<>:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage - data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage - where - (:<>:@#@$$###) :: SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) => - (<>:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<>:@#@$$###) ()) - type (<>:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage - type family (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where - (<>:@#@$$$) a0123456789876543210 a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210 - type ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (:$$:@#@$###) :: SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - ($$:@#@$) a0123456789876543210 - type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings = snd ((,) (:$$:@#@$###) ()) - type ($$:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage - data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage - where - (:$$:@#@$$###) :: SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => - ($$:@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:$$:@#@$$###) ()) - type ($$:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage - type family ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where - ($$:@#@$$$) a0123456789876543210 a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 - type (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where - (<>:) x y = Apply (Apply (:<>:@#@$) x) y - type ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage - 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) :: Type) - (%$$:) :: - (forall (t :: ErrorMessage) (t :: ErrorMessage). - Sing t - -> Sing t - -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage) :: Type) - (%<>:) (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 SingI1 ((<>:@#@$$) :: ErrorMessage - -> (~>) ErrorMessage ErrorMessage) where - liftSing (s :: Sing (d :: ErrorMessage)) - = singFun1 @((<>:@#@$$) (d :: ErrorMessage)) ((%<>:) s) - instance SingI (($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where - sing = singFun2 @($$:@#@$) (%$$:) - instance SingI d => - SingI (($$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where - sing - = singFun1 @(($$:@#@$$) (d :: ErrorMessage)) ((%$$:) (sing @d)) - instance SingI1 (($$:@#@$$) :: ErrorMessage - -> (~>) ErrorMessage ErrorMessage) where - liftSing (s :: Sing (d :: ErrorMessage)) - = singFun1 @(($$:@#@$$) (d :: ErrorMessage)) ((%$$:) s) - data SErrorMessage :: ErrorMessage -> Type - where - (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). - (Sing n) -> (Sing n) -> SErrorMessage ((:$$:) n n :: ErrorMessage) - (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). - (Sing n) -> (Sing n) -> SErrorMessage ((:<>:) n n :: ErrorMessage) - SEM :: forall (n :: [Bool]). - (Sing n) -> SErrorMessage (EM n :: ErrorMessage) - type instance Sing @ErrorMessage = SErrorMessage - 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 n => SingI1 ((:$$:) (n :: ErrorMessage)) where - liftSing = (:%$$:) sing - instance SingI2 (:$$:) where - liftSing2 = (:%$$:) - instance SingI ((:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where - sing = singFun2 @(:$$:@#@$) (:%$$:) - instance SingI d => - SingI ((:$$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where - sing - = singFun1 @((:$$:@#@$$) (d :: ErrorMessage)) ((:%$$:) (sing @d)) - instance SingI1 ((:$$:@#@$$) :: ErrorMessage - -> (~>) ErrorMessage ErrorMessage) where - liftSing (s :: Sing (d :: ErrorMessage)) - = singFun1 @((:$$:@#@$$) (d :: ErrorMessage)) ((:%$$:) s) - instance (SingI n, SingI n) => - SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where - sing = (:%<>:) sing sing - instance SingI n => SingI1 ((:<>:) (n :: ErrorMessage)) where - liftSing = (:%<>:) sing - instance SingI2 (:<>:) where - liftSing2 = (:%<>:) - instance SingI ((:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where - sing = singFun2 @(:<>:@#@$) (:%<>:) - instance SingI d => - SingI ((:<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where - sing - = singFun1 @((:<>:@#@$$) (d :: ErrorMessage)) ((:%<>:) (sing @d)) - instance SingI1 ((:<>:@#@$$) :: ErrorMessage - -> (~>) ErrorMessage ErrorMessage) where - liftSing (s :: Sing (d :: ErrorMessage)) - = singFun1 @((:<>:@#@$$) (d :: ErrorMessage)) ((:%<>:) s) - instance SingI n => SingI (EM (n :: [Bool])) where - sing = SEM sing - instance SingI1 EM where - liftSing = SEM - instance SingI (EMSym0 :: (~>) [Bool] ErrorMessage) where - sing = singFun1 @EMSym0 SEM +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 (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ where+ (::$$:@#@$###) :: SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) =>+ (:$$:@#@$) a0123456789876543210+ type instance Apply @ErrorMessage @((~>) ErrorMessage ErrorMessage) (:$$:@#@$) a0123456789876543210 = (:$$:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:$$:@#@$) where+ suppressUnusedWarnings = snd ((,) (::$$:@#@$###) ())+ type (:$$:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage+ data (:$$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage+ where+ (::$$:@#@$$###) :: SameKind (Apply ((:$$:@#@$$) a0123456789876543210) arg) ((:$$:@#@$$$) a0123456789876543210 arg) =>+ (:$$:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @ErrorMessage @ErrorMessage ((:$$:@#@$$) a0123456789876543210) a0123456789876543210 = (:$$:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:$$:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::$$:@#@$$###) ())+ type (:$$:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family (:$$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where+ (:$$:@#@$$$) a0123456789876543210 a0123456789876543210 = (:$$:) a0123456789876543210 a0123456789876543210+ type (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ where+ (::<>:@#@$###) :: SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) =>+ (:<>:@#@$) a0123456789876543210+ type instance Apply @ErrorMessage @((~>) ErrorMessage ErrorMessage) (:<>:@#@$) a0123456789876543210 = (:<>:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:<>:@#@$) where+ suppressUnusedWarnings = snd ((,) (::<>:@#@$###) ())+ type (:<>:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage+ data (:<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage+ where+ (::<>:@#@$$###) :: SameKind (Apply ((:<>:@#@$$) a0123456789876543210) arg) ((:<>:@#@$$$) a0123456789876543210 arg) =>+ (:<>:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @ErrorMessage @ErrorMessage ((:<>:@#@$$) a0123456789876543210) a0123456789876543210 = (:<>:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:<>:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::<>:@#@$$###) ())+ type (:<>:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family (:<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where+ (:<>:@#@$$$) a0123456789876543210 a0123456789876543210 = (:<>:) a0123456789876543210 a0123456789876543210+ type EMSym0 :: (~>) [Bool] ErrorMessage+ data EMSym0 :: (~>) [Bool] ErrorMessage+ where+ EMSym0KindInference :: SameKind (Apply EMSym0 arg) (EMSym1 arg) =>+ EMSym0 a0123456789876543210+ type instance Apply @[Bool] @ErrorMessage EMSym0 a0123456789876543210 = EM a0123456789876543210+ instance SuppressUnusedWarnings EMSym0 where+ suppressUnusedWarnings = snd ((,) EMSym0KindInference ())+ type EMSym1 :: [Bool] -> ErrorMessage+ type family EMSym1 (a0123456789876543210 :: [Bool]) :: ErrorMessage where+ EMSym1 a0123456789876543210 = EM a0123456789876543210+ type (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ where+ (:<>:@#@$###) :: SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) =>+ (<>:@#@$) a0123456789876543210+ type instance Apply @ErrorMessage @((~>) ErrorMessage ErrorMessage) (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<>:@#@$) where+ suppressUnusedWarnings = snd ((,) (:<>:@#@$###) ())+ type (<>:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage+ data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage+ where+ (:<>:@#@$$###) :: SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) =>+ (<>:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @ErrorMessage @ErrorMessage ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<>:@#@$$###) ())+ type (<>:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where+ (<>:@#@$$$) a0123456789876543210 a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210+ type ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)+ where+ (:$$:@#@$###) :: SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>+ ($$:@#@$) a0123456789876543210+ type instance Apply @ErrorMessage @((~>) ErrorMessage ErrorMessage) ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings ($$:@#@$) where+ suppressUnusedWarnings = snd ((,) (:$$:@#@$###) ())+ type ($$:@#@$$) :: ErrorMessage -> (~>) ErrorMessage ErrorMessage+ data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage+ where+ (:$$:@#@$$###) :: SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) =>+ ($$:@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @ErrorMessage @ErrorMessage (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:$$:@#@$$###) ())+ type ($$:@#@$$$) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) :: ErrorMessage where+ ($$:@#@$$$) a0123456789876543210 a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210+ type (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where+ (<>:) x y = Apply (Apply (:<>:@#@$) x) y+ type ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage+ type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where+ ($$:) x y = Apply (Apply (:$$:@#@$) x) y+ (%<>:) ::+ (forall (t :: ErrorMessage) (t :: ErrorMessage).+ Sing t -> Sing t -> Sing ((<>:) t t :: ErrorMessage) :: Type)+ (%$$:) ::+ (forall (t :: ErrorMessage) (t :: ErrorMessage).+ Sing t -> Sing t -> Sing (($$:) t t :: ErrorMessage) :: Type)+ (%<>:) (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 SingI1 ((<>:@#@$$) :: ErrorMessage+ -> (~>) ErrorMessage ErrorMessage) where+ liftSing (s :: Sing (d :: ErrorMessage))+ = singFun1 @((<>:@#@$$) (d :: ErrorMessage)) ((%<>:) s)+ instance SingI (($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where+ sing = singFun2 @($$:@#@$) (%$$:)+ instance SingI d =>+ SingI (($$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where+ sing+ = singFun1 @(($$:@#@$$) (d :: ErrorMessage)) ((%$$:) (sing @d))+ instance SingI1 (($$:@#@$$) :: ErrorMessage+ -> (~>) ErrorMessage ErrorMessage) where+ liftSing (s :: Sing (d :: ErrorMessage))+ = singFun1 @(($$:@#@$$) (d :: ErrorMessage)) ((%$$:) s)+ data SErrorMessage :: ErrorMessage -> Type+ where+ (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage).+ (Sing n) -> (Sing n) -> SErrorMessage ((:$$:) n n :: ErrorMessage)+ (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage).+ (Sing n) -> (Sing n) -> SErrorMessage ((:<>:) n n :: ErrorMessage)+ SEM :: forall (n :: [Bool]).+ (Sing n) -> SErrorMessage (EM n :: ErrorMessage)+ type instance Sing @ErrorMessage = SErrorMessage+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%$$:) c c))+ (toSing b :: SomeSing ErrorMessage)+ (toSing b :: SomeSing ErrorMessage)+ toSing+ ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:%<>:) c c))+ (toSing b :: SomeSing ErrorMessage)+ (toSing b :: SomeSing ErrorMessage)+ toSing (EM (b :: Demote [Bool]))+ = (\cases (SomeSing c) -> SomeSing (SEM c))+ (toSing b :: SomeSing [Bool])+ instance (SingI n, SingI n) =>+ SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where+ sing = (:%$$:) sing sing+ instance SingI n => SingI1 ((:$$:) (n :: ErrorMessage)) where+ liftSing = (:%$$:) sing+ instance SingI2 (:$$:) where+ liftSing2 = (:%$$:)+ instance SingI ((:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where+ sing = singFun2 @(:$$:@#@$) (:%$$:)+ instance SingI d =>+ SingI ((:$$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where+ sing+ = singFun1 @((:$$:@#@$$) (d :: ErrorMessage)) ((:%$$:) (sing @d))+ instance SingI1 ((:$$:@#@$$) :: ErrorMessage+ -> (~>) ErrorMessage ErrorMessage) where+ liftSing (s :: Sing (d :: ErrorMessage))+ = singFun1 @((:$$:@#@$$) (d :: ErrorMessage)) ((:%$$:) s)+ instance (SingI n, SingI n) =>+ SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where+ sing = (:%<>:) sing sing+ instance SingI n => SingI1 ((:<>:) (n :: ErrorMessage)) where+ liftSing = (:%<>:) sing+ instance SingI2 (:<>:) where+ liftSing2 = (:%<>:)+ instance SingI ((:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where+ sing = singFun2 @(:<>:@#@$) (:%<>:)+ instance SingI d =>+ SingI ((:<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where+ sing+ = singFun1 @((:<>:@#@$$) (d :: ErrorMessage)) ((:%<>:) (sing @d))+ instance SingI1 ((:<>:@#@$$) :: ErrorMessage+ -> (~>) ErrorMessage ErrorMessage) where+ liftSing (s :: Sing (d :: ErrorMessage))+ = singFun1 @((:<>:@#@$$) (d :: ErrorMessage)) ((:%<>:) s)+ instance SingI n => SingI (EM (n :: [Bool])) where+ sing = SEM sing+ instance SingI1 EM where+ liftSing = SEM+ instance SingI (EMSym0 :: (~>) [Bool] ErrorMessage) where+ sing = singFun1 @EMSym0 SEM
tests/compile-and-dump/Singletons/T200.hs view
@@ -1,15 +1,15 @@-module T200 where - -import Data.Singletons.Base.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 - |]) +module T200 where++import Data.Singletons.Base.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/T204.golden view
@@ -1,106 +1,106 @@-Singletons/T204.hs:(0,0)-(0,0): Splicing declarations - let - sing_data_con_name :: Name -> Name - sing_data_con_name n - = case nameBase n of - ':' : '%' : rest -> mkName $ ":^%" ++ rest - _ -> singledDataConName defaultOptions n - in - withOptions - defaultOptions {singledDataConName = sing_data_con_name} - $ singletons - $ lift - [d| data Ratio1 a = a :% a - data Ratio2 a = a :%% a |] - ======> - data Ratio1 a = a :% a - data Ratio2 a = a :%% a - type (:%@#@$) :: forall a. (~>) a ((~>) a (Ratio1 a)) - data (:%@#@$) :: (~>) a ((~>) a (Ratio1 a)) - where - (::%@#@$###) :: SameKind (Apply (:%@#@$) arg) ((:%@#@$$) arg) => - (:%@#@$) a0123456789876543210 - type instance Apply (:%@#@$) a0123456789876543210 = (:%@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:%@#@$) where - suppressUnusedWarnings = snd ((,) (::%@#@$###) ()) - type (:%@#@$$) :: forall a. a -> (~>) a (Ratio1 a) - data (:%@#@$$) (a0123456789876543210 :: a) :: (~>) a (Ratio1 a) - where - (::%@#@$$###) :: SameKind (Apply ((:%@#@$$) a0123456789876543210) arg) ((:%@#@$$$) a0123456789876543210 arg) => - (:%@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:%@#@$$) a0123456789876543210) a0123456789876543210 = (:%) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:%@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::%@#@$$###) ()) - type (:%@#@$$$) :: forall a. a -> a -> Ratio1 a - type family (:%@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ratio1 a where - (:%@#@$$$) a0123456789876543210 a0123456789876543210 = (:%) a0123456789876543210 a0123456789876543210 - type (:%%@#@$) :: forall a. (~>) a ((~>) a (Ratio2 a)) - data (:%%@#@$) :: (~>) a ((~>) a (Ratio2 a)) - where - (::%%@#@$###) :: SameKind (Apply (:%%@#@$) arg) ((:%%@#@$$) arg) => - (:%%@#@$) a0123456789876543210 - type instance Apply (:%%@#@$) a0123456789876543210 = (:%%@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:%%@#@$) where - suppressUnusedWarnings = snd ((,) (::%%@#@$###) ()) - type (:%%@#@$$) :: forall a. a -> (~>) a (Ratio2 a) - data (:%%@#@$$) (a0123456789876543210 :: a) :: (~>) a (Ratio2 a) - where - (::%%@#@$$###) :: SameKind (Apply ((:%%@#@$$) a0123456789876543210) arg) ((:%%@#@$$$) a0123456789876543210 arg) => - (:%%@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:%%@#@$$) a0123456789876543210) a0123456789876543210 = (:%%) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:%%@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::%%@#@$$###) ()) - type (:%%@#@$$$) :: forall a. a -> a -> Ratio2 a - type family (:%%@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ratio2 a where - (:%%@#@$$$) a0123456789876543210 a0123456789876543210 = (:%%) a0123456789876543210 a0123456789876543210 - data SRatio1 :: forall a. Ratio1 a -> GHC.Types.Type - where - (:^%) :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SRatio1 ((:%) n n :: Ratio1 a) - type instance Sing @(Ratio1 a) = SRatio1 - instance SingKind a => SingKind (Ratio1 a) where - type Demote (Ratio1 a) = Ratio1 (Demote a) - fromSing ((:^%) b b) = (:%) (fromSing b) (fromSing b) - 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 SRatio2 :: forall a. Ratio2 a -> GHC.Types.Type - where - (:^%%) :: forall a (n :: a) (n :: a). - (Sing n) -> (Sing n) -> SRatio2 ((:%%) n n :: Ratio2 a) - type instance Sing @(Ratio2 a) = SRatio2 - instance SingKind a => SingKind (Ratio2 a) where - type Demote (Ratio2 a) = Ratio2 (Demote a) - fromSing ((:^%%) b b) = (:%%) (fromSing b) (fromSing b) - toSing ((:%%) (b :: Demote a) (b :: Demote a)) - = case (,) (toSing b :: SomeSing a) (toSing b :: SomeSing a) of - (,) (SomeSing c) (SomeSing c) -> SomeSing ((:^%%) c c) - instance (SingI n, SingI n) => SingI ((:%) (n :: a) (n :: a)) where - sing = (:^%) sing sing - instance SingI n => SingI1 ((:%) (n :: a)) where - liftSing = (:^%) sing - instance SingI2 (:%) where - liftSing2 = (:^%) - instance SingI ((:%@#@$) :: (~>) a ((~>) a (Ratio1 a))) where - sing = singFun2 @(:%@#@$) (:^%) - instance SingI d => - SingI ((:%@#@$$) (d :: a) :: (~>) a (Ratio1 a)) where - sing = singFun1 @((:%@#@$$) (d :: a)) ((:^%) (sing @d)) - instance SingI1 ((:%@#@$$) :: a -> (~>) a (Ratio1 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:%@#@$$) (d :: a)) ((:^%) s) - instance (SingI n, SingI n) => - SingI ((:%%) (n :: a) (n :: a)) where - sing = (:^%%) sing sing - instance SingI n => SingI1 ((:%%) (n :: a)) where - liftSing = (:^%%) sing - instance SingI2 (:%%) where - liftSing2 = (:^%%) - instance SingI ((:%%@#@$) :: (~>) a ((~>) a (Ratio2 a))) where - sing = singFun2 @(:%%@#@$) (:^%%) - instance SingI d => - SingI ((:%%@#@$$) (d :: a) :: (~>) a (Ratio2 a)) where - sing = singFun1 @((:%%@#@$$) (d :: a)) ((:^%%) (sing @d)) - instance SingI1 ((:%%@#@$$) :: a -> (~>) a (Ratio2 a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:%%@#@$$) (d :: a)) ((:^%%) s) +Singletons/T204.hs:(0,0)-(0,0): Splicing declarations+ let+ sing_data_con_name :: Name -> Name+ sing_data_con_name n+ = case nameBase n of+ ':' : '%' : rest -> mkName $ ":^%" ++ rest+ _ -> singledDataConName defaultOptions n+ in+ withOptions+ defaultOptions {singledDataConName = sing_data_con_name}+ $ singletons+ $ lift+ [d| data Ratio1 a = a :% a+ data Ratio2 a = a :%% a |]+ ======>+ data Ratio1 a = a :% a+ data Ratio2 a = a :%% a+ type (:%@#@$) :: forall a. (~>) a ((~>) a (Ratio1 a))+ data (:%@#@$) :: (~>) a ((~>) a (Ratio1 a))+ where+ (::%@#@$###) :: SameKind (Apply (:%@#@$) arg) ((:%@#@$$) arg) =>+ (:%@#@$) a0123456789876543210+ type instance Apply @a @((~>) a (Ratio1 a)) (:%@#@$) a0123456789876543210 = (:%@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:%@#@$) where+ suppressUnusedWarnings = snd ((,) (::%@#@$###) ())+ type (:%@#@$$) :: forall a. a -> (~>) a (Ratio1 a)+ data (:%@#@$$) (a0123456789876543210 :: a) :: (~>) a (Ratio1 a)+ where+ (::%@#@$$###) :: SameKind (Apply ((:%@#@$$) a0123456789876543210) arg) ((:%@#@$$$) a0123456789876543210 arg) =>+ (:%@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Ratio1 a) ((:%@#@$$) a0123456789876543210) a0123456789876543210 = (:%) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:%@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::%@#@$$###) ())+ type (:%@#@$$$) :: forall a. a -> a -> Ratio1 a+ type family (:%@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ratio1 a where+ (:%@#@$$$) a0123456789876543210 a0123456789876543210 = (:%) a0123456789876543210 a0123456789876543210+ type (:%%@#@$) :: forall a. (~>) a ((~>) a (Ratio2 a))+ data (:%%@#@$) :: (~>) a ((~>) a (Ratio2 a))+ where+ (::%%@#@$###) :: SameKind (Apply (:%%@#@$) arg) ((:%%@#@$$) arg) =>+ (:%%@#@$) a0123456789876543210+ type instance Apply @a @((~>) a (Ratio2 a)) (:%%@#@$) a0123456789876543210 = (:%%@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:%%@#@$) where+ suppressUnusedWarnings = snd ((,) (::%%@#@$###) ())+ type (:%%@#@$$) :: forall a. a -> (~>) a (Ratio2 a)+ data (:%%@#@$$) (a0123456789876543210 :: a) :: (~>) a (Ratio2 a)+ where+ (::%%@#@$$###) :: SameKind (Apply ((:%%@#@$$) a0123456789876543210) arg) ((:%%@#@$$$) a0123456789876543210 arg) =>+ (:%%@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @(Ratio2 a) ((:%%@#@$$) a0123456789876543210) a0123456789876543210 = (:%%) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:%%@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::%%@#@$$###) ())+ type (:%%@#@$$$) :: forall a. a -> a -> Ratio2 a+ type family (:%%@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Ratio2 a where+ (:%%@#@$$$) a0123456789876543210 a0123456789876543210 = (:%%) a0123456789876543210 a0123456789876543210+ data SRatio1 :: forall a. Ratio1 a -> GHC.Internal.Types.Type+ where+ (:^%) :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SRatio1 ((:%) n n :: Ratio1 a)+ type instance Sing @(Ratio1 a) = SRatio1+ instance SingKind a => SingKind (Ratio1 a) where+ type Demote (Ratio1 a) = Ratio1 (Demote a)+ fromSing ((:^%) b b) = (:%) (fromSing b) (fromSing b)+ toSing ((:%) (b :: Demote a) (b :: Demote a))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:^%) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ data SRatio2 :: forall a. Ratio2 a -> GHC.Internal.Types.Type+ where+ (:^%%) :: forall a (n :: a) (n :: a).+ (Sing n) -> (Sing n) -> SRatio2 ((:%%) n n :: Ratio2 a)+ type instance Sing @(Ratio2 a) = SRatio2+ instance SingKind a => SingKind (Ratio2 a) where+ type Demote (Ratio2 a) = Ratio2 (Demote a)+ fromSing ((:^%%) b b) = (:%%) (fromSing b) (fromSing b)+ toSing ((:%%) (b :: Demote a) (b :: Demote a))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing ((:^%%) c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing a)+ instance (SingI n, SingI n) => SingI ((:%) (n :: a) (n :: a)) where+ sing = (:^%) sing sing+ instance SingI n => SingI1 ((:%) (n :: a)) where+ liftSing = (:^%) sing+ instance SingI2 (:%) where+ liftSing2 = (:^%)+ instance SingI ((:%@#@$) :: (~>) a ((~>) a (Ratio1 a))) where+ sing = singFun2 @(:%@#@$) (:^%)+ instance SingI d =>+ SingI ((:%@#@$$) (d :: a) :: (~>) a (Ratio1 a)) where+ sing = singFun1 @((:%@#@$$) (d :: a)) ((:^%) (sing @d))+ instance SingI1 ((:%@#@$$) :: a -> (~>) a (Ratio1 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:%@#@$$) (d :: a)) ((:^%) s)+ instance (SingI n, SingI n) =>+ SingI ((:%%) (n :: a) (n :: a)) where+ sing = (:^%%) sing sing+ instance SingI n => SingI1 ((:%%) (n :: a)) where+ liftSing = (:^%%) sing+ instance SingI2 (:%%) where+ liftSing2 = (:^%%)+ instance SingI ((:%%@#@$) :: (~>) a ((~>) a (Ratio2 a))) where+ sing = singFun2 @(:%%@#@$) (:^%%)+ instance SingI d =>+ SingI ((:%%@#@$$) (d :: a) :: (~>) a (Ratio2 a)) where+ sing = singFun1 @((:%%@#@$$) (d :: a)) ((:^%%) (sing @d))+ instance SingI1 ((:%%@#@$$) :: a -> (~>) a (Ratio2 a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:%%@#@$$) (d :: a)) ((:^%%) s)
tests/compile-and-dump/Singletons/T204.hs view
@@ -1,17 +1,17 @@-module T204 where - -import Control.Monad.Trans.Class -import Data.Singletons.TH -import Data.Singletons.TH.Options -import Language.Haskell.TH - -$(let sing_data_con_name :: Name -> Name - sing_data_con_name n = - case nameBase n of - ':':'%':rest -> mkName $ ":^%" ++ rest - _ -> singledDataConName defaultOptions n in - withOptions defaultOptions{singledDataConName = sing_data_con_name} $ - singletons $ lift - [d| data Ratio1 a = a :% a - data Ratio2 a = a :%% a - |]) +module T204 where++import Control.Monad.Trans.Class+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Language.Haskell.TH++$(let sing_data_con_name :: Name -> Name+ sing_data_con_name n =+ case nameBase n of+ ':':'%':rest -> mkName $ ":^%" ++ rest+ _ -> singledDataConName defaultOptions n in+ withOptions defaultOptions{singledDataConName = sing_data_con_name} $+ singletons $ lift+ [d| data Ratio1 a = a :% a+ data Ratio2 a = a :%% a+ |])
tests/compile-and-dump/Singletons/T206.hs view
@@ -1,5 +1,5 @@-module T206 where - -import Prelude.Singletons - -x = SCons @Bool @True @'[False] +module T206 where++import Prelude.Singletons++x = SCons @Bool @True @'[False]
tests/compile-and-dump/Singletons/T209.golden view
@@ -1,90 +1,87 @@-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 family HmSym0 :: Hm where - HmSym0 = Hm - type MSym0 :: (~>) a ((~>) b ((~>) Bool Bool)) - data MSym0 :: (~>) a ((~>) b ((~>) Bool Bool)) - where - MSym0KindInference :: SameKind (Apply MSym0 arg) (MSym1 arg) => - MSym0 a0123456789876543210 - type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210 - instance SuppressUnusedWarnings MSym0 where - suppressUnusedWarnings = snd ((,) MSym0KindInference ()) - type MSym1 :: a -> (~>) b ((~>) Bool Bool) - data MSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) Bool Bool) - where - MSym1KindInference :: SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) => - MSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MSym1KindInference ()) - type MSym2 :: a -> b -> (~>) Bool Bool - data MSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) Bool Bool - where - MSym2KindInference :: 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 (MSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MSym2KindInference ()) - type MSym3 :: a -> b -> Bool -> Bool - type family MSym3 (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: Bool) :: Bool where - MSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210 - type M :: a -> b -> Bool -> Bool - type family M (a :: a) (a :: b) (a :: Bool) :: Bool where - M _ _ x = x - class PC a b - instance PC Bool Hm - instance PC a (Maybe a) - sM :: - (forall (t :: a) (t :: b) (t :: Bool). - Sing t - -> Sing t - -> Sing t - -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool) :: Type) - 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 SingI1 (MSym1 :: a -> (~>) b ((~>) Bool Bool)) where - liftSing (s :: Sing (d :: a)) = singFun2 @(MSym1 (d :: a)) (sM s) - 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)) - instance SingI d => - SingI1 (MSym2 (d :: a) :: b -> (~>) Bool Bool) where - liftSing (s :: Sing (d :: b)) - = singFun1 @(MSym2 (d :: a) (d :: b)) (sM (sing @d) s) - instance SingI2 (MSym2 :: a -> b -> (~>) Bool Bool) where - liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b)) - = singFun1 @(MSym2 (d :: a) (d :: b)) (sM s s) - data SHm :: Hm -> Type where SHm :: SHm (Hm :: Hm) - type instance Sing @Hm = SHm - 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 +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 family HmSym0 :: Hm where+ HmSym0 = Hm+ type MSym0 :: (~>) a ((~>) b ((~>) Bool Bool))+ data MSym0 :: (~>) a ((~>) b ((~>) Bool Bool))+ where+ MSym0KindInference :: SameKind (Apply MSym0 arg) (MSym1 arg) =>+ MSym0 a0123456789876543210+ type instance Apply @a @((~>) b ((~>) Bool Bool)) MSym0 a0123456789876543210 = MSym1 a0123456789876543210+ instance SuppressUnusedWarnings MSym0 where+ suppressUnusedWarnings = snd ((,) MSym0KindInference ())+ type MSym1 :: a -> (~>) b ((~>) Bool Bool)+ data MSym1 (a0123456789876543210 :: a) :: (~>) b ((~>) Bool Bool)+ where+ MSym1KindInference :: SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) =>+ MSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @((~>) Bool Bool) (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MSym1KindInference ())+ type MSym2 :: a -> b -> (~>) Bool Bool+ data MSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (~>) Bool Bool+ where+ MSym2KindInference :: SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) =>+ MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Bool (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MSym2KindInference ())+ type MSym3 :: a -> b -> Bool -> Bool+ type family MSym3 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) (a0123456789876543210 :: Bool) :: Bool where+ MSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210+ type M :: a -> b -> Bool -> Bool+ type family M @a @b (a :: a) (a :: b) (a :: Bool) :: Bool where+ M _ _ x = x+ class PC a b+ instance PC Bool Hm+ instance PC a (Maybe a)+ sM ::+ (forall (t :: a) (t :: b) (t :: Bool).+ Sing t -> Sing t -> Sing t -> Sing (M t t t :: Bool) :: Type)+ 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 SingI1 (MSym1 :: a -> (~>) b ((~>) Bool Bool)) where+ liftSing (s :: Sing (d :: a)) = singFun2 @(MSym1 (d :: a)) (sM s)+ 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))+ instance SingI d =>+ SingI1 (MSym2 (d :: a) :: b -> (~>) Bool Bool) where+ liftSing (s :: Sing (d :: b))+ = singFun1 @(MSym2 (d :: a) (d :: b)) (sM (sing @d) s)+ instance SingI2 (MSym2 :: a -> b -> (~>) Bool Bool) where+ liftSing2 (s :: Sing (d :: a)) (s :: Sing (d :: b))+ = singFun1 @(MSym2 (d :: a) (d :: b)) (sM s s)+ data SHm :: Hm -> Type where SHm :: SHm (Hm :: Hm)+ type instance Sing @Hm = SHm+ 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 view
@@ -1,17 +1,16 @@-{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} - -module T209 where - -import Data.Singletons.TH - -$(singletons - [d| class C a b where - m :: a -> b -> Bool -> Bool - m _ _ x = x - - data Hm = Hm - deriving anyclass (C Bool) - - deriving anyclass instance C a a => C a (Maybe a) - |]) +{-# LANGUAGE DeriveAnyClass #-}++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.golden view
@@ -1,42 +1,42 @@-Singletons/T216.hs:0:0:: Splicing declarations - genDefunSymbols [''MyProxy, ''Symmetry] - ======> - data MyProxySym0 :: (~>) Type ((~>) k0123456789876543210 Type) - where - MyProxySym0KindInference :: SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) => - MyProxySym0 k0123456789876543210 - type instance Apply MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210 - instance SuppressUnusedWarnings MyProxySym0 where - suppressUnusedWarnings = snd ((,) MyProxySym0KindInference ()) - data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type - where - MyProxySym1KindInference :: SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) => - MyProxySym1 k0123456789876543210 e0123456789876543210 - type instance Apply (MyProxySym1 k0123456789876543210) e0123456789876543210 = MyProxy k0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where - suppressUnusedWarnings = snd ((,) MyProxySym1KindInference ()) - type family MyProxySym2 (k0123456789876543210 :: Type) (e0123456789876543210 :: k0123456789876543210) :: Type where - MyProxySym2 k0123456789876543210 e0123456789876543210 = MyProxy k0123456789876543210 e0123456789876543210 - data SymmetrySym0 :: (~>) t0123456789876543210 ((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)) - where - SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => - SymmetrySym0 a0123456789876543210 - type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 - instance SuppressUnusedWarnings SymmetrySym0 where - suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ()) - data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) - where - SymmetrySym1KindInference :: SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => - SymmetrySym1 a0123456789876543210 y0123456789876543210 - type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) SymmetrySym1KindInference ()) - data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type - where - SymmetrySym2KindInference :: SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => - SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 - type instance Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings = snd ((,) SymmetrySym2KindInference ()) - type family SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) :: Type where - SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 +Singletons/T216.hs:0:0:: Splicing declarations+ genDefunSymbols [''MyProxy, ''Symmetry]+ ======>+ data MyProxySym0 :: (~>) Type ((~>) k0123456789876543210 Type)+ where+ MyProxySym0KindInference :: SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) =>+ MyProxySym0 k0123456789876543210+ type instance Apply @Type @((~>) k0123456789876543210 Type) MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210+ instance SuppressUnusedWarnings MyProxySym0 where+ suppressUnusedWarnings = snd ((,) MyProxySym0KindInference ())+ data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type+ where+ MyProxySym1KindInference :: SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) =>+ MyProxySym1 k0123456789876543210 e0123456789876543210+ type instance Apply @k0123456789876543210 @Type (MyProxySym1 k0123456789876543210) e0123456789876543210 = MyProxy k0123456789876543210 e0123456789876543210+ instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MyProxySym1KindInference ())+ type family MyProxySym2 (k0123456789876543210 :: Type) (e0123456789876543210 :: k0123456789876543210) :: Type where+ MyProxySym2 k0123456789876543210 e0123456789876543210 = MyProxy k0123456789876543210 e0123456789876543210+ data SymmetrySym0 :: (~>) t0123456789876543210 ((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type))+ where+ SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) =>+ SymmetrySym0 a0123456789876543210+ type instance Apply @t0123456789876543210 @((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)) SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210+ instance SuppressUnusedWarnings SymmetrySym0 where+ suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ())+ data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)+ where+ SymmetrySym1KindInference :: SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) =>+ SymmetrySym1 a0123456789876543210 y0123456789876543210+ type instance Apply @t0123456789876543210 @((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210+ instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) SymmetrySym1KindInference ())+ data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type+ where+ SymmetrySym2KindInference :: SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) =>+ SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210+ type instance Apply @((:~:) a0123456789876543210 y0123456789876543210) @Type (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210+ instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings = snd ((,) SymmetrySym2KindInference ())+ type family SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) :: Type where+ SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210
tests/compile-and-dump/Singletons/T216.hs view
@@ -1,12 +1,12 @@-module T216 where - -import Data.Kind -import Data.Singletons.TH - -type family MyProxy k (a :: k) :: Type where - MyProxy _ a = Proxy a - -type family Symmetry (a :: t) (y :: t) (e :: a :~: y) :: Type where - Symmetry a y _ = y :~: a - -$(genDefunSymbols [''MyProxy, ''Symmetry]) +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.golden view
@@ -1,6 +1,6 @@-Singletons/T226.hs:0:0:: Splicing declarations - singletons [d| class a ~> b |] - ======> - class (~>) a b - class (#~>) a b - class (%~>) a b +Singletons/T226.hs:0:0:: Splicing declarations+ singletons [d| class a ~> b |]+ ======>+ class (~>) a b+ class (#~>) a b+ class (%~>) a b
tests/compile-and-dump/Singletons/T226.hs view
@@ -1,5 +1,5 @@-module T226 where - -import Data.Singletons.TH - -$(singletons [d| class a ~> b |]) +module T226 where++import Data.Singletons.TH++$(singletons [d| class a ~> b |])
tests/compile-and-dump/Singletons/T229.golden view
@@ -1,27 +1,26 @@-Singletons/T229.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| ___foo :: Bool -> Bool - ___foo _ = True |] - ======> - ___foo :: Bool -> Bool - ___foo _ = True - type US___fooSym0 :: (~>) Bool Bool - data US___fooSym0 :: (~>) Bool Bool - where - US___fooSym0KindInference :: SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => - US___fooSym0 a0123456789876543210 - type instance Apply US___fooSym0 a0123456789876543210 = US___foo a0123456789876543210 - instance SuppressUnusedWarnings US___fooSym0 where - suppressUnusedWarnings = snd ((,) US___fooSym0KindInference ()) - type US___fooSym1 :: Bool -> Bool - type family US___fooSym1 (a0123456789876543210 :: Bool) :: Bool where - US___fooSym1 a0123456789876543210 = US___foo a0123456789876543210 - type US___foo :: Bool -> Bool - type family US___foo (a :: Bool) :: Bool where - US___foo _ = TrueSym0 - ___sfoo :: - (forall (t :: Bool). - Sing t -> Sing (Apply US___fooSym0 t :: Bool) :: Type) - ___sfoo _ = STrue - instance SingI (US___fooSym0 :: (~>) Bool Bool) where - sing = singFun1 @US___fooSym0 ___sfoo +Singletons/T229.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| ___foo :: Bool -> Bool+ ___foo _ = True |]+ ======>+ ___foo :: Bool -> Bool+ ___foo _ = True+ type US___fooSym0 :: (~>) Bool Bool+ data US___fooSym0 :: (~>) Bool Bool+ where+ US___fooSym0KindInference :: SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) =>+ US___fooSym0 a0123456789876543210+ type instance Apply @Bool @Bool US___fooSym0 a0123456789876543210 = US___foo a0123456789876543210+ instance SuppressUnusedWarnings US___fooSym0 where+ suppressUnusedWarnings = snd ((,) US___fooSym0KindInference ())+ type US___fooSym1 :: Bool -> Bool+ type family US___fooSym1 (a0123456789876543210 :: Bool) :: Bool where+ US___fooSym1 a0123456789876543210 = US___foo a0123456789876543210+ type US___foo :: Bool -> Bool+ type family US___foo (a :: Bool) :: Bool where+ US___foo _ = TrueSym0+ ___sfoo ::+ (forall (t :: Bool). Sing t -> Sing (US___foo t :: Bool) :: Type)+ ___sfoo _ = STrue+ instance SingI (US___fooSym0 :: (~>) Bool Bool) where+ sing = singFun1 @US___fooSym0 ___sfoo
tests/compile-and-dump/Singletons/T229.hs view
@@ -1,6 +1,6 @@-module T229 where - -import Data.Singletons.Base.TH - -$(singletons [d| ___foo :: Bool -> Bool - ___foo _ = True |]) +module T229 where++import Data.Singletons.Base.TH++$(singletons [d| ___foo :: Bool -> Bool+ ___foo _ = True |])
tests/compile-and-dump/Singletons/T249.golden view
@@ -1,90 +1,93 @@-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 MkFoo1Sym0 :: forall a. (~>) a (Foo1 a) - data MkFoo1Sym0 :: (~>) a (Foo1 a) - where - MkFoo1Sym0KindInference :: SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => - MkFoo1Sym0 a0123456789876543210 - type instance Apply MkFoo1Sym0 a0123456789876543210 = MkFoo1 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo1Sym0 where - suppressUnusedWarnings = snd ((,) MkFoo1Sym0KindInference ()) - type MkFoo1Sym1 :: forall a. a -> Foo1 a - type family MkFoo1Sym1 (a0123456789876543210 :: a) :: Foo1 a where - MkFoo1Sym1 a0123456789876543210 = MkFoo1 a0123456789876543210 - type MkFoo2Sym0 :: (~>) x (Foo2 x) - data MkFoo2Sym0 :: (~>) x (Foo2 x) - where - MkFoo2Sym0KindInference :: SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => - MkFoo2Sym0 a0123456789876543210 - type instance Apply MkFoo2Sym0 a0123456789876543210 = MkFoo2 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo2Sym0 where - suppressUnusedWarnings = snd ((,) MkFoo2Sym0KindInference ()) - type MkFoo2Sym1 :: x -> Foo2 x - type family MkFoo2Sym1 (a0123456789876543210 :: x) :: Foo2 x where - MkFoo2Sym1 a0123456789876543210 = MkFoo2 a0123456789876543210 - type MkFoo3Sym0 :: forall x. (~>) x (Foo3 x) - data MkFoo3Sym0 :: (~>) x (Foo3 x) - where - MkFoo3Sym0KindInference :: SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => - MkFoo3Sym0 a0123456789876543210 - type instance Apply MkFoo3Sym0 a0123456789876543210 = MkFoo3 a0123456789876543210 - instance SuppressUnusedWarnings MkFoo3Sym0 where - suppressUnusedWarnings = snd ((,) MkFoo3Sym0KindInference ()) - type MkFoo3Sym1 :: forall x. x -> Foo3 x - type family MkFoo3Sym1 (a0123456789876543210 :: x) :: Foo3 x where - MkFoo3Sym1 a0123456789876543210 = MkFoo3 a0123456789876543210 - data SFoo1 :: forall a. Foo1 a -> Type - where - SMkFoo1 :: forall a (n :: a). - (Sing n) -> SFoo1 (MkFoo1 n :: Foo1 a) - type instance Sing @(Foo1 a) = SFoo1 - 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 SFoo2 :: forall a. Foo2 a -> Type - where - SMkFoo2 :: forall x (n :: x). - (Sing n) -> SFoo2 (MkFoo2 n :: Foo2 x) - type instance Sing @(Foo2 a) = SFoo2 - 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 SFoo3 :: forall a. Foo3 a -> Type - where - SMkFoo3 :: forall x (n :: x). - (Sing n) -> SFoo3 (MkFoo3 n :: Foo3 x) - type instance Sing @(Foo3 a) = SFoo3 - 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 SingI1 MkFoo1 where - liftSing = SMkFoo1 - instance SingI (MkFoo1Sym0 :: (~>) a (Foo1 a)) where - sing = singFun1 @MkFoo1Sym0 SMkFoo1 - instance SingI n => SingI (MkFoo2 (n :: x)) where - sing = SMkFoo2 sing - instance SingI1 MkFoo2 where - liftSing = SMkFoo2 - instance SingI (MkFoo2Sym0 :: (~>) x (Foo2 x)) where - sing = singFun1 @MkFoo2Sym0 SMkFoo2 - instance SingI n => SingI (MkFoo3 (n :: x)) where - sing = SMkFoo3 sing - instance SingI1 MkFoo3 where - liftSing = SMkFoo3 - instance SingI (MkFoo3Sym0 :: (~>) x (Foo3 x)) where - sing = singFun1 @MkFoo3Sym0 SMkFoo3 +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 MkFoo1Sym0 :: forall a. (~>) a (Foo1 a)+ data MkFoo1Sym0 :: (~>) a (Foo1 a)+ where+ MkFoo1Sym0KindInference :: SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) =>+ MkFoo1Sym0 a0123456789876543210+ type instance Apply @a @(Foo1 a) MkFoo1Sym0 a0123456789876543210 = MkFoo1 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo1Sym0 where+ suppressUnusedWarnings = snd ((,) MkFoo1Sym0KindInference ())+ type MkFoo1Sym1 :: forall a. a -> Foo1 a+ type family MkFoo1Sym1 @a (a0123456789876543210 :: a) :: Foo1 a where+ MkFoo1Sym1 a0123456789876543210 = MkFoo1 a0123456789876543210+ type MkFoo2Sym0 :: (~>) x (Foo2 x)+ data MkFoo2Sym0 :: (~>) x (Foo2 x)+ where+ MkFoo2Sym0KindInference :: SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) =>+ MkFoo2Sym0 a0123456789876543210+ type instance Apply @x @(Foo2 x) MkFoo2Sym0 a0123456789876543210 = MkFoo2 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo2Sym0 where+ suppressUnusedWarnings = snd ((,) MkFoo2Sym0KindInference ())+ type MkFoo2Sym1 :: x -> Foo2 x+ type family MkFoo2Sym1 @x (a0123456789876543210 :: x) :: Foo2 x where+ MkFoo2Sym1 a0123456789876543210 = MkFoo2 a0123456789876543210+ type MkFoo3Sym0 :: forall x. (~>) x (Foo3 x)+ data MkFoo3Sym0 :: (~>) x (Foo3 x)+ where+ MkFoo3Sym0KindInference :: SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>+ MkFoo3Sym0 a0123456789876543210+ type instance Apply @x @(Foo3 x) MkFoo3Sym0 a0123456789876543210 = MkFoo3 a0123456789876543210+ instance SuppressUnusedWarnings MkFoo3Sym0 where+ suppressUnusedWarnings = snd ((,) MkFoo3Sym0KindInference ())+ type MkFoo3Sym1 :: forall x. x -> Foo3 x+ type family MkFoo3Sym1 @x (a0123456789876543210 :: x) :: Foo3 x where+ MkFoo3Sym1 a0123456789876543210 = MkFoo3 a0123456789876543210+ data SFoo1 :: forall a. Foo1 a -> Type+ where+ SMkFoo1 :: forall a (n :: a).+ (Sing n) -> SFoo1 (MkFoo1 n :: Foo1 a)+ type instance Sing @(Foo1 a) = SFoo1+ 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))+ = (\cases (SomeSing c) -> SomeSing (SMkFoo1 c))+ (toSing b :: SomeSing a)+ data SFoo2 :: forall a. Foo2 a -> Type+ where+ SMkFoo2 :: forall x (n :: x).+ (Sing n) -> SFoo2 (MkFoo2 n :: Foo2 x)+ type instance Sing @(Foo2 a) = SFoo2+ 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))+ = (\cases (SomeSing c) -> SomeSing (SMkFoo2 c))+ (toSing b :: SomeSing x)+ data SFoo3 :: forall a. Foo3 a -> Type+ where+ SMkFoo3 :: forall x (n :: x).+ (Sing n) -> SFoo3 (MkFoo3 n :: Foo3 x)+ type instance Sing @(Foo3 a) = SFoo3+ 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))+ = (\cases (SomeSing c) -> SomeSing (SMkFoo3 c))+ (toSing b :: SomeSing x)+ instance SingI n => SingI (MkFoo1 (n :: a)) where+ sing = SMkFoo1 sing+ instance SingI1 MkFoo1 where+ liftSing = SMkFoo1+ instance SingI (MkFoo1Sym0 :: (~>) a (Foo1 a)) where+ sing = singFun1 @MkFoo1Sym0 SMkFoo1+ instance SingI n => SingI (MkFoo2 (n :: x)) where+ sing = SMkFoo2 sing+ instance SingI1 MkFoo2 where+ liftSing = SMkFoo2+ instance SingI (MkFoo2Sym0 :: (~>) x (Foo2 x)) where+ sing = singFun1 @MkFoo2Sym0 SMkFoo2+ instance SingI n => SingI (MkFoo3 (n :: x)) where+ sing = SMkFoo3 sing+ instance SingI1 MkFoo3 where+ liftSing = SMkFoo3+ instance SingI (MkFoo3Sym0 :: (~>) x (Foo3 x)) where+ sing = singFun1 @MkFoo3Sym0 SMkFoo3
tests/compile-and-dump/Singletons/T249.hs view
@@ -1,12 +1,12 @@-module T249 where - -import Data.Kind -import Data.Singletons.TH - -$(singletons - [d| data Foo1 a = MkFoo1 a - data Foo2 a where - MkFoo2 :: x -> Foo2 x - data Foo3 a where - MkFoo3 :: forall x. x -> Foo3 x - |]) +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.golden view
@@ -1,287 +1,182 @@-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 ConstantSym0 :: forall (a :: Type) - (b :: Type). (~>) a (Constant (a :: Type) (b :: Type)) - data ConstantSym0 :: (~>) a (Constant (a :: Type) (b :: Type)) - where - ConstantSym0KindInference :: SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => - ConstantSym0 a0123456789876543210 - type instance Apply ConstantSym0 a0123456789876543210 = Constant a0123456789876543210 - instance SuppressUnusedWarnings ConstantSym0 where - suppressUnusedWarnings = snd ((,) ConstantSym0KindInference ()) - type ConstantSym1 :: forall (a :: Type) (b :: Type). a - -> Constant (a :: Type) (b :: Type) - type family ConstantSym1 (a0123456789876543210 :: a) :: Constant (a :: Type) (b :: Type) where - ConstantSym1 a0123456789876543210 = Constant a0123456789876543210 - type IdentitySym0 :: (~>) a (Identity a) - data IdentitySym0 :: (~>) a (Identity a) - where - IdentitySym0KindInference :: SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => - IdentitySym0 a0123456789876543210 - type instance Apply IdentitySym0 a0123456789876543210 = Identity a0123456789876543210 - instance SuppressUnusedWarnings IdentitySym0 where - suppressUnusedWarnings = snd ((,) IdentitySym0KindInference ()) - type IdentitySym1 :: a -> Identity a - type family IdentitySym1 (a0123456789876543210 :: a) :: Identity a where - IdentitySym1 a0123456789876543210 = Identity a0123456789876543210 - type TFHelper_0123456789876543210 :: Constant a b - -> Constant a b -> Bool - type family TFHelper_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Bool where - TFHelper_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) (Constant a b) ((~>) (Constant a b) Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) (Constant a b) ((~>) (Constant a b) Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Constant a b - -> (~>) (Constant a b) Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Constant a b) :: (~>) (Constant a b) Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Constant a b - -> Constant a b -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Constant a b) (a0123456789876543210 :: Constant a b) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq (Constant a b) where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Constant a b - -> Constant a b -> Ordering - 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 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - type Compare_0123456789876543210Sym0 :: (~>) (Constant a b) ((~>) (Constant a b) Ordering) - data Compare_0123456789876543210Sym0 :: (~>) (Constant a b) ((~>) (Constant a b) Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Constant a b - -> (~>) (Constant a b) Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a b) :: (~>) (Constant a b) Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Constant a b - -> Constant a b -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a b) (a0123456789876543210 :: Constant a b) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd (Constant a b) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type TFHelper_0123456789876543210 :: Identity a - -> Identity a -> Bool - type family TFHelper_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Bool where - TFHelper_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210 - type TFHelper_0123456789876543210Sym0 :: (~>) (Identity a) ((~>) (Identity a) Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) (Identity a) ((~>) (Identity a) Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: Identity a - -> (~>) (Identity a) Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Identity a) :: (~>) (Identity a) Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: Identity a - -> Identity a -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Identity a) (a0123456789876543210 :: Identity a) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq (Identity a) where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: Identity a - -> Identity a -> Ordering - type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where - Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0) - type Compare_0123456789876543210Sym0 :: (~>) (Identity a) ((~>) (Identity a) Ordering) - data Compare_0123456789876543210Sym0 :: (~>) (Identity a) ((~>) (Identity a) Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: Identity a - -> (~>) (Identity a) Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a) :: (~>) (Identity a) Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: Identity a - -> Identity a -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a) (a0123456789876543210 :: Identity a) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd (Identity a) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - data SConstant :: forall (a :: Type) (b :: Type). - Constant a b -> Type - where - SConstant :: forall (a :: Type) (b :: Type) (n :: a). - (Sing n) -> - SConstant (Constant n :: Constant (a :: Type) (b :: Type)) - type instance Sing @(Constant a b) = SConstant - 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 SIdentity :: forall (a :: Type). Identity a -> Type - where - SIdentity :: forall a (n :: a). - (Sing n) -> SIdentity (Identity n :: Identity a) - type instance Sing @(Identity a) = SIdentity - 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 SEq a => SEq (Constant a b) where - (%==) :: - forall (t1 :: Constant a b) (t2 :: Constant a b). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun (Constant a b) ((~>) (Constant a b) Bool) - -> Type) t1) t2) - (%==) - (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210 - 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 @(<>@#@$) (%<>))) - SEQ) - (applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing - (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210) - sB_0123456789876543210)) - SNil) - instance SEq a => SEq (Identity a) where - (%==) :: - forall (t1 :: Identity a) (t2 :: Identity a). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun (Identity a) ((~>) (Identity a) Bool) - -> Type) t1) t2) - (%==) - (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210)) - (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210)) - = applySing - (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210) - sB_0123456789876543210 - 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 @(<>@#@$) (%<>))) - SEQ) - (applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing - (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210) - sB_0123456789876543210)) - SNil) - 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 SDecide a => - Data.Type.Equality.TestEquality (SConstant :: Constant a b - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide a => - Data.Type.Coercion.TestCoercion (SConstant :: Constant a b - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - 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 SDecide a => - Data.Type.Equality.TestEquality (SIdentity :: Identity a - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance SDecide a => - Data.Type.Coercion.TestCoercion (SIdentity :: Identity a - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - instance SingI n => SingI (Constant (n :: a)) where - sing = SConstant sing - instance SingI1 Constant where - liftSing = SConstant - instance SingI (ConstantSym0 :: (~>) a (Constant (a :: Type) (b :: Type))) where - sing = singFun1 @ConstantSym0 SConstant - instance SingI n => SingI (Identity (n :: a)) where - sing = SIdentity sing - instance SingI1 Identity where - liftSing = SIdentity - instance SingI (IdentitySym0 :: (~>) a (Identity a)) where - sing = singFun1 @IdentitySym0 SIdentity +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 ConstantSym0 :: forall (a :: Type)+ (b :: Type). (~>) a (Constant a b)+ data ConstantSym0 :: (~>) a (Constant a b)+ where+ ConstantSym0KindInference :: SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) =>+ ConstantSym0 a0123456789876543210+ type instance Apply @a @(Constant a b) ConstantSym0 a0123456789876543210 = Constant a0123456789876543210+ instance SuppressUnusedWarnings ConstantSym0 where+ suppressUnusedWarnings = snd ((,) ConstantSym0KindInference ())+ type ConstantSym1 :: forall (a :: Type) (b :: Type). a+ -> Constant a b+ type family ConstantSym1 @(a :: Type) @(b :: Type) (a0123456789876543210 :: a) :: Constant a b where+ ConstantSym1 a0123456789876543210 = Constant a0123456789876543210+ type IdentitySym0 :: (~>) a (Identity a)+ data IdentitySym0 :: (~>) a (Identity a)+ where+ IdentitySym0KindInference :: SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) =>+ IdentitySym0 a0123456789876543210+ type instance Apply @a @(Identity a) IdentitySym0 a0123456789876543210 = Identity a0123456789876543210+ instance SuppressUnusedWarnings IdentitySym0 where+ suppressUnusedWarnings = snd ((,) IdentitySym0KindInference ())+ type IdentitySym1 :: a -> Identity a+ type family IdentitySym1 @a (a0123456789876543210 :: a) :: Identity a where+ IdentitySym1 a0123456789876543210 = Identity a0123456789876543210+ type TFHelper_0123456789876543210 :: forall a b. Constant a b+ -> Constant a b -> Bool+ type family TFHelper_0123456789876543210 @a @b (a :: Constant a b) (a :: Constant a b) :: Bool where+ TFHelper_0123456789876543210 @a @b (Constant a_0123456789876543210 :: Constant a b) (Constant b_0123456789876543210 :: Constant a b) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq (Constant a b) where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: forall a b. Constant a b+ -> Constant a b -> Ordering+ type family Compare_0123456789876543210 @a @b (a :: Constant a b) (a :: Constant a b) :: Ordering where+ Compare_0123456789876543210 @a @b (Constant a_0123456789876543210 :: Constant a b) (Constant b_0123456789876543210 :: Constant a b) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ instance POrd (Constant a b) where+ type Compare a a = Compare_0123456789876543210 a a+ type TFHelper_0123456789876543210 :: forall a. Identity a+ -> Identity a -> Bool+ type family TFHelper_0123456789876543210 @a (a :: Identity a) (a :: Identity a) :: Bool where+ TFHelper_0123456789876543210 @a (Identity a_0123456789876543210 :: Identity a) (Identity b_0123456789876543210 :: Identity a) = Apply (Apply (==@#@$) a_0123456789876543210) b_0123456789876543210+ instance PEq (Identity a) where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: forall a. Identity a+ -> Identity a -> Ordering+ type family Compare_0123456789876543210 @a (a :: Identity a) (a :: Identity a) :: Ordering where+ Compare_0123456789876543210 @a (Identity a_0123456789876543210 :: Identity a) (Identity b_0123456789876543210 :: Identity a) = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) NilSym0)+ instance POrd (Identity a) where+ type Compare a a = Compare_0123456789876543210 a a+ data SConstant :: forall (a :: Type) (b :: Type).+ Constant a b -> Type+ where+ SConstant :: forall (a :: Type) (b :: Type) (n :: a).+ (Sing n) -> SConstant (Constant n :: Constant a b)+ type instance Sing @(Constant a b) = SConstant+ 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))+ = (\cases (SomeSing c) -> SomeSing (SConstant c))+ (toSing b :: SomeSing a)+ data SIdentity :: forall (a :: Type). Identity a -> Type+ where+ SIdentity :: forall a (n :: a).+ (Sing n) -> SIdentity (Identity n :: Identity a)+ type instance Sing @(Identity a) = SIdentity+ 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))+ = (\cases (SomeSing c) -> SomeSing (SIdentity c))+ (toSing b :: SomeSing a)+ instance SEq a => SEq (Constant a b) where+ (%==)+ (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SOrd a => SOrd (Constant a b) where+ sCompare+ (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ (applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing+ (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210)+ sB_0123456789876543210))+ SNil)+ instance SEq a => SEq (Identity a) where+ (%==)+ (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing (singFun2 @(==@#@$) (%==)) sA_0123456789876543210)+ sB_0123456789876543210+ instance SOrd a => SOrd (Identity a) where+ sCompare+ (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210))+ (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210))+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ (applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing+ (applySing (singFun2 @CompareSym0 sCompare) sA_0123456789876543210)+ sB_0123456789876543210))+ SNil)+ instance SDecide a => SDecide (Constant a b) where+ (%~) (SConstant a) (SConstant b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SConstant (z :: Constant a b)) where+ (==) _ _ = True+ instance SDecide a =>+ GHC.Internal.Data.Type.Equality.TestEquality (SConstant :: Constant a b+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide a =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SConstant :: Constant a b+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance SDecide a => SDecide (Identity a) where+ (%~) (SIdentity a) (SIdentity b)+ = (\cases+ (Proved Refl) -> Proved Refl+ (Disproved contra) -> Disproved (\cases Refl -> contra Refl))+ ((%~) a b)+ instance Eq (SIdentity (z :: Identity a)) where+ (==) _ _ = True+ instance SDecide a =>+ GHC.Internal.Data.Type.Equality.TestEquality (SIdentity :: Identity a+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance SDecide a =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SIdentity :: Identity a+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SConstant (z :: Constant a b)) where+ compare _ _ = EQ+ instance Ord (SIdentity (z :: Identity a)) where+ compare _ _ = EQ+ instance SingI n => SingI (Constant (n :: a)) where+ sing = SConstant sing+ instance SingI1 Constant where+ liftSing = SConstant+ instance SingI (ConstantSym0 :: (~>) a (Constant a b)) where+ sing = singFun1 @ConstantSym0 SConstant+ instance SingI n => SingI (Identity (n :: a)) where+ sing = SIdentity sing+ instance SingI1 Identity where+ liftSing = SIdentity+ instance SingI (IdentitySym0 :: (~>) a (Identity a)) where+ sing = singFun1 @IdentitySym0 SIdentity
tests/compile-and-dump/Singletons/T271.hs view
@@ -1,13 +1,13 @@-module T271 where - -import Data.Kind (Type) -import Data.Singletons.Base.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) - |]) +module T271 where++import Data.Kind (Type)+import Data.Singletons.Base.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.golden view
@@ -1,118 +1,72 @@-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 (<<>>@#@$) :: forall a. (~>) a ((~>) a a) - data (<<>>@#@$) :: (~>) a ((~>) a a) - where - (:<<>>@#@$###) :: SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) => - (<<>>@#@$) a0123456789876543210 - type instance Apply (<<>>@#@$) a0123456789876543210 = (<<>>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<<>>@#@$) where - suppressUnusedWarnings = snd ((,) (:<<>>@#@$###) ()) - type (<<>>@#@$$) :: forall a. a -> (~>) a a - data (<<>>@#@$$) (a0123456789876543210 :: a) :: (~>) a a - where - (:<<>>@#@$$###) :: SameKind (Apply ((<<>>@#@$$) a0123456789876543210) arg) ((<<>>@#@$$$) a0123456789876543210 arg) => - (<<>>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<<>>@#@$$) a0123456789876543210) a0123456789876543210 = (<<>>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<>>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<<>>@#@$$###) ()) - type (<<>>@#@$$$) :: forall a. a -> a -> a - type family (<<>>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where - (<<>>@#@$$$) a0123456789876543210 a0123456789876543210 = (<<>>) a0123456789876543210 a0123456789876543210 - class PS a where - type family (<<>>) (arg :: a) (arg :: a) :: a - type family Lambda_0123456789876543210 f g x where - Lambda_0123456789876543210 f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x) - data Lambda_0123456789876543210Sym0 f0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 f0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 f0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym2KindInference ()) - type family Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 x0123456789876543210 - type TFHelper_0123456789876543210 :: (~>) a b - -> (~>) a b -> (~>) a b - 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_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) ((~>) a b) ((~>) a b)) - data TFHelper_0123456789876543210Sym0 :: (~>) ((~>) a b) ((~>) ((~>) a b) ((~>) a b)) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: (~>) a b - -> (~>) ((~>) a b) ((~>) a b) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a b) :: (~>) ((~>) a b) ((~>) a b) - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: (~>) a b - -> (~>) a b -> (~>) a b - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a b) (a0123456789876543210 :: (~>) a b) :: (~>) a b where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 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) :: Type) - 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) :: Type) - (%<<>>) (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)) - instance SS a => SingI1 ((<<>>@#@$$) :: a -> (~>) a a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((<<>>@#@$$) (d :: a)) ((%<<>>) s) +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 (<<>>@#@$) :: forall a. (~>) a ((~>) a a)+ data (<<>>@#@$) :: (~>) a ((~>) a a)+ where+ (:<<>>@#@$###) :: SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) =>+ (<<>>@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (<<>>@#@$) a0123456789876543210 = (<<>>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<<>>@#@$) where+ suppressUnusedWarnings = snd ((,) (:<<>>@#@$###) ())+ type (<<>>@#@$$) :: forall a. a -> (~>) a a+ data (<<>>@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:<<>>@#@$$###) :: SameKind (Apply ((<<>>@#@$$) a0123456789876543210) arg) ((<<>>@#@$$$) a0123456789876543210 arg) =>+ (<<>>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((<<>>@#@$$) a0123456789876543210) a0123456789876543210 = (<<>>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<<>>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<<>>@#@$$###) ())+ type (<<>>@#@$$$) :: forall a. a -> a -> a+ type family (<<>>@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (<<>>@#@$$$) a0123456789876543210 a0123456789876543210 = (<<>>) a0123456789876543210 a0123456789876543210+ class PS a where+ type family (<<>>) (arg :: a) (arg :: a) :: a+ type family LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (g0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a b f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x)+ data LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (g0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (g0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 b0123456789876543210 f0123456789876543210 g0123456789876543210 a_01234567898765432100123456789876543210+ type TFHelper_0123456789876543210 :: forall a b. (~>) a b+ -> (~>) a b -> (~>) a b+ type family TFHelper_0123456789876543210 @a @b (a :: (~>) a b) (a :: (~>) a b) :: (~>) a b where+ TFHelper_0123456789876543210 @a @b (f :: (~>) a b) (g :: (~>) a b) = LamCases_0123456789876543210Sym0 a b f g+ instance PS ((~>) a b) where+ type (<<>>) a a = TFHelper_0123456789876543210 a a+ class SS a where+ (%<<>>) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((<<>>) t t :: a) :: Type)+ instance SS b => SS ((~>) a b) where+ (%<<>>) (sF :: Sing f) (sG :: Sing g)+ = singFun1+ @(LamCases_0123456789876543210Sym0 a b f g)+ (\cases+ (sX :: 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))+ instance SS a => SingI1 ((<<>>@#@$$) :: a -> (~>) a a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((<<>>@#@$$) (d :: a)) ((%<<>>) s)
tests/compile-and-dump/Singletons/T287.hs view
@@ -1,11 +1,11 @@-module T287 where - -import Data.Singletons.TH - -$(singletons [d| - class S a where - (<<>>) :: a -> a -> a - - instance S b => S (a -> b) where - f <<>> g = \x -> f x <<>> g x - |]) +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.golden view
@@ -1,121 +1,117 @@-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 BanSym0 :: (~>) Bool Bool - data BanSym0 :: (~>) Bool Bool - where - BanSym0KindInference :: SameKind (Apply BanSym0 arg) (BanSym1 arg) => - BanSym0 a0123456789876543210 - type instance Apply BanSym0 a0123456789876543210 = Ban a0123456789876543210 - instance SuppressUnusedWarnings BanSym0 where - suppressUnusedWarnings = snd ((,) BanSym0KindInference ()) - type BanSym1 :: Bool -> Bool - type family BanSym1 (a0123456789876543210 :: Bool) :: Bool where - BanSym1 a0123456789876543210 = Ban a0123456789876543210 - type BazSym0 :: (~>) Bool Bool - data BazSym0 :: (~>) Bool Bool - where - BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0 a0123456789876543210 - type instance Apply BazSym0 a0123456789876543210 = Baz a0123456789876543210 - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings = snd ((,) BazSym0KindInference ()) - type BazSym1 :: Bool -> Bool - type family BazSym1 (a0123456789876543210 :: Bool) :: Bool where - BazSym1 a0123456789876543210 = Baz a0123456789876543210 - type BarSym0 :: (~>) Bool Bool - data BarSym0 :: (~>) Bool Bool - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: Bool -> Bool - type family BarSym1 (a0123456789876543210 :: Bool) :: Bool where - BarSym1 a0123456789876543210 = Bar a0123456789876543210 - type FooSym0 :: (~>) Bool Bool - data FooSym0 :: (~>) Bool Bool - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: Bool -> Bool - type family FooSym1 (a0123456789876543210 :: Bool) :: Bool where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Ban :: Bool -> Bool - type family Ban (a :: Bool) :: Bool where - Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x - type Baz :: Bool -> Bool - type family Baz (a :: Bool) :: Bool where - Baz x = Apply (Apply ($!@#@$) NotSym0) x - type Bar :: Bool -> Bool - type family Bar (a :: Bool) :: Bool where - Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x - type Foo :: Bool -> Bool - type family Foo (a :: Bool) :: Bool where - Foo x = Apply (Apply ($@#@$) NotSym0) x - sBan :: - (forall (t :: Bool). - Sing t -> Sing (Apply BanSym0 t :: Bool) :: Type) - sBaz :: - (forall (t :: Bool). - Sing t -> Sing (Apply BazSym0 t :: Bool) :: Type) - sBar :: - (forall (t :: Bool). - Sing t -> Sing (Apply BarSym0 t :: Bool) :: Type) - sFoo :: - (forall (t :: Bool). - Sing t -> Sing (Apply FooSym0 t :: Bool) :: Type) - 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 +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 BanSym0 :: (~>) Bool Bool+ data BanSym0 :: (~>) Bool Bool+ where+ BanSym0KindInference :: SameKind (Apply BanSym0 arg) (BanSym1 arg) =>+ BanSym0 a0123456789876543210+ type instance Apply @Bool @Bool BanSym0 a0123456789876543210 = Ban a0123456789876543210+ instance SuppressUnusedWarnings BanSym0 where+ suppressUnusedWarnings = snd ((,) BanSym0KindInference ())+ type BanSym1 :: Bool -> Bool+ type family BanSym1 (a0123456789876543210 :: Bool) :: Bool where+ BanSym1 a0123456789876543210 = Ban a0123456789876543210+ type BazSym0 :: (~>) Bool Bool+ data BazSym0 :: (~>) Bool Bool+ where+ BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) =>+ BazSym0 a0123456789876543210+ type instance Apply @Bool @Bool BazSym0 a0123456789876543210 = Baz a0123456789876543210+ instance SuppressUnusedWarnings BazSym0 where+ suppressUnusedWarnings = snd ((,) BazSym0KindInference ())+ type BazSym1 :: Bool -> Bool+ type family BazSym1 (a0123456789876543210 :: Bool) :: Bool where+ BazSym1 a0123456789876543210 = Baz a0123456789876543210+ type BarSym0 :: (~>) Bool Bool+ data BarSym0 :: (~>) Bool Bool+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @Bool @Bool BarSym0 a0123456789876543210 = Bar a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: Bool -> Bool+ type family BarSym1 (a0123456789876543210 :: Bool) :: Bool where+ BarSym1 a0123456789876543210 = Bar a0123456789876543210+ type FooSym0 :: (~>) Bool Bool+ data FooSym0 :: (~>) Bool Bool+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @Bool @Bool FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: Bool -> Bool+ type family FooSym1 (a0123456789876543210 :: Bool) :: Bool where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Ban :: Bool -> Bool+ type family Ban (a :: Bool) :: Bool where+ Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x+ type Baz :: Bool -> Bool+ type family Baz (a :: Bool) :: Bool where+ Baz x = Apply (Apply ($!@#@$) NotSym0) x+ type Bar :: Bool -> Bool+ type family Bar (a :: Bool) :: Bool where+ Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x+ type Foo :: Bool -> Bool+ type family Foo (a :: Bool) :: Bool where+ Foo x = Apply (Apply ($@#@$) NotSym0) x+ sBan ::+ (forall (t :: Bool). Sing t -> Sing (Ban t :: Bool) :: Type)+ sBaz ::+ (forall (t :: Bool). Sing t -> Sing (Baz t :: Bool) :: Type)+ sBar ::+ (forall (t :: Bool). Sing t -> Sing (Bar t :: Bool) :: Type)+ sFoo ::+ (forall (t :: Bool). Sing t -> Sing (Foo t :: Bool) :: Type)+ 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 view
@@ -1,44 +1,44 @@-module Singletons.T29 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(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 +module Singletons.T29 where++import Data.Singletons.TH+import Prelude.Singletons++$(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/T296.golden view
@@ -1,74 +1,69 @@-Singletons/T296.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| f :: forall a. MyProxy a -> MyProxy a - 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 :: forall a. MyProxy a -> MyProxy a - f MyProxy - = let - x = let - z :: MyProxy a - z = MyProxy - in z - in x - type MyProxySym0 :: forall (a :: Type). MyProxy (a :: Type) - type family MyProxySym0 :: MyProxy (a :: Type) where - MyProxySym0 = MyProxy - type Let0123456789876543210ZSym0 :: MyProxy a - type family Let0123456789876543210ZSym0 :: MyProxy a where - Let0123456789876543210ZSym0 = Let0123456789876543210Z - type Let0123456789876543210Z :: MyProxy a - type family Let0123456789876543210Z :: MyProxy a where - Let0123456789876543210Z = MyProxySym0 - type family Let0123456789876543210XSym0 where - Let0123456789876543210XSym0 = Let0123456789876543210X - type family Let0123456789876543210X where - Let0123456789876543210X = Let0123456789876543210ZSym0 - type FSym0 :: forall a. (~>) (MyProxy a) (MyProxy a) - data FSym0 :: (~>) (MyProxy a) (MyProxy a) - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: forall a. MyProxy a -> MyProxy a - type family FSym1 (a0123456789876543210 :: MyProxy a) :: MyProxy a where - FSym1 a0123456789876543210 = F a0123456789876543210 - type F :: forall a. MyProxy a -> MyProxy a - type family F (a :: MyProxy a) :: MyProxy a where - F MyProxy = Let0123456789876543210XSym0 - sF :: - forall a (t :: MyProxy a). Sing t - -> Sing (Apply FSym0 t :: MyProxy a) - sF SMyProxy - = let - sX :: Sing @_ Let0123456789876543210XSym0 - sX - = let - sZ :: (Sing (Let0123456789876543210ZSym0 :: MyProxy a) :: Type) - sZ = SMyProxy - in sZ - in sX - instance SingI (FSym0 :: (~>) (MyProxy a) (MyProxy a)) where - sing = singFun1 @FSym0 sF - data SMyProxy :: forall (a :: Type). MyProxy a -> Type - where - SMyProxy :: forall (a :: Type). - SMyProxy (MyProxy :: MyProxy (a :: Type)) - type instance Sing @(MyProxy a) = SMyProxy - 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 +Singletons/T296.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| f :: forall a. MyProxy a -> MyProxy a+ 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 :: forall a. MyProxy a -> MyProxy a+ f MyProxy+ = let+ x = let+ z :: MyProxy a+ z = MyProxy+ in z+ in x+ type MyProxySym0 :: forall (a :: Type). MyProxy a+ type family MyProxySym0 @(a :: Type) :: MyProxy a where+ MyProxySym0 = MyProxy+ type family Let0123456789876543210ZSym0 a0123456789876543210 :: MyProxy a0123456789876543210 where+ Let0123456789876543210ZSym0 a0123456789876543210 = Let0123456789876543210Z a0123456789876543210+ type family Let0123456789876543210Z a0123456789876543210 :: MyProxy a0123456789876543210 where+ Let0123456789876543210Z a = MyProxySym0+ type family Let0123456789876543210XSym0 a0123456789876543210 where+ Let0123456789876543210XSym0 a0123456789876543210 = Let0123456789876543210X a0123456789876543210+ type family Let0123456789876543210X a0123456789876543210 where+ Let0123456789876543210X a = Let0123456789876543210ZSym0 a+ type FSym0 :: forall a. (~>) (MyProxy a) (MyProxy a)+ data FSym0 :: (~>) (MyProxy a) (MyProxy a)+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @(MyProxy a) @(MyProxy a) FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: forall a. MyProxy a -> MyProxy a+ type family FSym1 @a (a0123456789876543210 :: MyProxy a) :: MyProxy a where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type F :: forall a. MyProxy a -> MyProxy a+ type family F @a (a :: MyProxy a) :: MyProxy a where+ F @a (MyProxy :: MyProxy a) = Let0123456789876543210XSym0 a+ sF :: forall a (t :: MyProxy a). Sing t -> Sing (F t :: MyProxy a)+ sF SMyProxy+ = let+ sX :: Sing @_ (Let0123456789876543210X a)+ sX+ = let+ sZ :: (Sing (Let0123456789876543210Z a :: MyProxy a) :: Type)+ sZ = SMyProxy+ in sZ+ in sX+ instance SingI (FSym0 :: (~>) (MyProxy a) (MyProxy a)) where+ sing = singFun1 @FSym0 sF+ data SMyProxy :: forall (a :: Type). MyProxy a -> Type+ where+ SMyProxy :: forall (a :: Type). SMyProxy (MyProxy :: MyProxy a)+ type instance Sing @(MyProxy a) = SMyProxy+ 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/T296.hs view
@@ -1,14 +1,14 @@-module T296 where - -import Data.Kind -import Data.Singletons.TH - -$(singletons [d| - data MyProxy (a :: Type) = MyProxy - - f :: forall a. MyProxy a -> MyProxy a - f MyProxy = - let x = let z :: MyProxy a - z = MyProxy in z - in x - |]) +module T296 where++import Data.Kind+import Data.Singletons.TH++$(singletons [d|+ data MyProxy (a :: Type) = MyProxy++ f :: forall a. MyProxy a -> MyProxy a+ f MyProxy =+ let x = let z :: MyProxy a+ z = MyProxy in z+ in x+ |])
tests/compile-and-dump/Singletons/T297.golden view
@@ -1,67 +1,66 @@-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 :: forall (a :: Type). MyProxy (a :: Type) - type family MyProxySym0 :: MyProxy (a :: Type) where - MyProxySym0 = MyProxy - type Let0123456789876543210ZSym0 :: MyProxy a - type family Let0123456789876543210ZSym0 :: MyProxy a where - Let0123456789876543210ZSym0 = Let0123456789876543210Z - type Let0123456789876543210Z :: MyProxy a - type family Let0123456789876543210Z :: MyProxy a where - Let0123456789876543210Z = MyProxySym0 - type family Let0123456789876543210XSym0 where - Let0123456789876543210XSym0 = Let0123456789876543210X - type family Let0123456789876543210X where - Let0123456789876543210X = Let0123456789876543210ZSym0 - data FSym0 a0123456789876543210 - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type family FSym1 a0123456789876543210 where - FSym1 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 :: (Sing (Let0123456789876543210ZSym0 :: MyProxy a) :: Type) - sZ = SMyProxy - in sZ - in sX - instance SingI FSym0 where - sing = singFun1 @FSym0 sF - data SMyProxy :: forall (a :: Type). MyProxy a -> Type - where - SMyProxy :: forall (a :: Type). - SMyProxy (MyProxy :: MyProxy (a :: Type)) - type instance Sing @(MyProxy a) = SMyProxy - 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 +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 :: forall (a :: Type). MyProxy a+ type family MyProxySym0 @(a :: Type) :: MyProxy a where+ MyProxySym0 = MyProxy+ type Let0123456789876543210ZSym0 :: MyProxy a+ type family Let0123456789876543210ZSym0 @a :: MyProxy a where+ Let0123456789876543210ZSym0 = Let0123456789876543210Z+ type Let0123456789876543210Z :: MyProxy a+ type family Let0123456789876543210Z @a :: MyProxy a where+ Let0123456789876543210Z = MyProxySym0+ type family Let0123456789876543210XSym0 where+ Let0123456789876543210XSym0 = Let0123456789876543210X+ type family Let0123456789876543210X where+ Let0123456789876543210X = Let0123456789876543210ZSym0+ data FSym0 a0123456789876543210+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @_ @_ FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type family FSym1 a0123456789876543210 where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type family F a where+ F MyProxy = Let0123456789876543210XSym0+ sF :: forall arg. Sing arg -> Sing (F arg)+ sF SMyProxy+ = let+ sX :: Sing @_ Let0123456789876543210X+ sX+ = let+ sZ :: (Sing (Let0123456789876543210Z :: MyProxy a) :: Type)+ sZ = SMyProxy+ in sZ+ in sX+ instance SingI FSym0 where+ sing = singFun1 @FSym0 sF+ data SMyProxy :: forall (a :: Type). MyProxy a -> Type+ where+ SMyProxy :: forall (a :: Type). SMyProxy (MyProxy :: MyProxy a)+ type instance Sing @(MyProxy a) = SMyProxy+ 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 view
@@ -1,13 +1,13 @@-module T297 where - -import Data.Kind -import Data.Singletons.TH - -$(singletons [d| - data MyProxy (a :: Type) = MyProxy - - f MyProxy = - let x = let z :: MyProxy a -- When singled, this `a` should be explicitly quantified - z = MyProxy in z - in x - |]) +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.golden view
@@ -1,199 +1,138 @@-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 BarSym0 :: forall a b. (~>) a ((~>) b b) - data BarSym0 :: (~>) a ((~>) b b) - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: forall a b. a -> (~>) b b - data BarSym1 (a0123456789876543210 :: a) :: (~>) b b - where - BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) => - BarSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym1 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BarSym1KindInference ()) - type BarSym2 :: forall a b. a -> b -> b - type family BarSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - BarSym2 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 - type BazSym0 :: forall a b. (~>) a ((~>) b b) - data BazSym0 :: (~>) a ((~>) b b) - where - BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0 a0123456789876543210 - type instance Apply BazSym0 a0123456789876543210 = BazSym1 a0123456789876543210 - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings = snd ((,) BazSym0KindInference ()) - type BazSym1 :: forall a b. a -> (~>) b b - data BazSym1 (a0123456789876543210 :: a) :: (~>) b b - where - BazSym1KindInference :: SameKind (Apply (BazSym1 a0123456789876543210) arg) (BazSym2 a0123456789876543210 arg) => - BazSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BazSym1 a0123456789876543210) a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BazSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) BazSym1KindInference ()) - type BazSym2 :: forall a b. a -> b -> b - type family BazSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - BazSym2 a0123456789876543210 a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210 - type Bar_0123456789876543210 :: a -> b -> b - type family Bar_0123456789876543210 (a :: a) (a :: b) :: b where - Bar_0123456789876543210 _ x = x - type Bar_0123456789876543210Sym0 :: (~>) a ((~>) b b) - data Bar_0123456789876543210Sym0 :: (~>) a ((~>) b b) - where - Bar_0123456789876543210Sym0KindInference :: SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) => - Bar_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Bar_0123456789876543210Sym0KindInference ()) - type Bar_0123456789876543210Sym1 :: a -> (~>) b b - data Bar_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) b b - where - Bar_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Bar_0123456789876543210Sym1KindInference ()) - type Bar_0123456789876543210Sym2 :: a -> b -> b - type family Bar_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - Bar_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 - data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 - where - Let0123456789876543210HSym0KindInference :: SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) => - Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210HSym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210HSym0KindInference ()) - data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Let0123456789876543210HSym1KindInference :: 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 (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210HSym1KindInference ()) - data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) - where - Let0123456789876543210HSym2KindInference :: 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 (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210HSym2KindInference ()) - data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: (~>) b0123456789876543210 b0123456789876543210 - where - Let0123456789876543210HSym3KindInference :: 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 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210HSym3KindInference ()) - type family Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: b0123456789876543210 where - Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 = Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 - type family Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 (a :: c) (a :: b) :: b where - Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 _ x = x - type Baz_0123456789876543210 :: a -> b -> b - 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_0123456789876543210Sym0 :: (~>) a ((~>) b b) - data Baz_0123456789876543210Sym0 :: (~>) a ((~>) b b) - where - Baz_0123456789876543210Sym0KindInference :: SameKind (Apply Baz_0123456789876543210Sym0 arg) (Baz_0123456789876543210Sym1 arg) => - Baz_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Baz_0123456789876543210Sym0 a0123456789876543210 = Baz_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Baz_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Baz_0123456789876543210Sym0KindInference ()) - type Baz_0123456789876543210Sym1 :: a -> (~>) b b - data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a) :: (~>) b b - where - Baz_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Baz_0123456789876543210Sym1KindInference ()) - type Baz_0123456789876543210Sym2 :: a -> b -> b - type family Baz_0123456789876543210Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where - Baz_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 - class PFoo a where - type family Bar (arg :: a) (arg :: b) :: b - type family 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 (t :: a) (t :: b). - Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b) :: Type) - sBaz :: - forall b (t :: a) (t :: b). Sing t - -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b) - default sBar :: - (forall (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) :: Type) - 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 => SingI1 (BarSym1 :: a -> (~>) b b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(BarSym1 (d :: a)) (sBar s) - 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)) - instance SFoo a => SingI1 (BazSym1 :: a -> (~>) b b) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(BazSym1 (d :: a)) (sBaz s) +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 BarSym0 :: forall a b. (~>) a ((~>) b b)+ data BarSym0 :: (~>) a ((~>) b b)+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @a @((~>) b b) BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: forall a b. a -> (~>) b b+ data BarSym1 (a0123456789876543210 :: a) :: (~>) b b+ where+ BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) =>+ BarSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @b (BarSym1 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym1KindInference ())+ type BarSym2 :: forall a b. a -> b -> b+ type family BarSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where+ BarSym2 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ type BazSym0 :: forall a b. (~>) a ((~>) b b)+ data BazSym0 :: (~>) a ((~>) b b)+ where+ BazSym0KindInference :: SameKind (Apply BazSym0 arg) (BazSym1 arg) =>+ BazSym0 a0123456789876543210+ type instance Apply @a @((~>) b b) BazSym0 a0123456789876543210 = BazSym1 a0123456789876543210+ instance SuppressUnusedWarnings BazSym0 where+ suppressUnusedWarnings = snd ((,) BazSym0KindInference ())+ type BazSym1 :: forall a b. a -> (~>) b b+ data BazSym1 (a0123456789876543210 :: a) :: (~>) b b+ where+ BazSym1KindInference :: SameKind (Apply (BazSym1 a0123456789876543210) arg) (BazSym2 a0123456789876543210 arg) =>+ BazSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @b (BazSym1 a0123456789876543210) a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BazSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BazSym1KindInference ())+ type BazSym2 :: forall a b. a -> b -> b+ type family BazSym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: b where+ BazSym2 a0123456789876543210 a0123456789876543210 = Baz a0123456789876543210 a0123456789876543210+ type Bar_0123456789876543210 :: forall a b. a -> b -> b+ type family Bar_0123456789876543210 @a @b (a :: a) (a :: b) :: b where+ Bar_0123456789876543210 @a @b (_ :: a) (x :: b) = x+ data Let0123456789876543210HSym0 a0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) :: (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)+ where+ Let0123456789876543210HSym0KindInference :: SameKind (Apply (Let0123456789876543210HSym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) =>+ Let0123456789876543210HSym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210+ type instance Apply @c0123456789876543210 @((~>) b0123456789876543210 b0123456789876543210) (Let0123456789876543210HSym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210HSym0 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210HSym0KindInference ())+ data Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) :: (~>) b0123456789876543210 b0123456789876543210+ where+ Let0123456789876543210HSym1KindInference :: SameKind (Apply (Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym2 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) =>+ Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @b0123456789876543210 @b0123456789876543210 (Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210H a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210HSym1KindInference ())+ type family Let0123456789876543210HSym2 a0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: b0123456789876543210 where+ Let0123456789876543210HSym2 a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 = Let0123456789876543210H a0123456789876543210 b0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210+ type family Let0123456789876543210H a0123456789876543210 b0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) (a_01234567898765432100123456789876543210 :: b0123456789876543210) (a :: c) (a :: b0123456789876543210) :: b0123456789876543210 where+ Let0123456789876543210H a b a_0123456789876543210 a_0123456789876543210 (_ :: c) (x :: b) = x+ type Baz_0123456789876543210 :: forall a b. a -> b -> b+ type family Baz_0123456789876543210 @a @b (a :: a) (a :: b) :: b where+ Baz_0123456789876543210 @a @b (a_0123456789876543210 :: a) (a_0123456789876543210 :: b) = Apply (Apply (Let0123456789876543210HSym0 a b a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210+ class PFoo a where+ type family Bar (arg :: a) (arg :: b) :: b+ type family Baz (arg :: a) (arg :: b) :: b+ type Bar a a = Bar_0123456789876543210 a a+ type Baz a a = Baz_0123456789876543210 a a+ class SFoo a where+ sBar ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Bar t t :: b) :: Type)+ sBaz ::+ forall b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Baz t t :: b)+ default sBar ::+ (forall (t :: a) (t :: b).+ ((Bar t t :: b) ~ Bar_0123456789876543210 t t) =>+ Sing t -> Sing t -> Sing (Bar t t :: b) :: Type)+ default sBaz ::+ forall b (t :: a) (t :: b). ((Baz t t :: b)+ ~ Baz_0123456789876543210 t t) =>+ Sing t -> Sing t -> Sing (Baz 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 (Let0123456789876543210H a b a_0123456789876543210 a_0123456789876543210 t t :: b)+ sH _ (sX :: Sing x) = sX+ in+ singFun2+ @(Let0123456789876543210HSym0 a b 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 => SingI1 (BarSym1 :: a -> (~>) b b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(BarSym1 (d :: a)) (sBar s)+ 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))+ instance SFoo a => SingI1 (BazSym1 :: a -> (~>) b b) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(BazSym1 (d :: a)) (sBaz s)
tests/compile-and-dump/Singletons/T312.hs view
@@ -1,14 +1,14 @@-module T312 where - -import Data.Singletons.TH - -$(singletons [d| - class Foo a where - bar :: a -> b -> b - bar _ x = x - - baz :: forall b. a -> b -> b - baz = h where - h :: forall c. c -> b -> b - h _ x = x - |]) +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.golden view
@@ -1,126 +1,126 @@-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 family PFoo4 a - type PFoo4 a = Maybe a - instance PC a where - type PFoo4 a = Maybe a - data PFoo1Sym0 a0123456789876543210 - where - PFoo1Sym0KindInference :: SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) => - PFoo1Sym0 a0123456789876543210 - type instance Apply PFoo1Sym0 a0123456789876543210 = PFoo1 a0123456789876543210 - instance SuppressUnusedWarnings PFoo1Sym0 where - suppressUnusedWarnings = snd ((,) PFoo1Sym0KindInference ()) - type family PFoo1Sym1 a0123456789876543210 where - PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210 - data PFoo3Sym0 a0123456789876543210 - where - PFoo3Sym0KindInference :: SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) => - PFoo3Sym0 a0123456789876543210 - type instance Apply PFoo3Sym0 a0123456789876543210 = PFoo3 a0123456789876543210 - instance SuppressUnusedWarnings PFoo3Sym0 where - suppressUnusedWarnings = snd ((,) PFoo3Sym0KindInference ()) - type family PFoo3Sym1 a0123456789876543210 where - PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210 - data PFoo2Sym0 :: (~>) Type Type - where - PFoo2Sym0KindInference :: SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) => - PFoo2Sym0 a0123456789876543210 - type instance Apply PFoo2Sym0 a0123456789876543210 = PFoo2 a0123456789876543210 - instance SuppressUnusedWarnings PFoo2Sym0 where - suppressUnusedWarnings = snd ((,) PFoo2Sym0KindInference ()) - type family PFoo2Sym1 (a0123456789876543210 :: Type) :: Type where - PFoo2Sym1 a0123456789876543210 = PFoo2 a0123456789876543210 - data PFoo4Sym0 a0123456789876543210 - where - PFoo4Sym0KindInference :: SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) => - PFoo4Sym0 a0123456789876543210 - type instance Apply PFoo4Sym0 a0123456789876543210 = PFoo4 a0123456789876543210 - instance SuppressUnusedWarnings PFoo4Sym0 where - suppressUnusedWarnings = snd ((,) PFoo4Sym0KindInference ()) - type family PFoo4Sym1 (a0123456789876543210 :: Type) where - PFoo4Sym1 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 family SFoo4 a - type SFoo4 a = Maybe a - instance SC a where - type SFoo4 a = Maybe a - data SFoo1Sym0 a0123456789876543210 - where - SFoo1Sym0KindInference :: SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) => - SFoo1Sym0 a0123456789876543210 - type instance Apply SFoo1Sym0 a0123456789876543210 = SFoo1 a0123456789876543210 - instance SuppressUnusedWarnings SFoo1Sym0 where - suppressUnusedWarnings = snd ((,) SFoo1Sym0KindInference ()) - type family SFoo1Sym1 a0123456789876543210 where - SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210 - data SFoo3Sym0 a0123456789876543210 - where - SFoo3Sym0KindInference :: SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) => - SFoo3Sym0 a0123456789876543210 - type instance Apply SFoo3Sym0 a0123456789876543210 = SFoo3 a0123456789876543210 - instance SuppressUnusedWarnings SFoo3Sym0 where - suppressUnusedWarnings = snd ((,) SFoo3Sym0KindInference ()) - type family SFoo3Sym1 a0123456789876543210 where - SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210 - data SFoo2Sym0 :: (~>) Type Type - where - SFoo2Sym0KindInference :: SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) => - SFoo2Sym0 a0123456789876543210 - type instance Apply SFoo2Sym0 a0123456789876543210 = SFoo2 a0123456789876543210 - instance SuppressUnusedWarnings SFoo2Sym0 where - suppressUnusedWarnings = snd ((,) SFoo2Sym0KindInference ()) - type family SFoo2Sym1 (a0123456789876543210 :: Type) :: Type where - SFoo2Sym1 a0123456789876543210 = SFoo2 a0123456789876543210 - data SFoo4Sym0 a0123456789876543210 - where - SFoo4Sym0KindInference :: SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) => - SFoo4Sym0 a0123456789876543210 - type instance Apply SFoo4Sym0 a0123456789876543210 = SFoo4 a0123456789876543210 - instance SuppressUnusedWarnings SFoo4Sym0 where - suppressUnusedWarnings = snd ((,) SFoo4Sym0KindInference ()) - type family SFoo4Sym1 (a0123456789876543210 :: Type) where - SFoo4Sym1 a0123456789876543210 = SFoo4 a0123456789876543210 - class PSC (a :: Type) - instance PSC a - class SSC (a :: Type) - instance SSC a +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+ + instance PC a where+ type PFoo4 a = Maybe a+ type instance PFoo2 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 family PFoo4 a+ type PFoo4 a = Maybe a+ instance PC a where+ type PFoo4 a = Maybe a+ data PFoo1Sym0 a0123456789876543210+ where+ PFoo1Sym0KindInference :: SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) =>+ PFoo1Sym0 a0123456789876543210+ type instance Apply @_ @_ PFoo1Sym0 a0123456789876543210 = PFoo1 a0123456789876543210+ instance SuppressUnusedWarnings PFoo1Sym0 where+ suppressUnusedWarnings = snd ((,) PFoo1Sym0KindInference ())+ type family PFoo1Sym1 a0123456789876543210 where+ PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210+ data PFoo3Sym0 a0123456789876543210+ where+ PFoo3Sym0KindInference :: SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) =>+ PFoo3Sym0 a0123456789876543210+ type instance Apply @_ @_ PFoo3Sym0 a0123456789876543210 = PFoo3 a0123456789876543210+ instance SuppressUnusedWarnings PFoo3Sym0 where+ suppressUnusedWarnings = snd ((,) PFoo3Sym0KindInference ())+ type family PFoo3Sym1 a0123456789876543210 where+ PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210+ data PFoo2Sym0 :: (~>) Type Type+ where+ PFoo2Sym0KindInference :: SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) =>+ PFoo2Sym0 a0123456789876543210+ type instance Apply @Type @Type PFoo2Sym0 a0123456789876543210 = PFoo2 a0123456789876543210+ instance SuppressUnusedWarnings PFoo2Sym0 where+ suppressUnusedWarnings = snd ((,) PFoo2Sym0KindInference ())+ type family PFoo2Sym1 (a0123456789876543210 :: Type) :: Type where+ PFoo2Sym1 a0123456789876543210 = PFoo2 a0123456789876543210+ data PFoo4Sym0 a0123456789876543210+ where+ PFoo4Sym0KindInference :: SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) =>+ PFoo4Sym0 a0123456789876543210+ type instance Apply @Type @_ PFoo4Sym0 a0123456789876543210 = PFoo4 a0123456789876543210+ instance SuppressUnusedWarnings PFoo4Sym0 where+ suppressUnusedWarnings = snd ((,) PFoo4Sym0KindInference ())+ type family PFoo4Sym1 (a0123456789876543210 :: Type) where+ PFoo4Sym1 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+ + instance SC a where+ type SFoo4 a = Maybe a+ type instance SFoo2 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 family SFoo4 a+ type SFoo4 a = Maybe a+ instance SC a where+ type SFoo4 a = Maybe a+ data SFoo1Sym0 a0123456789876543210+ where+ SFoo1Sym0KindInference :: SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) =>+ SFoo1Sym0 a0123456789876543210+ type instance Apply @_ @_ SFoo1Sym0 a0123456789876543210 = SFoo1 a0123456789876543210+ instance SuppressUnusedWarnings SFoo1Sym0 where+ suppressUnusedWarnings = snd ((,) SFoo1Sym0KindInference ())+ type family SFoo1Sym1 a0123456789876543210 where+ SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210+ data SFoo3Sym0 a0123456789876543210+ where+ SFoo3Sym0KindInference :: SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) =>+ SFoo3Sym0 a0123456789876543210+ type instance Apply @_ @_ SFoo3Sym0 a0123456789876543210 = SFoo3 a0123456789876543210+ instance SuppressUnusedWarnings SFoo3Sym0 where+ suppressUnusedWarnings = snd ((,) SFoo3Sym0KindInference ())+ type family SFoo3Sym1 a0123456789876543210 where+ SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210+ data SFoo2Sym0 :: (~>) Type Type+ where+ SFoo2Sym0KindInference :: SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) =>+ SFoo2Sym0 a0123456789876543210+ type instance Apply @Type @Type SFoo2Sym0 a0123456789876543210 = SFoo2 a0123456789876543210+ instance SuppressUnusedWarnings SFoo2Sym0 where+ suppressUnusedWarnings = snd ((,) SFoo2Sym0KindInference ())+ type family SFoo2Sym1 (a0123456789876543210 :: Type) :: Type where+ SFoo2Sym1 a0123456789876543210 = SFoo2 a0123456789876543210+ data SFoo4Sym0 a0123456789876543210+ where+ SFoo4Sym0KindInference :: SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) =>+ SFoo4Sym0 a0123456789876543210+ type instance Apply @Type @_ SFoo4Sym0 a0123456789876543210 = SFoo4 a0123456789876543210+ instance SuppressUnusedWarnings SFoo4Sym0 where+ suppressUnusedWarnings = snd ((,) SFoo4Sym0KindInference ())+ type family SFoo4Sym1 (a0123456789876543210 :: Type) where+ SFoo4Sym1 a0123456789876543210 = SFoo4 a0123456789876543210+ class PSC (a :: Type)+ instance PSC a+ class SSC (a :: Type)+ instance SSC a
tests/compile-and-dump/Singletons/T313.hs view
@@ -1,38 +1,38 @@-module T313 where - -import Data.Kind -import Data.Singletons.TH - -$(promote [d| - type PFoo1 a = Maybe a - - type family PFoo2 a - type instance PFoo2 a = Maybe a - - type family PFoo3 a where - PFoo3 a = Maybe a - - class PC (a :: Type) where - type PFoo4 a - type PFoo4 a = Maybe a - - instance PC a where - type PFoo4 a = Maybe a - |]) - -$(singletons [d| - type SFoo1 a = Maybe a - - type family SFoo2 a - type instance SFoo2 a = Maybe a - - type family SFoo3 a where - SFoo3 a = Maybe a - - class SC (a :: Type) where - type SFoo4 a - type SFoo4 a = Maybe a - - instance SC a where - type SFoo4 a = Maybe a - |]) +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.golden view
@@ -1,42 +1,42 @@-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 ReplaceAllGTypesSym0 :: (~>) ((~>) a ((~>) Type a)) ((~>) [Type] ((~>) [a] [a])) - data ReplaceAllGTypesSym0 :: (~>) ((~>) a ((~>) Type a)) ((~>) [Type] ((~>) [a] [a])) - where - ReplaceAllGTypesSym0KindInference :: SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) => - ReplaceAllGTypesSym0 a0123456789876543210 - type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210 - instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where - suppressUnusedWarnings - = snd ((,) ReplaceAllGTypesSym0KindInference ()) - type ReplaceAllGTypesSym1 :: (~>) a ((~>) Type a) - -> (~>) [Type] ((~>) [a] [a]) - data ReplaceAllGTypesSym1 (a0123456789876543210 :: (~>) a ((~>) Type a)) :: (~>) [Type] ((~>) [a] [a]) - where - ReplaceAllGTypesSym1KindInference :: SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) => - ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ReplaceAllGTypesSym1KindInference ()) - type ReplaceAllGTypesSym2 :: (~>) a ((~>) Type a) - -> [Type] -> (~>) [a] [a] - data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a ((~>) Type a)) (a0123456789876543210 :: [Type]) :: (~>) [a] [a] - where - ReplaceAllGTypesSym2KindInference :: 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 (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ReplaceAllGTypesSym2KindInference ()) - type ReplaceAllGTypesSym3 :: (~>) a ((~>) Type a) - -> [Type] -> [a] -> [a] - type family ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a ((~>) Type a)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a]) :: [a] where - ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 - type ReplaceAllGTypes :: (~>) a ((~>) Type a) - -> [Type] -> [a] -> [a] - type family ReplaceAllGTypes (a :: (~>) a ((~>) Type a)) (a :: [Type]) (a :: [a]) :: [a] where - ReplaceAllGTypes f types as = Apply (Apply (Apply ZipWithSym0 f) as) types +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 ReplaceAllGTypesSym0 :: (~>) ((~>) a ((~>) Type a)) ((~>) [Type] ((~>) [a] [a]))+ data ReplaceAllGTypesSym0 :: (~>) ((~>) a ((~>) Type a)) ((~>) [Type] ((~>) [a] [a]))+ where+ ReplaceAllGTypesSym0KindInference :: SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) =>+ ReplaceAllGTypesSym0 a0123456789876543210+ type instance Apply @((~>) a ((~>) Type a)) @((~>) [Type] ((~>) [a] [a])) ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210+ instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where+ suppressUnusedWarnings+ = snd ((,) ReplaceAllGTypesSym0KindInference ())+ type ReplaceAllGTypesSym1 :: (~>) a ((~>) Type a)+ -> (~>) [Type] ((~>) [a] [a])+ data ReplaceAllGTypesSym1 (a0123456789876543210 :: (~>) a ((~>) Type a)) :: (~>) [Type] ((~>) [a] [a])+ where+ ReplaceAllGTypesSym1KindInference :: SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) =>+ ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @[Type] @((~>) [a] [a]) (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) ReplaceAllGTypesSym1KindInference ())+ type ReplaceAllGTypesSym2 :: (~>) a ((~>) Type a)+ -> [Type] -> (~>) [a] [a]+ data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a ((~>) Type a)) (a0123456789876543210 :: [Type]) :: (~>) [a] [a]+ where+ ReplaceAllGTypesSym2KindInference :: SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) =>+ ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @[a] @[a] (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) ReplaceAllGTypesSym2KindInference ())+ type ReplaceAllGTypesSym3 :: (~>) a ((~>) Type a)+ -> [Type] -> [a] -> [a]+ type family ReplaceAllGTypesSym3 @a (a0123456789876543210 :: (~>) a ((~>) Type a)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a]) :: [a] where+ ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210+ type ReplaceAllGTypes :: (~>) a ((~>) Type a)+ -> [Type] -> [a] -> [a]+ type family ReplaceAllGTypes @a (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 view
@@ -1,10 +1,10 @@-module T316 where - -import Data.Kind -import Data.Singletons.TH -import Prelude.Singletons - -$(promoteOnly [d| - replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] - replaceAllGTypes f types as = zipWith f as types - |]) +module T316 where++import Data.Kind+import Data.Singletons.TH+import Prelude.Singletons++$(promoteOnly [d|+ replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a]+ replaceAllGTypes f types as = zipWith f as types+ |])
tests/compile-and-dump/Singletons/T322.golden view
@@ -1,54 +1,53 @@-Singletons/T322.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixr 2 ! - - (!) :: Bool -> Bool -> Bool - (!) = (||) |] - ======> - (!) :: Bool -> Bool -> Bool - (!) = (||) - infixr 2 ! - type (!@#@$) :: (~>) Bool ((~>) Bool Bool) - data (!@#@$) :: (~>) Bool ((~>) Bool Bool) - where - (:!@#@$###) :: SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => - (!@#@$) a0123456789876543210 - type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (!@#@$) where - suppressUnusedWarnings = snd ((,) (:!@#@$###) ()) - infixr 2 !@#@$ - type (!@#@$$) :: Bool -> (~>) Bool Bool - data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool - where - (:!@#@$$###) :: SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) => - (!@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:!@#@$$###) ()) - infixr 2 !@#@$$ - type (!@#@$$$) :: Bool -> Bool -> Bool - type family (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Bool where - (!@#@$$$) a0123456789876543210 a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210 - infixr 2 !@#@$$$ - type (!) :: Bool -> Bool -> Bool - type family (!) (a :: Bool) (a :: Bool) :: Bool where - (!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210 - infixr 2 %! - (%!) :: - (forall (t :: Bool) (t :: Bool). - Sing t - -> Sing t -> Sing (Apply (Apply (!@#@$) t) t :: Bool) :: Type) - (%!) - (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)) - instance SingI1 ((!@#@$$) :: Bool -> (~>) Bool Bool) where - liftSing (s :: Sing (d :: Bool)) - = singFun1 @((!@#@$$) (d :: Bool)) ((%!) s) +Singletons/T322.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| infixr 2 !+ + (!) :: Bool -> Bool -> Bool+ (!) = (||) |]+ ======>+ (!) :: Bool -> Bool -> Bool+ (!) = (||)+ infixr 2 !+ type (!@#@$) :: (~>) Bool ((~>) Bool Bool)+ data (!@#@$) :: (~>) Bool ((~>) Bool Bool)+ where+ (:!@#@$###) :: SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) =>+ (!@#@$) a0123456789876543210+ type instance Apply @Bool @((~>) Bool Bool) (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (!@#@$) where+ suppressUnusedWarnings = snd ((,) (:!@#@$###) ())+ infixr 2 type !@#@$+ type (!@#@$$) :: Bool -> (~>) Bool Bool+ data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool+ where+ (:!@#@$$###) :: SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) =>+ (!@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Bool ((!@#@$$) a0123456789876543210) a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:!@#@$$###) ())+ infixr 2 type !@#@$$+ type (!@#@$$$) :: Bool -> Bool -> Bool+ type family (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Bool where+ (!@#@$$$) a0123456789876543210 a0123456789876543210 = (!) a0123456789876543210 a0123456789876543210+ infixr 2 type !@#@$$$+ type (!) :: Bool -> Bool -> Bool+ type family (!) (a :: Bool) (a :: Bool) :: Bool where+ (!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210+ infixr 2 data %!+ (%!) ::+ (forall (t :: Bool) (t :: Bool).+ Sing t -> Sing t -> Sing ((!) t t :: Bool) :: Type)+ (%!)+ (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))+ instance SingI1 ((!@#@$$) :: Bool -> (~>) Bool Bool) where+ liftSing (s :: Sing (d :: Bool))+ = singFun1 @((!@#@$$) (d :: Bool)) ((%!) s)
tests/compile-and-dump/Singletons/T322.hs view
@@ -1,13 +1,13 @@-module T322 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - (!) :: Bool -> Bool -> Bool - (!) = (||) - infixr 2 ! - |]) - -f1 :: (False && True ! True) :~: True -f1 = Refl +module T322 where++import Data.Singletons.TH+import Prelude.Singletons++$(singletons [d|+ (!) :: Bool -> Bool -> Bool+ (!) = (||)+ infixr 2 !+ |])++f1 :: (False && True ! True) :~: True+f1 = Refl
tests/compile-and-dump/Singletons/T323.hs view
@@ -1,7 +1,7 @@-module T323 where - -import Data.Type.Equality -import Prelude.Singletons - -test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h -test = Refl +module T323 where++import Data.Type.Equality+import Prelude.Singletons++test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h+test = Refl
tests/compile-and-dump/Singletons/T326.golden view
@@ -1,73 +1,72 @@-Singletons/T326.hs:0:0:: Splicing declarations - genPromotions [''C1] - ======> - type (<%>@#@$) :: forall a. (~>) a ((~>) a a) - data (<%>@#@$) :: (~>) a ((~>) a a) - where - (:<%>@#@$###) :: SameKind (Apply (<%>@#@$) arg) ((<%>@#@$$) arg) => - (<%>@#@$) a0123456789876543210 - type instance Apply (<%>@#@$) a0123456789876543210 = (<%>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<%>@#@$) where - suppressUnusedWarnings = snd ((,) (:<%>@#@$###) ()) - infixl 9 <%>@#@$ - type (<%>@#@$$) :: forall a. a -> (~>) a a - data (<%>@#@$$) (a0123456789876543210 :: a) :: (~>) a a - where - (:<%>@#@$$###) :: SameKind (Apply ((<%>@#@$$) a0123456789876543210) arg) ((<%>@#@$$$) a0123456789876543210 arg) => - (<%>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<%>@#@$$) a0123456789876543210) a0123456789876543210 = (<%>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<%>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<%>@#@$$###) ()) - infixl 9 <%>@#@$$ - type (<%>@#@$$$) :: forall a. a -> a -> a - type family (<%>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where - (<%>@#@$$$) a0123456789876543210 a0123456789876543210 = (<%>) a0123456789876543210 a0123456789876543210 - infixl 9 <%>@#@$$$ - type PC1 :: Type -> Constraint - class PC1 (a :: Type) where - type family (<%>) (arg :: a) (arg :: a) :: a - infixl 9 <%> -Singletons/T326.hs:0:0:: Splicing declarations - genSingletons [''C2] - ======> - type (<%%>@#@$) :: forall a. (~>) a ((~>) a a) - data (<%%>@#@$) :: (~>) a ((~>) a a) - where - (:<%%>@#@$###) :: SameKind (Apply (<%%>@#@$) arg) ((<%%>@#@$$) arg) => - (<%%>@#@$) a0123456789876543210 - type instance Apply (<%%>@#@$) a0123456789876543210 = (<%%>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (<%%>@#@$) where - suppressUnusedWarnings = snd ((,) (:<%%>@#@$###) ()) - infixl 9 <%%>@#@$ - type (<%%>@#@$$) :: forall a. a -> (~>) a a - data (<%%>@#@$$) (a0123456789876543210 :: a) :: (~>) a a - where - (:<%%>@#@$$###) :: SameKind (Apply ((<%%>@#@$$) a0123456789876543210) arg) ((<%%>@#@$$$) a0123456789876543210 arg) => - (<%%>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((<%%>@#@$$) a0123456789876543210) a0123456789876543210 = (<%%>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<%%>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (:<%%>@#@$$###) ()) - infixl 9 <%%>@#@$$ - type (<%%>@#@$$$) :: forall a. a -> a -> a - type family (<%%>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where - (<%%>@#@$$$) a0123456789876543210 a0123456789876543210 = (<%%>) a0123456789876543210 a0123456789876543210 - infixl 9 <%%>@#@$$$ - type PC2 :: Type -> Constraint - class PC2 (a :: Type) where - type family (<%%>) (arg :: a) (arg :: a) :: a - infixl 9 <%%> - class SC2 (a :: Type) where - (%<%%>) :: - (forall (t :: a) (t :: a). - Sing t - -> Sing t -> Sing (Apply (Apply (<%%>@#@$) t) t :: a) :: Type) - type SC2 :: Type -> Constraint - infixl 9 %<%%> - instance SC2 a => SingI ((<%%>@#@$) :: (~>) a ((~>) a a)) where - sing = singFun2 @(<%%>@#@$) (%<%%>) - instance (SC2 a, SingI d) => - SingI ((<%%>@#@$$) (d :: a) :: (~>) a a) where - sing = singFun1 @((<%%>@#@$$) (d :: a)) ((%<%%>) (sing @d)) - instance SC2 a => SingI1 ((<%%>@#@$$) :: a -> (~>) a a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((<%%>@#@$$) (d :: a)) ((%<%%>) s) +Singletons/T326.hs:0:0:: Splicing declarations+ genPromotions [''C1]+ ======>+ type (<%>@#@$) :: forall (a :: Type). (~>) a ((~>) a a)+ data (<%>@#@$) :: (~>) a ((~>) a a)+ where+ (:<%>@#@$###) :: SameKind (Apply (<%>@#@$) arg) ((<%>@#@$$) arg) =>+ (<%>@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (<%>@#@$) a0123456789876543210 = (<%>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<%>@#@$) where+ suppressUnusedWarnings = snd ((,) (:<%>@#@$###) ())+ infixl 9 type <%>@#@$+ type (<%>@#@$$) :: forall (a :: Type). a -> (~>) a a+ data (<%>@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:<%>@#@$$###) :: SameKind (Apply ((<%>@#@$$) a0123456789876543210) arg) ((<%>@#@$$$) a0123456789876543210 arg) =>+ (<%>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((<%>@#@$$) a0123456789876543210) a0123456789876543210 = (<%>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<%>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<%>@#@$$###) ())+ infixl 9 type <%>@#@$$+ type (<%>@#@$$$) :: forall (a :: Type). a -> a -> a+ type family (<%>@#@$$$) @(a :: Type) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (<%>@#@$$$) a0123456789876543210 a0123456789876543210 = (<%>) a0123456789876543210 a0123456789876543210+ infixl 9 type <%>@#@$$$+ type PC1 :: Type -> Constraint+ class PC1 (a :: Type) where+ type family (<%>) (arg :: a) (arg :: a) :: a+ infixl 9 type <%>+Singletons/T326.hs:0:0:: Splicing declarations+ genSingletons [''C2]+ ======>+ type (<%%>@#@$) :: forall (a :: Type). (~>) a ((~>) a a)+ data (<%%>@#@$) :: (~>) a ((~>) a a)+ where+ (:<%%>@#@$###) :: SameKind (Apply (<%%>@#@$) arg) ((<%%>@#@$$) arg) =>+ (<%%>@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (<%%>@#@$) a0123456789876543210 = (<%%>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (<%%>@#@$) where+ suppressUnusedWarnings = snd ((,) (:<%%>@#@$###) ())+ infixl 9 type <%%>@#@$+ type (<%%>@#@$$) :: forall (a :: Type). a -> (~>) a a+ data (<%%>@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:<%%>@#@$$###) :: SameKind (Apply ((<%%>@#@$$) a0123456789876543210) arg) ((<%%>@#@$$$) a0123456789876543210 arg) =>+ (<%%>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((<%%>@#@$$) a0123456789876543210) a0123456789876543210 = (<%%>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((<%%>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:<%%>@#@$$###) ())+ infixl 9 type <%%>@#@$$+ type (<%%>@#@$$$) :: forall (a :: Type). a -> a -> a+ type family (<%%>@#@$$$) @(a :: Type) (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (<%%>@#@$$$) a0123456789876543210 a0123456789876543210 = (<%%>) a0123456789876543210 a0123456789876543210+ infixl 9 type <%%>@#@$$$+ type PC2 :: Type -> Constraint+ class PC2 (a :: Type) where+ type family (<%%>) (arg :: a) (arg :: a) :: a+ infixl 9 type <%%>+ class SC2 (a :: Type) where+ (%<%%>) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((<%%>) t t :: a) :: Type)+ type SC2 :: Type -> Constraint+ infixl 9 data %<%%>+ instance SC2 a => SingI ((<%%>@#@$) :: (~>) a ((~>) a a)) where+ sing = singFun2 @(<%%>@#@$) (%<%%>)+ instance (SC2 a, SingI d) =>+ SingI ((<%%>@#@$$) (d :: a) :: (~>) a a) where+ sing = singFun1 @((<%%>@#@$$) (d :: a)) ((%<%%>) (sing @d))+ instance SC2 a => SingI1 ((<%%>@#@$$) :: a -> (~>) a a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((<%%>@#@$$) (d :: a)) ((%<%%>) s)
tests/compile-and-dump/Singletons/T326.hs view
@@ -1,23 +1,23 @@-module T326 where - -import Data.Singletons.TH -import Data.Type.Equality - -class C1 a where - infixl 9 <%> - (<%>) :: a -> a -> a - -class C2 a where - infixl 9 <%%> - (<%%>) :: a -> a -> a - -$(genPromotions [''C1]) -$(genSingletons [''C2]) - -test1 :: Proxy f -> Proxy g -> Proxy h - -> (f <%> g) <%> h :~: f <%> g <%> h -test1 _ _ _ = Refl - -test2 :: Proxy f -> Proxy g -> Proxy h - -> (f <%%> g) <%%> h :~: f <%%> g <%%> h -test2 _ _ _ = Refl +module T326 where++import Data.Singletons.TH+import Data.Type.Equality++class C1 a where+ infixl 9 <%>+ (<%>) :: a -> a -> a++class C2 a where+ infixl 9 <%%>+ (<%%>) :: a -> a -> a++$(genPromotions [''C1])+$(genSingletons [''C2])++test1 :: Proxy f -> Proxy g -> Proxy h+ -> (f <%> g) <%> h :~: f <%> g <%> h+test1 _ _ _ = Refl++test2 :: Proxy f -> Proxy g -> Proxy h+ -> (f <%%> g) <%%> h :~: f <%%> g <%%> h+test2 _ _ _ = Refl
tests/compile-and-dump/Singletons/T33.golden view
@@ -1,40 +1,40 @@-Singletons/T33.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| foo :: (Bool, Bool) -> () - foo ~(_, _) = () |] - ======> - foo :: (Bool, Bool) -> () - foo ~(_, _) = () - type FooSym0 :: (~>) (Bool, Bool) () - data FooSym0 :: (~>) (Bool, Bool) () - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: (Bool, Bool) -> () - type family FooSym1 (a0123456789876543210 :: (Bool, - Bool)) :: () where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Foo :: (Bool, Bool) -> () - type family Foo (a :: (Bool, Bool)) :: () where - Foo '(_, _) = Tuple0Sym0 - sFoo :: - (forall (t :: (Bool, Bool)). - Sing t -> Sing (Apply FooSym0 t :: ()) :: Type) - sFoo (STuple2 _ _) = STuple0 - instance SingI (FooSym0 :: (~>) (Bool, Bool) ()) where - sing = singFun1 @FooSym0 sFoo - -Singletons/T33.hs:0:0: warning: [GHC-39584] - Lazy pattern converted into regular pattern during singleton generation. - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^^... - -Singletons/T33.hs:0:0: warning: [GHC-39584] - Lazy pattern converted into regular pattern in promotion - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^^... +Singletons/T33.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| foo :: (Bool, Bool) -> ()+ foo ~(_, _) = () |]+ ======>+ foo :: (Bool, Bool) -> ()+ foo ~(_, _) = ()+ type FooSym0 :: (~>) (Bool, Bool) ()+ data FooSym0 :: (~>) (Bool, Bool) ()+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @(Bool,+ Bool) @() FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: (Bool, Bool) -> ()+ type family FooSym1 (a0123456789876543210 :: (Bool,+ Bool)) :: () where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Foo :: (Bool, Bool) -> ()+ type family Foo (a :: (Bool, Bool)) :: () where+ Foo '(_, _) = Tuple0Sym0+ sFoo ::+ (forall (t :: (Bool, Bool)). Sing t -> Sing (Foo t :: ()) :: Type)+ sFoo (STuple2 _ _) = STuple0+ instance SingI (FooSym0 :: (~>) (Bool, Bool) ()) where+ sing = singFun1 @FooSym0 sFoo+Singletons/T33.hs:0:0: warning: [GHC-39584]+ Lazy pattern converted into regular pattern during singleton generation.+ |+6 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...++Singletons/T33.hs:0:0: warning: [GHC-39584]+ Lazy pattern converted into regular pattern in promotion+ |+6 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...+
tests/compile-and-dump/Singletons/T33.hs view
@@ -1,9 +1,9 @@-module Singletons.T33 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - foo :: (Bool, Bool) -> () - foo ~(_, _) = () - |]) +module Singletons.T33 where++import Data.Singletons.TH+import Prelude.Singletons++$(singletons [d|+ foo :: (Bool, Bool) -> ()+ foo ~(_, _) = ()+ |])
tests/compile-and-dump/Singletons/T332.golden view
@@ -1,67 +1,66 @@-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 MkFooSym0 :: Foo - type family MkFooSym0 :: Foo where - MkFooSym0 = MkFoo - type FSym0 :: (~>) Foo () - data FSym0 :: (~>) Foo () - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: Foo -> () - type family FSym1 (a0123456789876543210 :: Foo) :: () where - FSym1 a0123456789876543210 = F a0123456789876543210 - type F :: Foo -> () - type family F (a :: Foo) :: () where - F MkFoo = Tuple0Sym0 -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 :: Bar - type family MkBarSym0 :: Bar where - MkBarSym0 = MkBar - type BSym0 :: (~>) Bar () - data BSym0 :: (~>) Bar () - where - BSym0KindInference :: SameKind (Apply BSym0 arg) (BSym1 arg) => - BSym0 a0123456789876543210 - type instance Apply BSym0 a0123456789876543210 = B a0123456789876543210 - instance SuppressUnusedWarnings BSym0 where - suppressUnusedWarnings = snd ((,) BSym0KindInference ()) - type BSym1 :: Bar -> () - type family BSym1 (a0123456789876543210 :: Bar) :: () where - BSym1 a0123456789876543210 = B a0123456789876543210 - type B :: Bar -> () - type family B (a :: Bar) :: () where - B MkBar = Tuple0Sym0 - sB :: - (forall (t :: Bar). Sing t -> Sing (Apply BSym0 t :: ()) :: Type) - sB SMkBar = STuple0 - instance SingI (BSym0 :: (~>) Bar ()) where - sing = singFun1 @BSym0 sB - data SBar :: Bar -> Type where SMkBar :: SBar (MkBar :: Bar) - type instance Sing @Bar = SBar - instance SingKind Bar where - type Demote Bar = Bar - fromSing SMkBar = MkBar - toSing MkBar = SomeSing SMkBar - instance SingI MkBar where - sing = SMkBar +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 MkFooSym0 :: Foo+ type family MkFooSym0 :: Foo where+ MkFooSym0 = MkFoo+ type FSym0 :: (~>) Foo ()+ data FSym0 :: (~>) Foo ()+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @Foo @() FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: Foo -> ()+ type family FSym1 (a0123456789876543210 :: Foo) :: () where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type F :: Foo -> ()+ type family F (a :: Foo) :: () where+ F MkFoo = Tuple0Sym0+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 :: Bar+ type family MkBarSym0 :: Bar where+ MkBarSym0 = MkBar+ type BSym0 :: (~>) Bar ()+ data BSym0 :: (~>) Bar ()+ where+ BSym0KindInference :: SameKind (Apply BSym0 arg) (BSym1 arg) =>+ BSym0 a0123456789876543210+ type instance Apply @Bar @() BSym0 a0123456789876543210 = B a0123456789876543210+ instance SuppressUnusedWarnings BSym0 where+ suppressUnusedWarnings = snd ((,) BSym0KindInference ())+ type BSym1 :: Bar -> ()+ type family BSym1 (a0123456789876543210 :: Bar) :: () where+ BSym1 a0123456789876543210 = B a0123456789876543210+ type B :: Bar -> ()+ type family B (a :: Bar) :: () where+ B MkBar = Tuple0Sym0+ sB :: (forall (t :: Bar). Sing t -> Sing (B t :: ()) :: Type)+ sB SMkBar = STuple0+ instance SingI (BSym0 :: (~>) Bar ()) where+ sing = singFun1 @BSym0 sB+ data SBar :: Bar -> Type where SMkBar :: SBar (MkBar :: Bar)+ type instance Sing @Bar = SBar+ 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 view
@@ -1,17 +1,17 @@-module T332 where - -import Data.Singletons.Base.TH - -$(promote [d| - data Foo = MkFoo - - f :: Foo -> () - f MkFoo{} = () - |]) - -$(singletons [d| - data Bar = MkBar - - b :: Bar -> () - b MkBar{} = () - |]) +module T332 where++import Data.Singletons.Base.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.golden view
@@ -1,18 +1,18 @@-Singletons/T342.hs:(0,0)-(0,0): Splicing declarations - do synName <- newName "MyId" - a <- newName "a" - let dsyn = DTySynD synName [DPlainTV a ()] (DVarT a) - syn = decToTH dsyn - defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName] - pure $ syn : defuns - ======> - type MyId a = a - data MyIdSym0 a0123456789876543210 - where - MyIdSym0KindInference :: SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) => - MyIdSym0 a0123456789876543210 - type instance Apply MyIdSym0 a0123456789876543210 = MyId a0123456789876543210 - instance SuppressUnusedWarnings MyIdSym0 where - suppressUnusedWarnings = snd ((,) MyIdSym0KindInference ()) - type family MyIdSym1 a0123456789876543210 where - MyIdSym1 a0123456789876543210 = MyId a0123456789876543210 +Singletons/T342.hs:(0,0)-(0,0): Splicing declarations+ do synName <- newName "MyId"+ a <- newName "a"+ let dsyn = DTySynD synName [DPlainTV a BndrReq] (DVarT a)+ syn = decToTH dsyn+ defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName]+ pure $ syn : defuns+ ======>+ type MyId a = a+ data MyIdSym0 a0123456789876543210+ where+ MyIdSym0KindInference :: SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) =>+ MyIdSym0 a0123456789876543210+ type instance Apply @_ @_ MyIdSym0 a0123456789876543210 = MyId a0123456789876543210+ instance SuppressUnusedWarnings MyIdSym0 where+ suppressUnusedWarnings = snd ((,) MyIdSym0KindInference ())+ type family MyIdSym1 a0123456789876543210 where+ MyIdSym1 a0123456789876543210 = MyId a0123456789876543210
tests/compile-and-dump/Singletons/T342.hs view
@@ -1,13 +1,13 @@-module T342 where - -import Data.Singletons.TH -import Language.Haskell.TH -import Language.Haskell.TH.Desugar - -$(do synName <- newName "MyId" - a <- newName "a" - let dsyn = DTySynD synName [DPlainTV a ()] (DVarT a) - syn = decToTH dsyn - defuns <- withLocalDeclarations [syn] $ - genDefunSymbols [synName] - pure $ syn:defuns) +module T342 where++import Data.Singletons.TH+import Language.Haskell.TH+import Language.Haskell.TH.Desugar++$(do synName <- newName "MyId"+ a <- newName "a"+ let dsyn = DTySynD synName [DPlainTV a BndrReq] (DVarT a)+ syn = decToTH dsyn+ defuns <- withLocalDeclarations [syn] $+ genDefunSymbols [synName]+ pure $ syn:defuns)
tests/compile-and-dump/Singletons/T353.golden view
@@ -1,99 +1,95 @@-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 - data SymmetrySym0 :: (~>) (Proxy t0123456789876543210) ((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)) - where - SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => - SymmetrySym0 a0123456789876543210 - type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 - instance SuppressUnusedWarnings SymmetrySym0 where - suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ()) - data SymmetrySym1 (a0123456789876543210 :: Proxy t0123456789876543210) :: (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) - where - SymmetrySym1KindInference :: SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => - SymmetrySym1 a0123456789876543210 y0123456789876543210 - type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) SymmetrySym1KindInference ()) - data SymmetrySym2 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type - where - SymmetrySym2KindInference :: SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => - SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 - type instance Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where - suppressUnusedWarnings = snd ((,) SymmetrySym2KindInference ()) - type family SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) :: Type where - SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 -Singletons/T353.hs:0:0:: Splicing declarations - genDefunSymbols [''Prod] - ======> - type MkProdSym0 :: forall k - (f :: k -> Type) - (g :: k -> Type) - (p :: k). (~>) (f p) ((~>) (g p) (Prod (f :: k -> Type) (g :: k - -> Type) (p :: k))) - data MkProdSym0 :: (~>) (f p) ((~>) (g p) (Prod (f :: k - -> Type) (g :: k -> Type) (p :: k))) - where - MkProdSym0KindInference :: SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) => - MkProdSym0 a0123456789876543210 - type instance Apply MkProdSym0 a0123456789876543210 = MkProdSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkProdSym0 where - suppressUnusedWarnings = snd ((,) MkProdSym0KindInference ()) - type MkProdSym1 :: forall k - (f :: k -> Type) - (g :: k -> Type) - (p :: k). f p - -> (~>) (g p) (Prod (f :: k -> Type) (g :: k - -> Type) (p :: k)) - data MkProdSym1 (a0123456789876543210 :: f p) :: (~>) (g p) (Prod (f :: k - -> Type) (g :: k - -> Type) (p :: k)) - where - MkProdSym1KindInference :: SameKind (Apply (MkProdSym1 a0123456789876543210) arg) (MkProdSym2 a0123456789876543210 arg) => - MkProdSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkProdSym1 a0123456789876543210) a0123456789876543210 = 'MkProd a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkProdSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkProdSym1KindInference ()) - type MkProdSym2 :: forall k - (f :: k -> Type) - (g :: k -> Type) - (p :: k). f p - -> g p -> Prod (f :: k -> Type) (g :: k -> Type) (p :: k) - type family MkProdSym2 (a0123456789876543210 :: f p) (a0123456789876543210 :: g p) :: Prod (f :: k - -> Type) (g :: k - -> Type) (p :: k) where - MkProdSym2 a0123456789876543210 a0123456789876543210 = 'MkProd a0123456789876543210 a0123456789876543210 -Singletons/T353.hs:0:0:: Splicing declarations - genDefunSymbols [''Foo] - ======> - type MkFooSym0 :: forall k - k - (a :: k) - (b :: k). (~>) (Proxy a) ((~>) (Proxy b) (Foo (a :: k) (b :: k))) - data MkFooSym0 :: (~>) (Proxy a) ((~>) (Proxy b) (Foo (a :: k) (b :: k))) - where - MkFooSym0KindInference :: SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) => - MkFooSym0 a0123456789876543210 - type instance Apply MkFooSym0 a0123456789876543210 = MkFooSym1 a0123456789876543210 - instance SuppressUnusedWarnings MkFooSym0 where - suppressUnusedWarnings = snd ((,) MkFooSym0KindInference ()) - type MkFooSym1 :: forall k k (a :: k) (b :: k). Proxy a - -> (~>) (Proxy b) (Foo (a :: k) (b :: k)) - data MkFooSym1 (a0123456789876543210 :: Proxy a) :: (~>) (Proxy b) (Foo (a :: k) (b :: k)) - where - MkFooSym1KindInference :: SameKind (Apply (MkFooSym1 a0123456789876543210) arg) (MkFooSym2 a0123456789876543210 arg) => - MkFooSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkFooSym1 a0123456789876543210) a0123456789876543210 = 'MkFoo a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkFooSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkFooSym1KindInference ()) - type MkFooSym2 :: forall k k (a :: k) (b :: k). Proxy a - -> Proxy b -> Foo (a :: k) (b :: k) - type family MkFooSym2 (a0123456789876543210 :: Proxy a) (a0123456789876543210 :: Proxy b) :: Foo (a :: k) (b :: k) where - MkFooSym2 a0123456789876543210 a0123456789876543210 = 'MkFoo a0123456789876543210 a0123456789876543210 +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+ data SymmetrySym0 :: (~>) (Proxy t0123456789876543210) ((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type))+ where+ SymmetrySym0KindInference :: SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) =>+ SymmetrySym0 a0123456789876543210+ type instance Apply @(Proxy t0123456789876543210) @((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)) SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210+ instance SuppressUnusedWarnings SymmetrySym0 where+ suppressUnusedWarnings = snd ((,) SymmetrySym0KindInference ())+ data SymmetrySym1 (a0123456789876543210 :: Proxy t0123456789876543210) :: (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)+ where+ SymmetrySym1KindInference :: SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) =>+ SymmetrySym1 a0123456789876543210 y0123456789876543210+ type instance Apply @(Proxy t0123456789876543210) @((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210+ instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) SymmetrySym1KindInference ())+ data SymmetrySym2 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type+ where+ SymmetrySym2KindInference :: SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) =>+ SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210+ type instance Apply @((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) @Type (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210+ instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings = snd ((,) SymmetrySym2KindInference ())+ type family SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) :: Type where+ SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210+Singletons/T353.hs:0:0:: Splicing declarations+ genDefunSymbols [''Prod]+ ======>+ type MkProdSym0 :: forall {k :: Type}+ (f :: k -> Type)+ (g :: k -> Type)+ (p :: k). (~>) (f p) ((~>) (g p) (Prod f g p))+ data MkProdSym0 :: (~>) (f p) ((~>) (g p) (Prod f g p))+ where+ MkProdSym0KindInference :: SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) =>+ MkProdSym0 a0123456789876543210+ type instance Apply @(f p) @((~>) (g p) (Prod f g p)) MkProdSym0 a0123456789876543210 = MkProdSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkProdSym0 where+ suppressUnusedWarnings = snd ((,) MkProdSym0KindInference ())+ type MkProdSym1 :: forall {k :: Type}+ (f :: k -> Type)+ (g :: k -> Type)+ (p :: k). f p -> (~>) (g p) (Prod f g p)+ data MkProdSym1 (a0123456789876543210 :: f p) :: (~>) (g p) (Prod f g p)+ where+ MkProdSym1KindInference :: SameKind (Apply (MkProdSym1 a0123456789876543210) arg) (MkProdSym2 a0123456789876543210 arg) =>+ MkProdSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(g p) @(Prod f g p) (MkProdSym1 a0123456789876543210) a0123456789876543210 = 'MkProd a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkProdSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkProdSym1KindInference ())+ type MkProdSym2 :: forall {k :: Type}+ (f :: k -> Type)+ (g :: k -> Type)+ (p :: k). f p -> g p -> Prod f g p+ type family MkProdSym2 @(f :: k -> Type) @(g :: k+ -> Type) @(p :: k) (a0123456789876543210 :: f p) (a0123456789876543210 :: g p) :: Prod f g p where+ MkProdSym2 a0123456789876543210 a0123456789876543210 = 'MkProd a0123456789876543210 a0123456789876543210+Singletons/T353.hs:0:0:: Splicing declarations+ genDefunSymbols [''Foo]+ ======>+ type MkFooSym0 :: forall {k :: Type}+ {k :: Type}+ (a :: k)+ (b :: k). (~>) (Proxy a) ((~>) (Proxy b) (Foo a b))+ data MkFooSym0 :: (~>) (Proxy a) ((~>) (Proxy b) (Foo a b))+ where+ MkFooSym0KindInference :: SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) =>+ MkFooSym0 a0123456789876543210+ type instance Apply @(Proxy a) @((~>) (Proxy b) (Foo a b)) MkFooSym0 a0123456789876543210 = MkFooSym1 a0123456789876543210+ instance SuppressUnusedWarnings MkFooSym0 where+ suppressUnusedWarnings = snd ((,) MkFooSym0KindInference ())+ type MkFooSym1 :: forall {k :: Type}+ {k :: Type}+ (a :: k)+ (b :: k). Proxy a -> (~>) (Proxy b) (Foo a b)+ data MkFooSym1 (a0123456789876543210 :: Proxy a) :: (~>) (Proxy b) (Foo a b)+ where+ MkFooSym1KindInference :: SameKind (Apply (MkFooSym1 a0123456789876543210) arg) (MkFooSym2 a0123456789876543210 arg) =>+ MkFooSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Proxy b) @(Foo a b) (MkFooSym1 a0123456789876543210) a0123456789876543210 = 'MkFoo a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkFooSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkFooSym1KindInference ())+ type MkFooSym2 :: forall {k :: Type}+ {k :: Type}+ (a :: k)+ (b :: k). Proxy a -> Proxy b -> Foo a b+ type family MkFooSym2 @(a :: k) @(b :: k) (a0123456789876543210 :: Proxy a) (a0123456789876543210 :: Proxy b) :: Foo a b where+ MkFooSym2 a0123456789876543210 a0123456789876543210 = 'MkFoo a0123456789876543210 a0123456789876543210
tests/compile-and-dump/Singletons/T353.hs view
@@ -1,17 +1,17 @@-module T353 where - -import Data.Kind -import Data.Proxy -import Data.Singletons.TH - -$(singletons [d| - type family Symmetry (a :: Proxy t) (y :: Proxy t) - (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where - Symmetry a y _ = y :~: a - |]) - -data Prod f g p = MkProd (f p) (g p) -$(genDefunSymbols [''Prod]) - -data Foo a b = MkFoo (Proxy a) (Proxy b) -$(genDefunSymbols [''Foo]) +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.golden view
@@ -1,119 +1,87 @@-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 :: forall f a. f a - type family Method1Sym0 :: f a where - Method1Sym0 = Method1 - class PC1 (f :: k -> Type) where - type family Method1 :: f a - type Method2aSym0 :: forall b a. (~>) b a - data Method2aSym0 :: (~>) b a - where - Method2aSym0KindInference :: SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) => - Method2aSym0 a0123456789876543210 - type instance Apply Method2aSym0 a0123456789876543210 = Method2a a0123456789876543210 - instance SuppressUnusedWarnings Method2aSym0 where - suppressUnusedWarnings = snd ((,) Method2aSym0KindInference ()) - type Method2aSym1 :: forall b a. b -> a - type family Method2aSym1 (a0123456789876543210 :: b) :: a where - Method2aSym1 a0123456789876543210 = Method2a a0123456789876543210 - type Method2bSym0 :: forall b a. (~>) b a - data Method2bSym0 :: (~>) b a - where - Method2bSym0KindInference :: SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) => - Method2bSym0 a0123456789876543210 - type instance Apply Method2bSym0 a0123456789876543210 = Method2b a0123456789876543210 - instance SuppressUnusedWarnings Method2bSym0 where - suppressUnusedWarnings = snd ((,) Method2bSym0KindInference ()) - type Method2bSym1 :: forall b a. b -> a - type family Method2bSym1 (a0123456789876543210 :: b) :: a where - Method2bSym1 a0123456789876543210 = Method2b a0123456789876543210 - class PC2 a where - type family Method2a (arg :: b) :: a - type family Method2b (arg :: b) :: a - type Method1_0123456789876543210 :: [a] - type family Method1_0123456789876543210 :: [a] where - Method1_0123456789876543210 = NilSym0 - type Method1_0123456789876543210Sym0 :: [a] - type family Method1_0123456789876543210Sym0 :: [a] where - Method1_0123456789876543210Sym0 = Method1_0123456789876543210 - instance PC1 [] where - type Method1 = Method1_0123456789876543210Sym0 - type Method2a_0123456789876543210 :: b -> [a] - type family Method2a_0123456789876543210 (a :: b) :: [a] where - Method2a_0123456789876543210 _ = NilSym0 - type Method2a_0123456789876543210Sym0 :: (~>) b [a] - data Method2a_0123456789876543210Sym0 :: (~>) b [a] - where - Method2a_0123456789876543210Sym0KindInference :: SameKind (Apply Method2a_0123456789876543210Sym0 arg) (Method2a_0123456789876543210Sym1 arg) => - Method2a_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Method2a_0123456789876543210Sym0 a0123456789876543210 = Method2a_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Method2a_0123456789876543210Sym0KindInference ()) - type Method2a_0123456789876543210Sym1 :: b -> [a] - type family Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b) :: [a] where - Method2a_0123456789876543210Sym1 a0123456789876543210 = Method2a_0123456789876543210 a0123456789876543210 - type Method2b_0123456789876543210 :: b -> [a] - type family Method2b_0123456789876543210 (a :: b) :: [a] where - Method2b_0123456789876543210 _ = NilSym0 - type Method2b_0123456789876543210Sym0 :: (~>) b [a] - data Method2b_0123456789876543210Sym0 :: (~>) b [a] - where - Method2b_0123456789876543210Sym0KindInference :: SameKind (Apply Method2b_0123456789876543210Sym0 arg) (Method2b_0123456789876543210Sym1 arg) => - Method2b_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Method2b_0123456789876543210Sym0 a0123456789876543210 = Method2b_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Method2b_0123456789876543210Sym0KindInference ()) - type Method2b_0123456789876543210Sym1 :: b -> [a] - type family Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b) :: [a] where - Method2b_0123456789876543210Sym1 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 :: (Sing (Method1Sym0 :: f a) :: Type) - 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 :: (Sing (Method1Sym0 :: [a]) :: Type) - sMethod1 = 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 _ = SNil - sMethod2b _ = 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 +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 C2 [a] where+ method2a _ = []+ method2b :: forall b. b -> [a]+ method2b _ = []+ instance C1 [] where+ method1 :: [a]+ method1 = [] |]+ ======>+ 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 :: forall f a. f a+ type family Method1Sym0 @f @a :: f a where+ Method1Sym0 = Method1+ class PC1 (f :: k -> Type) where+ type family Method1 :: f a+ type Method2aSym0 :: forall b a. (~>) b a+ data Method2aSym0 :: (~>) b a+ where+ Method2aSym0KindInference :: SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) =>+ Method2aSym0 a0123456789876543210+ type instance Apply @b @a Method2aSym0 a0123456789876543210 = Method2a a0123456789876543210+ instance SuppressUnusedWarnings Method2aSym0 where+ suppressUnusedWarnings = snd ((,) Method2aSym0KindInference ())+ type Method2aSym1 :: forall b a. b -> a+ type family Method2aSym1 @b @a (a0123456789876543210 :: b) :: a where+ Method2aSym1 a0123456789876543210 = Method2a a0123456789876543210+ type Method2bSym0 :: forall b a. (~>) b a+ data Method2bSym0 :: (~>) b a+ where+ Method2bSym0KindInference :: SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) =>+ Method2bSym0 a0123456789876543210+ type instance Apply @b @a Method2bSym0 a0123456789876543210 = Method2b a0123456789876543210+ instance SuppressUnusedWarnings Method2bSym0 where+ suppressUnusedWarnings = snd ((,) Method2bSym0KindInference ())+ type Method2bSym1 :: forall b a. b -> a+ type family Method2bSym1 @b @a (a0123456789876543210 :: b) :: a where+ Method2bSym1 a0123456789876543210 = Method2b a0123456789876543210+ class PC2 a where+ type family Method2a (arg :: b) :: a+ type family Method2b (arg :: b) :: a+ type Method1_0123456789876543210 :: forall a. [a]+ type family Method1_0123456789876543210 @a :: [a] where+ Method1_0123456789876543210 @a = NilSym0+ instance PC1 [] where+ type Method1 = Method1_0123456789876543210+ type Method2a_0123456789876543210 :: forall a b. b -> [a]+ type family Method2a_0123456789876543210 @a @b (a :: b) :: [a] where+ Method2a_0123456789876543210 @a @b (_ :: b) = NilSym0+ type Method2b_0123456789876543210 :: forall a b. b -> [a]+ type family Method2b_0123456789876543210 @a @b (a :: b) :: [a] where+ Method2b_0123456789876543210 @a @b (_ :: b) = NilSym0+ instance PC2 [a] where+ type Method2a a = Method2a_0123456789876543210 a+ type Method2b a = Method2b_0123456789876543210 a+ class SC1 (f :: k -> Type) where+ sMethod1 :: (Sing (Method1 :: f a) :: Type)+ class SC2 a where+ sMethod2a :: forall b (t :: b). Sing t -> Sing (Method2a t :: a)+ sMethod2b :: forall b (t :: b). Sing t -> Sing (Method2b t :: a)+ instance SC1 [] where+ sMethod1 :: (Sing (Method1 :: [a]) :: Type)+ sMethod1 = SNil+ instance SC2 [a] where+ sMethod2b :: forall b (t :: b). Sing t -> Sing (Method2b t :: [a])+ sMethod2a _ = SNil+ sMethod2b _ = 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 view
@@ -1,24 +1,24 @@-module T358 where - -import Data.Kind -import Data.Singletons.Base.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 _ = [] - |]) +module T358 where++import Data.Kind+import Data.Singletons.Base.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/T367.golden view
@@ -1,41 +1,40 @@-Singletons/T367.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| const' :: a -> b -> a - const' x _ = x |] - ======> - type Const'Sym0 :: (~>) a ((~>) b a) - data Const'Sym0 :: (~>) a ((~>) b a) - where - Const'Sym0KindInference :: SameKind (Apply Const'Sym0 arg) (Const'Sym1 arg) => - Const'Sym0 a0123456789876543210 - type instance Apply Const'Sym0 a0123456789876543210 = Const'Sym1 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings Const'Sym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) Const'Sym0KindInference ()) - type Const'Sym1 :: a -> (~>) b a - data Const'Sym1 (a0123456789876543210 :: a) :: (~>) b a - where - Const'Sym1KindInference :: SameKind (Apply (Const'Sym1 a0123456789876543210) arg) (Const'Sym2 a0123456789876543210 arg) => - Const'Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Const'Sym1 a0123456789876543210) a0123456789876543210 = Const' a0123456789876543210 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (Const'Sym1 a0123456789876543210) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) Const'Sym1KindInference ()) - type Const'Sym2 :: a -> b -> a - type family Const'Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - Const'Sym2 a0123456789876543210 a0123456789876543210 = Const' a0123456789876543210 a0123456789876543210 - type Const' :: a -> b -> a - type family Const' (a :: a) (a :: b) :: a where - Const' x _ = x - sConst' :: - (forall (t :: a) (t :: b). - Sing t - -> Sing t -> Sing (Apply (Apply Const'Sym0 t) t :: a) :: Type) - sConst' (sX :: Sing x) _ = sX - instance SingI (Const'Sym0 :: (~>) a ((~>) b a)) where - sing = singFun2 @Const'Sym0 sConst' - instance SingI d => SingI (Const'Sym1 (d :: a) :: (~>) b a) where - sing = singFun1 @(Const'Sym1 (d :: a)) (sConst' (sing @d)) - instance SingI1 (Const'Sym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(Const'Sym1 (d :: a)) (sConst' s) +Singletons/T367.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| const' :: a -> b -> a+ const' x _ = x |]+ ======>+ type Const'Sym0 :: (~>) a ((~>) b a)+ data Const'Sym0 :: (~>) a ((~>) b a)+ where+ Const'Sym0KindInference :: SameKind (Apply Const'Sym0 arg) (Const'Sym1 arg) =>+ Const'Sym0 a0123456789876543210+ type instance Apply @a @((~>) b a) Const'Sym0 a0123456789876543210 = Const'Sym1 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings Const'Sym0 where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) Const'Sym0KindInference ())+ type Const'Sym1 :: a -> (~>) b a+ data Const'Sym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ Const'Sym1KindInference :: SameKind (Apply (Const'Sym1 a0123456789876543210) arg) (Const'Sym2 a0123456789876543210 arg) =>+ Const'Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (Const'Sym1 a0123456789876543210) a0123456789876543210 = Const' a0123456789876543210 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (Const'Sym1 a0123456789876543210) where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) Const'Sym1KindInference ())+ type Const'Sym2 :: a -> b -> a+ type family Const'Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ Const'Sym2 a0123456789876543210 a0123456789876543210 = Const' a0123456789876543210 a0123456789876543210+ type Const' :: a -> b -> a+ type family Const' @a @b (a :: a) (a :: b) :: a where+ Const' x _ = x+ sConst' ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (Const' t t :: a) :: Type)+ sConst' (sX :: Sing x) _ = sX+ instance SingI (Const'Sym0 :: (~>) a ((~>) b a)) where+ sing = singFun2 @Const'Sym0 sConst'+ instance SingI d => SingI (Const'Sym1 (d :: a) :: (~>) b a) where+ sing = singFun1 @(Const'Sym1 (d :: a)) (sConst' (sing @d))+ instance SingI1 (Const'Sym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(Const'Sym1 (d :: a)) (sConst' s)
tests/compile-and-dump/Singletons/T367.hs view
@@ -1,12 +1,12 @@-module T367 where - -import Data.Singletons.TH (singletonsOnly) -import Prelude.Singletons - -$(singletonsOnly [d| - const' :: a -> b -> a - const' x _ = x - |]) - -test :: Sing True -test = sConst' @Bool @() STrue STuple0 +module T367 where++import Data.Singletons.TH (singletonsOnly)+import Prelude.Singletons++$(singletonsOnly [d|+ const' :: a -> b -> a+ const' x _ = x+ |])++test :: Sing True+test = sConst' @Bool @() STrue STuple0
tests/compile-and-dump/Singletons/T371.golden view
@@ -1,247 +1,169 @@-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 :: forall (a :: Type). X (a :: Type) - type family X1Sym0 :: X (a :: Type) where - X1Sym0 = X1 - type X2Sym0 :: forall (a :: Type). (~>) (Y a) (X (a :: Type)) - data X2Sym0 :: (~>) (Y a) (X (a :: Type)) - where - X2Sym0KindInference :: SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => - X2Sym0 a0123456789876543210 - type instance Apply X2Sym0 a0123456789876543210 = X2 a0123456789876543210 - instance SuppressUnusedWarnings X2Sym0 where - suppressUnusedWarnings = snd ((,) X2Sym0KindInference ()) - type X2Sym1 :: forall (a :: Type). Y a -> X (a :: Type) - type family X2Sym1 (a0123456789876543210 :: Y a) :: X (a :: Type) where - X2Sym1 a0123456789876543210 = X2 a0123456789876543210 - type Y1Sym0 :: forall (a :: Type). Y (a :: Type) - type family Y1Sym0 :: Y (a :: Type) where - Y1Sym0 = Y1 - type Y2Sym0 :: forall (a :: Type). (~>) (X a) (Y (a :: Type)) - data Y2Sym0 :: (~>) (X a) (Y (a :: Type)) - where - Y2Sym0KindInference :: SameKind (Apply Y2Sym0 arg) (Y2Sym1 arg) => - Y2Sym0 a0123456789876543210 - type instance Apply Y2Sym0 a0123456789876543210 = Y2 a0123456789876543210 - instance SuppressUnusedWarnings Y2Sym0 where - suppressUnusedWarnings = snd ((,) Y2Sym0KindInference ()) - type Y2Sym1 :: forall (a :: Type). X a -> Y (a :: Type) - type family Y2Sym1 (a0123456789876543210 :: X a) :: Y (a :: Type) where - Y2Sym1 a0123456789876543210 = Y2 a0123456789876543210 - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> X a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "X2 ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> X a -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: X a) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> X a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: X a) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow (X a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> Y a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (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) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> Y a -> (~>) GHC.Types.Symbol GHC.Types.Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Y a) :: (~>) GHC.Types.Symbol GHC.Types.Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> Y a -> GHC.Types.Symbol -> GHC.Types.Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: Y a) (a0123456789876543210 :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow (Y a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data SX :: forall (a :: Type). X a -> Type - where - SX1 :: forall (a :: Type). SX (X1 :: X (a :: Type)) - SX2 :: forall (a :: Type) (n :: Y a). - (Sing n) -> SX (X2 n :: X (a :: Type)) - type instance Sing @(X a) = SX - 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 SY :: forall (a :: Type). Y a -> Type - where - SY1 :: forall (a :: Type). SY (Y1 :: Y (a :: Type)) - SY2 :: forall (a :: Type) (n :: X a). - (Sing n) -> SY (Y2 n :: Y (a :: Type)) - type instance Sing @(Y a) = SY - 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.Num.Natural.Natural) - (t2 :: X a) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (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) - (sFromInteger (sing :: Sing 10)))) - (applySing - (applySing - (singFun3 @(.@#@$) (%.)) - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "X2 "))) - (applySing - (applySing - (singFun3 @ShowsPrecSym0 sShowsPrec) - (sFromInteger (sing :: Sing 11))) - sArg_0123456789876543210))) - sA_0123456789876543210 - instance SShow (X a) => SShow (Y a) where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: Y a) - (t3 :: GHC.Types.Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) (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) - (sFromInteger (sing :: Sing 10)))) - (applySing - (applySing - (singFun3 @(.@#@$) (%.)) - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Y2 "))) - (applySing - (applySing - (singFun3 @ShowsPrecSym0 sShowsPrec) - (sFromInteger (sing :: Sing 11))) - sArg_0123456789876543210))) - sA_0123456789876543210 - deriving instance Data.Singletons.ShowSing.ShowSing (Y a) => - Show (SX (z :: X a)) - deriving instance Data.Singletons.ShowSing.ShowSing (X a) => - Show (SY (z :: Y a)) - instance SingI X1 where - sing = SX1 - instance SingI n => SingI (X2 (n :: Y a)) where - sing = SX2 sing - instance SingI1 X2 where - liftSing = SX2 - instance SingI (X2Sym0 :: (~>) (Y a) (X (a :: Type))) where - sing = singFun1 @X2Sym0 SX2 - instance SingI Y1 where - sing = SY1 - instance SingI n => SingI (Y2 (n :: X a)) where - sing = SY2 sing - instance SingI1 Y2 where - liftSing = SY2 - instance SingI (Y2Sym0 :: (~>) (X a) (Y (a :: Type))) where - sing = singFun1 @Y2Sym0 SY2 +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 :: forall (a :: Type). X a+ type family X1Sym0 @(a :: Type) :: X a where+ X1Sym0 = X1+ type X2Sym0 :: forall (a :: Type). (~>) (Y a) (X a)+ data X2Sym0 :: (~>) (Y a) (X a)+ where+ X2Sym0KindInference :: SameKind (Apply X2Sym0 arg) (X2Sym1 arg) =>+ X2Sym0 a0123456789876543210+ type instance Apply @(Y a) @(X a) X2Sym0 a0123456789876543210 = X2 a0123456789876543210+ instance SuppressUnusedWarnings X2Sym0 where+ suppressUnusedWarnings = snd ((,) X2Sym0KindInference ())+ type X2Sym1 :: forall (a :: Type). Y a -> X a+ type family X2Sym1 @(a :: Type) (a0123456789876543210 :: Y a) :: X a where+ X2Sym1 a0123456789876543210 = X2 a0123456789876543210+ type Y1Sym0 :: forall (a :: Type). Y a+ type family Y1Sym0 @(a :: Type) :: Y a where+ Y1Sym0 = Y1+ type Y2Sym0 :: forall (a :: Type). (~>) (X a) (Y a)+ data Y2Sym0 :: (~>) (X a) (Y a)+ where+ Y2Sym0KindInference :: SameKind (Apply Y2Sym0 arg) (Y2Sym1 arg) =>+ Y2Sym0 a0123456789876543210+ type instance Apply @(X a) @(Y a) Y2Sym0 a0123456789876543210 = Y2 a0123456789876543210+ instance SuppressUnusedWarnings Y2Sym0 where+ suppressUnusedWarnings = snd ((,) Y2Sym0KindInference ())+ type Y2Sym1 :: forall (a :: Type). X a -> Y a+ type family Y2Sym1 @(a :: Type) (a0123456789876543210 :: X a) :: Y a where+ Y2Sym1 a0123456789876543210 = Y2 a0123456789876543210+ type ShowsPrec_0123456789876543210 :: forall a. GHC.Internal.Bignum.Natural.Natural+ -> X a+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 @a (a :: GHC.Internal.Bignum.Natural.Natural) (a :: X a) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.Types.Symbol where+ ShowsPrec_0123456789876543210 @a (_ :: GHC.Internal.Bignum.Natural.Natural) (X1 :: X a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply ShowStringSym0 "X1") a_0123456789876543210+ ShowsPrec_0123456789876543210 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (X2 arg_0123456789876543210 :: X a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "X2 ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210+ instance PShow (X a) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ type ShowsPrec_0123456789876543210 :: forall a. GHC.Internal.Bignum.Natural.Natural+ -> Y a+ -> GHC.Internal.Types.Symbol+ -> GHC.Internal.Types.Symbol+ type family ShowsPrec_0123456789876543210 @a (a :: GHC.Internal.Bignum.Natural.Natural) (a :: Y a) (a :: GHC.Internal.Types.Symbol) :: GHC.Internal.Types.Symbol where+ ShowsPrec_0123456789876543210 @a (_ :: GHC.Internal.Bignum.Natural.Natural) (Y1 :: Y a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply ShowStringSym0 "Y1") a_0123456789876543210+ ShowsPrec_0123456789876543210 @a (p_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) (Y2 arg_0123456789876543210 :: Y a) (a_0123456789876543210 :: GHC.Internal.Types.Symbol) = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210+ instance PShow (Y a) where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data SX :: forall (a :: Type). X a -> Type+ where+ SX1 :: forall (a :: Type). SX (X1 :: X a)+ SX2 :: forall (a :: Type) (n :: Y a). (Sing n) -> SX (X2 n :: X a)+ type instance Sing @(X a) = SX+ 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)))+ = (\cases (SomeSing c) -> SomeSing (SX2 c))+ (toSing b :: SomeSing (Y a))+ data SY :: forall (a :: Type). Y a -> Type+ where+ SY1 :: forall (a :: Type). SY (Y1 :: Y a)+ SY2 :: forall (a :: Type) (n :: X a). (Sing n) -> SY (Y2 n :: Y a)+ type instance Sing @(Y a) = SY+ 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)))+ = (\cases (SomeSing c) -> SomeSing (SY2 c))+ (toSing b :: SomeSing (X a))+ instance SShow (Y a) => SShow (X a) where+ 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)+ (sFromInteger (sing :: Sing 10))))+ (applySing+ (applySing+ (singFun3 @(.@#@$) (%.))+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "X2 ")))+ (applySing+ (applySing+ (singFun3 @ShowsPrecSym0 sShowsPrec)+ (sFromInteger (sing :: Sing 11)))+ sArg_0123456789876543210)))+ sA_0123456789876543210+ instance SShow (X a) => SShow (Y a) where+ 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)+ (sFromInteger (sing :: Sing 10))))+ (applySing+ (applySing+ (singFun3 @(.@#@$) (%.))+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Y2 ")))+ (applySing+ (applySing+ (singFun3 @ShowsPrecSym0 sShowsPrec)+ (sFromInteger (sing :: Sing 11)))+ sArg_0123456789876543210)))+ sA_0123456789876543210+ deriving instance Data.Singletons.ShowSing.ShowSing (Y a) =>+ Show (SX (z :: X a))+ deriving instance Data.Singletons.ShowSing.ShowSing (X a) =>+ Show (SY (z :: Y a))+ instance SingI X1 where+ sing = SX1+ instance SingI n => SingI (X2 (n :: Y a)) where+ sing = SX2 sing+ instance SingI1 X2 where+ liftSing = SX2+ instance SingI (X2Sym0 :: (~>) (Y a) (X a)) where+ sing = singFun1 @X2Sym0 SX2+ instance SingI Y1 where+ sing = SY1+ instance SingI n => SingI (Y2 (n :: X a)) where+ sing = SY2 sing+ instance SingI1 Y2 where+ liftSing = SY2+ instance SingI (Y2Sym0 :: (~>) (X a) (Y a)) where+ sing = singFun1 @Y2Sym0 SY2
tests/compile-and-dump/Singletons/T371.hs view
@@ -1,16 +1,16 @@-module T371 where - -import Data.Kind -import Data.Singletons.Base.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)) +module T371 where++import Data.Kind+import Data.Singletons.Base.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/T376.golden view
@@ -1,44 +1,44 @@-Singletons/T376.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| f :: (() -> ()) -> (() -> ()) - f g = g :: () -> () |] - ======> - f :: (() -> ()) -> () -> () - f g = g :: () -> () - type FSym0 :: (~>) ((~>) () ()) ((~>) () ()) - data FSym0 :: (~>) ((~>) () ()) ((~>) () ()) - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: (~>) () () -> (~>) () () - data FSym1 (a0123456789876543210 :: (~>) () ()) :: (~>) () () - where - FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) => - FSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FSym1 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FSym1KindInference ()) - type FSym2 :: (~>) () () -> () -> () - type family FSym2 (a0123456789876543210 :: (~>) () ()) (a0123456789876543210 :: ()) :: () where - FSym2 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210 - type F :: (~>) () () -> () -> () - type family F (a :: (~>) () ()) (a :: ()) :: () where - F g a_0123456789876543210 = Apply (g :: (~>) () ()) a_0123456789876543210 - sF :: - (forall (t :: (~>) () ()) (t :: ()). - Sing t -> Sing t -> Sing (Apply (Apply FSym0 t) t :: ()) :: Type) - sF - (sG :: Sing g) - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing (sG :: Sing (g :: (~>) () ())) sA_0123456789876543210 - instance SingI (FSym0 :: (~>) ((~>) () ()) ((~>) () ())) where - sing = singFun2 @FSym0 sF - instance SingI d => - SingI (FSym1 (d :: (~>) () ()) :: (~>) () ()) where - sing = singFun1 @(FSym1 (d :: (~>) () ())) (sF (sing @d)) - instance SingI1 (FSym1 :: (~>) () () -> (~>) () ()) where - liftSing (s :: Sing (d :: (~>) () ())) - = singFun1 @(FSym1 (d :: (~>) () ())) (sF s) +Singletons/T376.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| f :: (() -> ()) -> (() -> ())+ f g = g :: () -> () |]+ ======>+ f :: (() -> ()) -> () -> ()+ f g = g :: () -> ()+ type FSym0 :: (~>) ((~>) () ()) ((~>) () ())+ data FSym0 :: (~>) ((~>) () ()) ((~>) () ())+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @((~>) () ()) @((~>) () ()) FSym0 a0123456789876543210 = FSym1 a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: (~>) () () -> (~>) () ()+ data FSym1 (a0123456789876543210 :: (~>) () ()) :: (~>) () ()+ where+ FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) =>+ FSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @() @() (FSym1 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FSym1KindInference ())+ type FSym2 :: (~>) () () -> () -> ()+ type family FSym2 (a0123456789876543210 :: (~>) () ()) (a0123456789876543210 :: ()) :: () where+ FSym2 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210+ type F :: (~>) () () -> () -> ()+ type family F (a :: (~>) () ()) (a :: ()) :: () where+ F g a_0123456789876543210 = Apply (g :: (~>) () ()) a_0123456789876543210+ sF ::+ (forall (t :: (~>) () ()) (t :: ()).+ Sing t -> Sing t -> Sing (F t t :: ()) :: Type)+ sF+ (sG :: Sing g)+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing (sG :: Sing (g :: (~>) () ())) sA_0123456789876543210+ instance SingI (FSym0 :: (~>) ((~>) () ()) ((~>) () ())) where+ sing = singFun2 @FSym0 sF+ instance SingI d =>+ SingI (FSym1 (d :: (~>) () ()) :: (~>) () ()) where+ sing = singFun1 @(FSym1 (d :: (~>) () ())) (sF (sing @d))+ instance SingI1 (FSym1 :: (~>) () () -> (~>) () ()) where+ liftSing (s :: Sing (d :: (~>) () ()))+ = singFun1 @(FSym1 (d :: (~>) () ())) (sF s)
tests/compile-and-dump/Singletons/T376.hs view
@@ -1,8 +1,8 @@-module T376 where - -import Data.Singletons.TH - -$(singletons [d| - f :: (() -> ()) -> (() -> ()) - f g = g :: () -> () - |]) +module T376 where++import Data.Singletons.TH++$(singletons [d|+ f :: (() -> ()) -> (() -> ())+ f g = g :: () -> ()+ |])
tests/compile-and-dump/Singletons/T378a.golden view
@@ -1,90 +1,90 @@-Singletons/T378a.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| constBA :: forall b a. a -> b -> a - constBA x _ = x - - data Proxy :: forall k. k -> Type - where - Proxy1 :: Proxy a - Proxy2 :: Proxy (a :: k) - Proxy3 :: forall a. Proxy a - Proxy4 :: forall k (a :: k). Proxy a |] - ======> - constBA :: forall b a. a -> b -> a - constBA x _ = x - data Proxy :: forall k. k -> Type - where - Proxy1 :: Proxy a - Proxy2 :: Proxy (a :: k) - Proxy3 :: forall a. Proxy a - Proxy4 :: forall k (a :: k). Proxy a - type Proxy1Sym0 :: Proxy a - type family Proxy1Sym0 :: Proxy a where - Proxy1Sym0 = Proxy1 - type Proxy2Sym0 :: Proxy (a :: k) - type family Proxy2Sym0 :: Proxy (a :: k) where - Proxy2Sym0 = Proxy2 - type Proxy3Sym0 :: forall a. Proxy a - type family Proxy3Sym0 :: Proxy a where - Proxy3Sym0 = Proxy3 - type Proxy4Sym0 :: forall k (a :: k). Proxy a - type family Proxy4Sym0 :: Proxy a where - Proxy4Sym0 = Proxy4 - type ConstBASym0 :: forall b a. (~>) a ((~>) b a) - data ConstBASym0 :: (~>) a ((~>) b a) - where - ConstBASym0KindInference :: SameKind (Apply ConstBASym0 arg) (ConstBASym1 arg) => - ConstBASym0 a0123456789876543210 - type instance Apply ConstBASym0 a0123456789876543210 = ConstBASym1 a0123456789876543210 - instance SuppressUnusedWarnings ConstBASym0 where - suppressUnusedWarnings = snd ((,) ConstBASym0KindInference ()) - type ConstBASym1 :: forall b a. a -> (~>) b a - data ConstBASym1 (a0123456789876543210 :: a) :: (~>) b a - where - ConstBASym1KindInference :: SameKind (Apply (ConstBASym1 a0123456789876543210) arg) (ConstBASym2 a0123456789876543210 arg) => - ConstBASym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ConstBASym1 a0123456789876543210) a0123456789876543210 = ConstBA a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ConstBASym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) ConstBASym1KindInference ()) - type ConstBASym2 :: forall b a. a -> b -> a - type family ConstBASym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where - ConstBASym2 a0123456789876543210 a0123456789876543210 = ConstBA a0123456789876543210 a0123456789876543210 - type ConstBA :: forall b a. a -> b -> a - type family ConstBA (a :: a) (a :: b) :: a where - ConstBA x _ = x - sConstBA :: - forall b a (t :: a) (t :: b). Sing t - -> Sing t -> Sing (Apply (Apply ConstBASym0 t) t :: a) - sConstBA (sX :: Sing x) _ = sX - instance SingI (ConstBASym0 :: (~>) a ((~>) b a)) where - sing = singFun2 @ConstBASym0 sConstBA - instance SingI d => SingI (ConstBASym1 (d :: a) :: (~>) b a) where - sing = singFun1 @(ConstBASym1 (d :: a)) (sConstBA (sing @d)) - instance SingI1 (ConstBASym1 :: a -> (~>) b a) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(ConstBASym1 (d :: a)) (sConstBA s) - data SProxy :: forall k (a :: k). Proxy a -> Type - where - SProxy1 :: forall a. SProxy (Proxy1 :: Proxy a) - SProxy2 :: forall k (a :: k). SProxy (Proxy2 :: Proxy (a :: k)) - SProxy3 :: forall a. SProxy (Proxy3 :: Proxy a) - SProxy4 :: forall k (a :: k). SProxy (Proxy4 :: Proxy a) - type instance Sing @(Proxy a) = SProxy - instance SingKind a => SingKind (Proxy a) where - type Demote (Proxy a) = Proxy (Demote a) - fromSing SProxy1 = Proxy1 - fromSing SProxy2 = Proxy2 - fromSing SProxy3 = Proxy3 - fromSing SProxy4 = Proxy4 - toSing Proxy1 = SomeSing SProxy1 - toSing Proxy2 = SomeSing SProxy2 - toSing Proxy3 = SomeSing SProxy3 - toSing Proxy4 = SomeSing SProxy4 - instance SingI Proxy1 where - sing = SProxy1 - instance SingI Proxy2 where - sing = SProxy2 - instance SingI Proxy3 where - sing = SProxy3 - instance SingI Proxy4 where - sing = SProxy4 +Singletons/T378a.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| constBA :: forall b a. a -> b -> a+ constBA x _ = x+ + data Proxy :: forall k. k -> Type+ where+ Proxy1 :: Proxy a+ Proxy2 :: Proxy (a :: k)+ Proxy3 :: forall a. Proxy a+ Proxy4 :: forall k (a :: k). Proxy a |]+ ======>+ constBA :: forall b a. a -> b -> a+ constBA x _ = x+ data Proxy :: forall k. k -> Type+ where+ Proxy1 :: Proxy a+ Proxy2 :: Proxy (a :: k)+ Proxy3 :: forall a. Proxy a+ Proxy4 :: forall k (a :: k). Proxy a+ type Proxy1Sym0 :: Proxy a+ type family Proxy1Sym0 @a :: Proxy a where+ Proxy1Sym0 = Proxy1+ type Proxy2Sym0 :: Proxy (a :: k)+ type family Proxy2Sym0 @k @(a :: k) :: Proxy (a :: k) where+ Proxy2Sym0 = Proxy2+ type Proxy3Sym0 :: forall a. Proxy a+ type family Proxy3Sym0 @a :: Proxy a where+ Proxy3Sym0 = Proxy3+ type Proxy4Sym0 :: forall k (a :: k). Proxy a+ type family Proxy4Sym0 @k @(a :: k) :: Proxy a where+ Proxy4Sym0 = Proxy4+ type ConstBASym0 :: forall b a. (~>) a ((~>) b a)+ data ConstBASym0 :: (~>) a ((~>) b a)+ where+ ConstBASym0KindInference :: SameKind (Apply ConstBASym0 arg) (ConstBASym1 arg) =>+ ConstBASym0 a0123456789876543210+ type instance Apply @a @((~>) b a) ConstBASym0 a0123456789876543210 = ConstBASym1 a0123456789876543210+ instance SuppressUnusedWarnings ConstBASym0 where+ suppressUnusedWarnings = snd ((,) ConstBASym0KindInference ())+ type ConstBASym1 :: forall b a. a -> (~>) b a+ data ConstBASym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ ConstBASym1KindInference :: SameKind (Apply (ConstBASym1 a0123456789876543210) arg) (ConstBASym2 a0123456789876543210 arg) =>+ ConstBASym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (ConstBASym1 a0123456789876543210) a0123456789876543210 = ConstBA a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ConstBASym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) ConstBASym1KindInference ())+ type ConstBASym2 :: forall b a. a -> b -> a+ type family ConstBASym2 @b @a (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ ConstBASym2 a0123456789876543210 a0123456789876543210 = ConstBA a0123456789876543210 a0123456789876543210+ type ConstBA :: forall b a. a -> b -> a+ type family ConstBA @b @a (a :: a) (a :: b) :: a where+ ConstBA @b @a (x :: a) (_ :: b) = x+ sConstBA ::+ forall b a (t :: a) (t :: b). Sing t+ -> Sing t -> Sing (ConstBA t t :: a)+ sConstBA (sX :: Sing x) _ = sX+ instance SingI (ConstBASym0 :: (~>) a ((~>) b a)) where+ sing = singFun2 @ConstBASym0 sConstBA+ instance SingI d => SingI (ConstBASym1 (d :: a) :: (~>) b a) where+ sing = singFun1 @(ConstBASym1 (d :: a)) (sConstBA (sing @d))+ instance SingI1 (ConstBASym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(ConstBASym1 (d :: a)) (sConstBA s)+ data SProxy :: forall k (a :: k). Proxy a -> Type+ where+ SProxy1 :: forall a. SProxy (Proxy1 :: Proxy a)+ SProxy2 :: forall k (a :: k). SProxy (Proxy2 :: Proxy (a :: k))+ SProxy3 :: forall a. SProxy (Proxy3 :: Proxy a)+ SProxy4 :: forall k (a :: k). SProxy (Proxy4 :: Proxy a)+ type instance Sing @(Proxy a) = SProxy+ instance SingKind a => SingKind (Proxy a) where+ type Demote (Proxy a) = Proxy (Demote a)+ fromSing SProxy1 = Proxy1+ fromSing SProxy2 = Proxy2+ fromSing SProxy3 = Proxy3+ fromSing SProxy4 = Proxy4+ toSing Proxy1 = SomeSing SProxy1+ toSing Proxy2 = SomeSing SProxy2+ toSing Proxy3 = SomeSing SProxy3+ toSing Proxy4 = SomeSing SProxy4+ instance SingI Proxy1 where+ sing = SProxy1+ instance SingI Proxy2 where+ sing = SProxy2+ instance SingI Proxy3 where+ sing = SProxy3+ instance SingI Proxy4 where+ sing = SProxy4
tests/compile-and-dump/Singletons/T378a.hs view
@@ -1,64 +1,64 @@-module T378a where - -import Data.Kind -import Data.Singletons.TH hiding (Proxy(..)) -import Prelude.Singletons hiding (Proxy(..)) - -$(singletons [d| - constBA :: forall b a. a -> b -> a - constBA x _ = x - - data Proxy :: forall k. k -> Type where - Proxy1 :: Proxy a - Proxy2 :: Proxy (a :: k) - Proxy3 :: forall a. Proxy a - Proxy4 :: forall k (a :: k). Proxy a - |]) - -ex1 :: [Bool] -ex1 = [] @Bool - -type PEx1 :: [Bool] -type PEx1 = '[] @Bool - -sEx1 :: SList ('[] @Bool) -sEx1 = SNil @Bool - -ex2 :: Bool -ex2 = constBA @Ordering @Bool True LT - -type PEx2 :: Bool -type PEx2 = ConstBA @Ordering @Bool True LT - -sEx2 :: Sing (ConstBA True LT) -sEx2 = sConstBA @Ordering @Bool STrue SLT - -proxyEx1, proxyEx2, proxyEx3, proxyEx4 :: Proxy True -proxyEx1 = Proxy1 @True -proxyEx2 = Proxy2 @Bool @True -proxyEx3 = Proxy3 @True -proxyEx4 = Proxy4 @Bool @True - -type ProxyEx1 :: Proxy True -type ProxyEx1 = Proxy1 @True - -type ProxyEx2 :: Proxy True -type ProxyEx2 = Proxy2 @Bool @True - -type ProxyEx3 :: Proxy True -type ProxyEx3 = Proxy3 @True - -type ProxyEx4 :: Proxy True -type ProxyEx4 = Proxy4 @Bool @True - -sProxyEx1 :: SProxy (Proxy1 @True) -sProxyEx1 = SProxy1 @True - -sProxyEx2 :: SProxy (Proxy2 @Bool @True) -sProxyEx2 = SProxy2 @Bool @True - -sProxyEx3 :: SProxy (Proxy3 @True) -sProxyEx3 = SProxy3 @True - -sProxyEx4 :: SProxy (Proxy4 @Bool @True) -sProxyEx4 = SProxy4 @Bool @True +module T378a where++import Data.Kind+import Data.Singletons.TH hiding (Proxy(..))+import Prelude.Singletons hiding (Proxy(..))++$(singletons [d|+ constBA :: forall b a. a -> b -> a+ constBA x _ = x++ data Proxy :: forall k. k -> Type where+ Proxy1 :: Proxy a+ Proxy2 :: Proxy (a :: k)+ Proxy3 :: forall a. Proxy a+ Proxy4 :: forall k (a :: k). Proxy a+ |])++ex1 :: [Bool]+ex1 = [] @Bool++type PEx1 :: [Bool]+type PEx1 = '[] @Bool++sEx1 :: SList ('[] @Bool)+sEx1 = SNil @Bool++ex2 :: Bool+ex2 = constBA @Ordering @Bool True LT++type PEx2 :: Bool+type PEx2 = ConstBA @Ordering @Bool True LT++sEx2 :: Sing (ConstBA True LT)+sEx2 = sConstBA @Ordering @Bool STrue SLT++proxyEx1, proxyEx2, proxyEx3, proxyEx4 :: Proxy True+proxyEx1 = Proxy1 @True+proxyEx2 = Proxy2 @Bool @True+proxyEx3 = Proxy3 @True+proxyEx4 = Proxy4 @Bool @True++type ProxyEx1 :: Proxy True+type ProxyEx1 = Proxy1 @True++type ProxyEx2 :: Proxy True+type ProxyEx2 = Proxy2 @Bool @True++type ProxyEx3 :: Proxy True+type ProxyEx3 = Proxy3 @True++type ProxyEx4 :: Proxy True+type ProxyEx4 = Proxy4 @Bool @True++sProxyEx1 :: SProxy (Proxy1 @True)+sProxyEx1 = SProxy1 @True++sProxyEx2 :: SProxy (Proxy2 @Bool @True)+sProxyEx2 = SProxy2 @Bool @True++sProxyEx3 :: SProxy (Proxy3 @True)+sProxyEx3 = SProxy3 @True++sProxyEx4 :: SProxy (Proxy4 @Bool @True)+sProxyEx4 = SProxy4 @Bool @True
tests/compile-and-dump/Singletons/T378b.golden view
@@ -1,127 +1,117 @@-Singletons/T378b.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| f :: forall b a. a -> b -> () - f _ _ = () - natMinus :: Nat -> Nat -> Nat - natMinus Zero _ = Zero - natMinus (Succ a) (Succ b) = natMinus a b - natMinus a@(Succ _) Zero = a - - type C :: forall b a. a -> b -> Constraint - type D :: forall b a. a -> b -> Type - - class C x y - data D x y |] - ======> - type C :: forall b a. a -> b -> Constraint - class C x y - type D :: forall b a. a -> b -> Type - data D x y - f :: forall b a. a -> b -> () - f _ _ = () - natMinus :: Nat -> Nat -> Nat - natMinus Zero _ = Zero - natMinus (Succ a) (Succ b) = natMinus a b - natMinus a@(Succ _) Zero = a - data Let0123456789876543210ASym0 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210ASym0KindInference :: SameKind (Apply Let0123456789876543210ASym0 arg) (Let0123456789876543210ASym1 arg) => - Let0123456789876543210ASym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210ASym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210A wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ASym0 where - suppressUnusedWarnings - = snd ((,) Let0123456789876543210ASym0KindInference ()) - type family Let0123456789876543210ASym1 wild_01234567898765432100123456789876543210 where - Let0123456789876543210ASym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210A wild_01234567898765432100123456789876543210 - type family Let0123456789876543210A wild_0123456789876543210 where - Let0123456789876543210A wild_0123456789876543210 = Apply SuccSym0 wild_0123456789876543210 - type NatMinusSym0 :: (~>) Nat ((~>) Nat Nat) - data NatMinusSym0 :: (~>) Nat ((~>) Nat Nat) - where - NatMinusSym0KindInference :: SameKind (Apply NatMinusSym0 arg) (NatMinusSym1 arg) => - NatMinusSym0 a0123456789876543210 - type instance Apply NatMinusSym0 a0123456789876543210 = NatMinusSym1 a0123456789876543210 - instance SuppressUnusedWarnings NatMinusSym0 where - suppressUnusedWarnings = snd ((,) NatMinusSym0KindInference ()) - type NatMinusSym1 :: Nat -> (~>) Nat Nat - data NatMinusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat - where - NatMinusSym1KindInference :: SameKind (Apply (NatMinusSym1 a0123456789876543210) arg) (NatMinusSym2 a0123456789876543210 arg) => - NatMinusSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (NatMinusSym1 a0123456789876543210) a0123456789876543210 = NatMinus a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (NatMinusSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) NatMinusSym1KindInference ()) - type NatMinusSym2 :: Nat -> Nat -> Nat - type family NatMinusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where - NatMinusSym2 a0123456789876543210 a0123456789876543210 = NatMinus a0123456789876543210 a0123456789876543210 - type FSym0 :: forall b a. (~>) a ((~>) b ()) - data FSym0 :: (~>) a ((~>) b ()) - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd ((,) FSym0KindInference ()) - type FSym1 :: forall b a. a -> (~>) b () - data FSym1 (a0123456789876543210 :: a) :: (~>) b () - where - FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) => - FSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FSym1 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) FSym1KindInference ()) - type FSym2 :: forall b a. a -> b -> () - type family FSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: () where - FSym2 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210 - type NatMinus :: Nat -> Nat -> Nat - type family NatMinus (a :: Nat) (a :: Nat) :: Nat where - NatMinus 'Zero _ = ZeroSym0 - NatMinus ('Succ a) ('Succ b) = Apply (Apply NatMinusSym0 a) b - NatMinus ('Succ wild_0123456789876543210) 'Zero = Let0123456789876543210ASym1 wild_0123456789876543210 - type F :: forall b a. a -> b -> () - type family F (a :: a) (a :: b) :: () where - F _ _ = Tuple0Sym0 - type PC :: forall b a. a -> b -> Constraint - class PC x y - sNatMinus :: - (forall (t :: Nat) (t :: Nat). - Sing t - -> Sing t -> Sing (Apply (Apply NatMinusSym0 t) t :: Nat) :: Type) - sF :: - forall b a (t :: a) (t :: b). Sing t - -> Sing t -> Sing (Apply (Apply FSym0 t) t :: ()) - sNatMinus SZero _ = SZero - sNatMinus (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) - = applySing (applySing (singFun2 @NatMinusSym0 sNatMinus) sA) sB - sNatMinus - (SSucc (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) - SZero - = let - sA :: - Sing @_ (Let0123456789876543210ASym1 wild_0123456789876543210) - sA = applySing (singFun1 @SuccSym0 SSucc) sWild_0123456789876543210 - in sA - sF _ _ = STuple0 - instance SingI (NatMinusSym0 :: (~>) Nat ((~>) Nat Nat)) where - sing = singFun2 @NatMinusSym0 sNatMinus - instance SingI d => - SingI (NatMinusSym1 (d :: Nat) :: (~>) Nat Nat) where - sing = singFun1 @(NatMinusSym1 (d :: Nat)) (sNatMinus (sing @d)) - instance SingI1 (NatMinusSym1 :: Nat -> (~>) Nat Nat) where - liftSing (s :: Sing (d :: Nat)) - = singFun1 @(NatMinusSym1 (d :: Nat)) (sNatMinus s) - instance SingI (FSym0 :: (~>) a ((~>) b ())) where - sing = singFun2 @FSym0 sF - instance SingI d => SingI (FSym1 (d :: a) :: (~>) b ()) where - sing = singFun1 @(FSym1 (d :: a)) (sF (sing @d)) - instance SingI1 (FSym1 :: a -> (~>) b ()) where - liftSing (s :: Sing (d :: a)) = singFun1 @(FSym1 (d :: a)) (sF s) - type SD :: forall b a (x :: a) (y :: b). D x y -> Type - data SD :: forall b a (x :: a) (y :: b). D x y -> Type - type instance Sing @(D x y) = SD - instance (SingKind x, SingKind y) => SingKind (D x y) where - type Demote (D x y) = D (Demote x) (Demote y) - fromSing x = case x of {} - toSing x = SomeSing (case x of {}) - class SC x y - type SC :: forall b a. a -> b -> Constraint +Singletons/T378b.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| f :: forall b a. a -> b -> ()+ f _ _ = ()+ natMinus :: Nat -> Nat -> Nat+ natMinus Zero _ = Zero+ natMinus (Succ a) (Succ b) = natMinus a b+ natMinus a@(Succ _) Zero = a+ + type C :: forall b a. a -> b -> Constraint+ type D :: forall b a. a -> b -> Type+ + class C x y+ data D x y |]+ ======>+ type C :: forall b a. a -> b -> Constraint+ class C x y+ type D :: forall b a. a -> b -> Type+ data D x y+ f :: forall b a. a -> b -> ()+ f _ _ = ()+ natMinus :: Nat -> Nat -> Nat+ natMinus Zero _ = Zero+ natMinus (Succ a) (Succ b) = natMinus a b+ natMinus a@(Succ _) Zero = a+ type family Let0123456789876543210ASym0 wild_01234567898765432100123456789876543210 where+ Let0123456789876543210ASym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210A wild_01234567898765432100123456789876543210+ type family Let0123456789876543210A wild_01234567898765432100123456789876543210 where+ Let0123456789876543210A wild_0123456789876543210 = Apply SuccSym0 wild_0123456789876543210+ type NatMinusSym0 :: (~>) Nat ((~>) Nat Nat)+ data NatMinusSym0 :: (~>) Nat ((~>) Nat Nat)+ where+ NatMinusSym0KindInference :: SameKind (Apply NatMinusSym0 arg) (NatMinusSym1 arg) =>+ NatMinusSym0 a0123456789876543210+ type instance Apply @Nat @((~>) Nat Nat) NatMinusSym0 a0123456789876543210 = NatMinusSym1 a0123456789876543210+ instance SuppressUnusedWarnings NatMinusSym0 where+ suppressUnusedWarnings = snd ((,) NatMinusSym0KindInference ())+ type NatMinusSym1 :: Nat -> (~>) Nat Nat+ data NatMinusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat+ where+ NatMinusSym1KindInference :: SameKind (Apply (NatMinusSym1 a0123456789876543210) arg) (NatMinusSym2 a0123456789876543210 arg) =>+ NatMinusSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Nat @Nat (NatMinusSym1 a0123456789876543210) a0123456789876543210 = NatMinus a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (NatMinusSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) NatMinusSym1KindInference ())+ type NatMinusSym2 :: Nat -> Nat -> Nat+ type family NatMinusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) :: Nat where+ NatMinusSym2 a0123456789876543210 a0123456789876543210 = NatMinus a0123456789876543210 a0123456789876543210+ type FSym0 :: forall b a. (~>) a ((~>) b ())+ data FSym0 :: (~>) a ((~>) b ())+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @a @((~>) b ()) FSym0 a0123456789876543210 = FSym1 a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: forall b a. a -> (~>) b ()+ data FSym1 (a0123456789876543210 :: a) :: (~>) b ()+ where+ FSym1KindInference :: SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) =>+ FSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @() (FSym1 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FSym1KindInference ())+ type FSym2 :: forall b a. a -> b -> ()+ type family FSym2 @b @a (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: () where+ FSym2 a0123456789876543210 a0123456789876543210 = F a0123456789876543210 a0123456789876543210+ type NatMinus :: Nat -> Nat -> Nat+ type family NatMinus (a :: Nat) (a :: Nat) :: Nat where+ NatMinus 'Zero _ = ZeroSym0+ NatMinus ('Succ a) ('Succ b) = Apply (Apply NatMinusSym0 a) b+ NatMinus ('Succ wild_0123456789876543210) 'Zero = Let0123456789876543210ASym0 wild_0123456789876543210+ type F :: forall b a. a -> b -> ()+ type family F @b @a (a :: a) (a :: b) :: () where+ F @b @a (_ :: a) (_ :: b) = Tuple0Sym0+ type PC :: forall b a. a -> b -> Constraint+ class PC x y+ sNatMinus ::+ (forall (t :: Nat) (t :: Nat).+ Sing t -> Sing t -> Sing (NatMinus t t :: Nat) :: Type)+ sF ::+ forall b a (t :: a) (t :: b). Sing t+ -> Sing t -> Sing (F t t :: ())+ sNatMinus SZero _ = SZero+ sNatMinus (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b))+ = applySing (applySing (singFun2 @NatMinusSym0 sNatMinus) sA) sB+ sNatMinus+ (SSucc (sWild_0123456789876543210 :: Sing wild_0123456789876543210))+ SZero+ = let+ sA :: Sing @_ (Let0123456789876543210A wild_0123456789876543210)+ sA = applySing (singFun1 @SuccSym0 SSucc) sWild_0123456789876543210+ in sA+ sF _ _ = STuple0+ instance SingI (NatMinusSym0 :: (~>) Nat ((~>) Nat Nat)) where+ sing = singFun2 @NatMinusSym0 sNatMinus+ instance SingI d =>+ SingI (NatMinusSym1 (d :: Nat) :: (~>) Nat Nat) where+ sing = singFun1 @(NatMinusSym1 (d :: Nat)) (sNatMinus (sing @d))+ instance SingI1 (NatMinusSym1 :: Nat -> (~>) Nat Nat) where+ liftSing (s :: Sing (d :: Nat))+ = singFun1 @(NatMinusSym1 (d :: Nat)) (sNatMinus s)+ instance SingI (FSym0 :: (~>) a ((~>) b ())) where+ sing = singFun2 @FSym0 sF+ instance SingI d => SingI (FSym1 (d :: a) :: (~>) b ()) where+ sing = singFun1 @(FSym1 (d :: a)) (sF (sing @d))+ instance SingI1 (FSym1 :: a -> (~>) b ()) where+ liftSing (s :: Sing (d :: a)) = singFun1 @(FSym1 (d :: a)) (sF s)+ type SD :: forall b a (x :: a) (y :: b). D x y -> Type+ data SD :: forall b a (x :: a) (y :: b). D x y -> Type+ type instance Sing @(D x y) = SD+ instance (SingKind x, SingKind y) => SingKind (D x y) where+ type Demote (D x y) = D (Demote x) (Demote y)+ fromSing x = (\case) x+ toSing x = SomeSing ((\case) x)+ class SC x y+ type SC :: forall b a. a -> b -> Constraint
tests/compile-and-dump/Singletons/T378b.hs view
@@ -1,40 +1,40 @@-module T378b where - -import Data.Kind -import Data.Singletons.Base.TH -import Singletons.Nat - -$(singletons [d| - type C :: forall b a. a -> b -> Constraint - class C x y - - type D :: forall b a. a -> b -> Type - data D x y - - f :: forall b a. a -> b -> () - f _ _ = () - - natMinus :: Nat -> Nat -> Nat - natMinus Zero _ = Zero - natMinus (Succ a) (Succ b) = natMinus a b - natMinus a@(Succ _) Zero = a - |]) - --- Test some type variable orderings -type CExP :: Bool -> Ordering -> Constraint -type CExP = PC @Ordering @Bool - -type CExS :: Bool -> Ordering -> Constraint -type CExS = SC @Ordering @Bool - -type DExS :: D (x :: Bool) (y :: Ordering) -> Type -type DExS = SD @Ordering @Bool - -type FEx0 :: Bool ~> Ordering ~> () -type FEx0 = FSym0 @Ordering @Bool - -type FEx1 :: Bool -> Ordering ~> () -type FEx1 = FSym1 @Ordering @Bool - -type FEx2 :: () -type FEx2 = FSym2 @Ordering @Bool True EQ +module T378b where++import Data.Kind+import Data.Singletons.Base.TH+import Singletons.Nat++$(singletons [d|+ type C :: forall b a. a -> b -> Constraint+ class C x y++ type D :: forall b a. a -> b -> Type+ data D x y++ f :: forall b a. a -> b -> ()+ f _ _ = ()++ natMinus :: Nat -> Nat -> Nat+ natMinus Zero _ = Zero+ natMinus (Succ a) (Succ b) = natMinus a b+ natMinus a@(Succ _) Zero = a+ |])++-- Test some type variable orderings+type CExP :: Bool -> Ordering -> Constraint+type CExP = PC @Ordering @Bool++type CExS :: Bool -> Ordering -> Constraint+type CExS = SC @Ordering @Bool++type DExS :: D (x :: Bool) (y :: Ordering) -> Type+type DExS = SD @Ordering @Bool++type FEx0 :: Bool ~> Ordering ~> ()+type FEx0 = FSym0 @Ordering @Bool++type FEx1 :: Bool -> Ordering ~> ()+type FEx1 = FSym1 @Ordering @Bool++type FEx2 :: ()+type FEx2 = FSym2 @Ordering @Bool True EQ
tests/compile-and-dump/Singletons/T401.golden view
@@ -1,13 +1,13 @@- -Singletons/T401.hs:0:0: error: [GHC-39584] Q monad failure - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... - -Singletons/T401.hs:0:0: error: [GHC-39584] - `singletons-th` does not support higher-rank `forall`s -In the type: (forall a_0 . a_0 -> a_0) -> b_1 -> b_1 - - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... ++Singletons/T401.hs:0:0: error: [GHC-39584] Q monad failure+ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...++Singletons/T401.hs:0:0: error: [GHC-39584]+ `singletons-th` does not support higher-rank `forall`s+In the type: (forall a_0 . a_0 -> a_0) -> b_1 -> b_1++ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...
tests/compile-and-dump/Singletons/T401.hs view
@@ -1,8 +1,8 @@-module T401 where - -import Data.Singletons.TH - -$(singletons [d| - f :: (forall a. a -> a) -> b -> b - f _ x = x - |]) +module T401 where++import Data.Singletons.TH++$(singletons [d|+ f :: (forall a. a -> a) -> b -> b+ f _ x = x+ |])
tests/compile-and-dump/Singletons/T401b.golden view
@@ -1,13 +1,13 @@- -Singletons/T401b.hs:0:0: error: [GHC-39584] Q monad failure - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... - -Singletons/T401b.hs:0:0: error: [GHC-39584] - `singletons-th` does not support higher-rank `forall`s -In the type: (forall a_0 . a_0) -> T_1 - - | -5 | $(singletons [d| - | ^^^^^^^^^^^^^^^... ++Singletons/T401b.hs:0:0: error: [GHC-39584] Q monad failure+ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...++Singletons/T401b.hs:0:0: error: [GHC-39584]+ `singletons-th` does not support higher-rank `forall`s+In the type: (forall a_0 . a_0) -> T_1++ |+5 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...
tests/compile-and-dump/Singletons/T401b.hs view
@@ -1,8 +1,8 @@-module T401b where - -import Data.Singletons.TH - -$(singletons [d| - newtype T where - MkT :: (forall a. a) -> T - |]) +module T401b where++import Data.Singletons.TH++$(singletons [d|+ newtype T where+ MkT :: (forall a. a) -> T+ |])
tests/compile-and-dump/Singletons/T402.golden view
@@ -1,13 +1,13 @@-Singletons/T402.hs:0:0:: Splicing declarations - singletons [d| type AnyOfKind (k :: Type) = Any :: k |] - ======> - type AnyOfKind (k :: Type) = Any :: k - data AnyOfKindSym0 :: (~>) Type k0123456789876543210 - where - AnyOfKindSym0KindInference :: SameKind (Apply AnyOfKindSym0 arg) (AnyOfKindSym1 arg) => - AnyOfKindSym0 k0123456789876543210 - type instance Apply AnyOfKindSym0 k0123456789876543210 = AnyOfKind k0123456789876543210 - instance SuppressUnusedWarnings AnyOfKindSym0 where - suppressUnusedWarnings = snd ((,) AnyOfKindSym0KindInference ()) - type family AnyOfKindSym1 (k0123456789876543210 :: Type) :: k0123456789876543210 where - AnyOfKindSym1 k0123456789876543210 = AnyOfKind k0123456789876543210 +Singletons/T402.hs:0:0:: Splicing declarations+ singletons [d| type AnyOfKind (k :: Type) = Any :: k |]+ ======>+ type AnyOfKind (k :: Type) = Any :: k+ data AnyOfKindSym0 :: (~>) Type k0123456789876543210+ where+ AnyOfKindSym0KindInference :: SameKind (Apply AnyOfKindSym0 arg) (AnyOfKindSym1 arg) =>+ AnyOfKindSym0 k0123456789876543210+ type instance Apply @Type @k0123456789876543210 AnyOfKindSym0 k0123456789876543210 = AnyOfKind k0123456789876543210+ instance SuppressUnusedWarnings AnyOfKindSym0 where+ suppressUnusedWarnings = snd ((,) AnyOfKindSym0KindInference ())+ type family AnyOfKindSym1 (k0123456789876543210 :: Type) :: k0123456789876543210 where+ AnyOfKindSym1 k0123456789876543210 = AnyOfKind k0123456789876543210
tests/compile-and-dump/Singletons/T402.hs view
@@ -1,7 +1,7 @@-module T402 where - -import Data.Kind -import Data.Singletons.TH - -type family Any :: k -$(singletons [d| type AnyOfKind (k :: Type) = Any :: k |]) +module T402 where++import Data.Kind+import Data.Singletons.TH++type family Any :: k+$(singletons [d| type AnyOfKind (k :: Type) = Any :: k |])
tests/compile-and-dump/Singletons/T410.golden view
@@ -1,61 +1,40 @@-Singletons/T410.hs:(0,0)-(0,0): Splicing declarations - promote - [d| class Eq a where - equals :: a -> a -> Bool - - instance Eq () where - equals () () = True |] - ======> - class Eq a where - equals :: a -> a -> Bool - instance Eq () where - equals () () = True - type EqualsSym0 :: forall a. (~>) a ((~>) a Bool) - data EqualsSym0 :: (~>) a ((~>) a Bool) - where - EqualsSym0KindInference :: SameKind (Apply EqualsSym0 arg) (EqualsSym1 arg) => - EqualsSym0 a0123456789876543210 - type instance Apply EqualsSym0 a0123456789876543210 = EqualsSym1 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings EqualsSym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) EqualsSym0KindInference ()) - type EqualsSym1 :: forall a. a -> (~>) a Bool - data EqualsSym1 (a0123456789876543210 :: a) :: (~>) a Bool - where - EqualsSym1KindInference :: SameKind (Apply (EqualsSym1 a0123456789876543210) arg) (EqualsSym2 a0123456789876543210 arg) => - EqualsSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (EqualsSym1 a0123456789876543210) a0123456789876543210 = Equals a0123456789876543210 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (EqualsSym1 a0123456789876543210) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) EqualsSym1KindInference ()) - type EqualsSym2 :: forall a. a -> a -> Bool - type family EqualsSym2 (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Bool where - EqualsSym2 a0123456789876543210 a0123456789876543210 = Equals a0123456789876543210 a0123456789876543210 - class PEq a where - type family Equals (arg :: a) (arg :: a) :: Bool - type Equals_0123456789876543210 :: () -> () -> Bool - type family Equals_0123456789876543210 (a :: ()) (a :: ()) :: Bool where - Equals_0123456789876543210 '() '() = TrueSym0 - type Equals_0123456789876543210Sym0 :: (~>) () ((~>) () Bool) - data Equals_0123456789876543210Sym0 :: (~>) () ((~>) () Bool) - where - Equals_0123456789876543210Sym0KindInference :: SameKind (Apply Equals_0123456789876543210Sym0 arg) (Equals_0123456789876543210Sym1 arg) => - Equals_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Equals_0123456789876543210Sym0 a0123456789876543210 = Equals_0123456789876543210Sym1 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings Equals_0123456789876543210Sym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) Equals_0123456789876543210Sym0KindInference ()) - type Equals_0123456789876543210Sym1 :: () -> (~>) () Bool - data Equals_0123456789876543210Sym1 (a0123456789876543210 :: ()) :: (~>) () Bool - where - Equals_0123456789876543210Sym1KindInference :: SameKind (Apply (Equals_0123456789876543210Sym1 a0123456789876543210) arg) (Equals_0123456789876543210Sym2 a0123456789876543210 arg) => - Equals_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Equals_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Equals_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (Equals_0123456789876543210Sym1 a0123456789876543210) where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) Equals_0123456789876543210Sym1KindInference ()) - type Equals_0123456789876543210Sym2 :: () -> () -> Bool - type family Equals_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) :: Bool where - Equals_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Equals_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq () where - type Equals a a = Apply (Apply Equals_0123456789876543210Sym0 a) a +Singletons/T410.hs:(0,0)-(0,0): Splicing declarations+ promote+ [d| class Eq a where+ equals :: a -> a -> Bool+ + instance Eq () where+ equals () () = True |]+ ======>+ class Eq a where+ equals :: a -> a -> Bool+ instance Eq () where+ equals () () = True+ type EqualsSym0 :: forall a. (~>) a ((~>) a Bool)+ data EqualsSym0 :: (~>) a ((~>) a Bool)+ where+ EqualsSym0KindInference :: SameKind (Apply EqualsSym0 arg) (EqualsSym1 arg) =>+ EqualsSym0 a0123456789876543210+ type instance Apply @a @((~>) a Bool) EqualsSym0 a0123456789876543210 = EqualsSym1 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings EqualsSym0 where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) EqualsSym0KindInference ())+ type EqualsSym1 :: forall a. a -> (~>) a Bool+ data EqualsSym1 (a0123456789876543210 :: a) :: (~>) a Bool+ where+ EqualsSym1KindInference :: SameKind (Apply (EqualsSym1 a0123456789876543210) arg) (EqualsSym2 a0123456789876543210 arg) =>+ EqualsSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @Bool (EqualsSym1 a0123456789876543210) a0123456789876543210 = Equals a0123456789876543210 a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings (EqualsSym1 a0123456789876543210) where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) EqualsSym1KindInference ())+ type EqualsSym2 :: forall a. a -> a -> Bool+ type family EqualsSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: Bool where+ EqualsSym2 a0123456789876543210 a0123456789876543210 = Equals a0123456789876543210 a0123456789876543210+ class PEq a where+ type family Equals (arg :: a) (arg :: a) :: Bool+ type Equals_0123456789876543210 :: () -> () -> Bool+ type family Equals_0123456789876543210 (a :: ()) (a :: ()) :: Bool where+ Equals_0123456789876543210 '() '() = TrueSym0+ instance PEq () where+ type Equals a a = Equals_0123456789876543210 a a
tests/compile-and-dump/Singletons/T410.hs view
@@ -1,12 +1,12 @@-module T410 where - -import Data.Bool.Singletons -import Data.Singletons -import Data.Singletons.TH (promote) - -$(promote [d| - class Eq a where - equals :: a -> a -> Bool - instance Eq () where - equals () () = True - |]) +module T410 where++import Data.Bool.Singletons+import Data.Singletons+import Data.Singletons.TH (promote)++$(promote [d|+ class Eq a where+ equals :: a -> a -> Bool+ instance Eq () where+ equals () () = True+ |])
tests/compile-and-dump/Singletons/T412.golden view
@@ -1,399 +1,381 @@-Singletons/T412.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| infixr 5 `D1`, `MkD1`, `d1A`, `d1B` - infixl 5 `T1a`, `T1b` - infix 5 `C1` - - class C1 a b where - infix 6 `m1` - m1 :: a -> b -> Bool - type T1a a b = Either a b - type family T1b a b where - T1b a b = Either a b - data D1 a b = MkD1 {d1A :: a, d1B :: b} |] - ======> - infix 5 `C1` - class C1 a b where - infix 6 `m1` - m1 :: a -> b -> Bool - infixl 5 `T1a` - infixl 5 `T1b` - type T1a a b = Either a b - type family T1b a b where - T1b a b = Either a b - infixr 5 `D1` - infixr 5 `MkD1` - infixr 5 `d1A` - infixr 5 `d1B` - data D1 a b = MkD1 {d1A :: a, d1B :: b} - data T1aSym0 a0123456789876543210 - where - T1aSym0KindInference :: SameKind (Apply T1aSym0 arg) (T1aSym1 arg) => - T1aSym0 a0123456789876543210 - type instance Apply T1aSym0 a0123456789876543210 = T1aSym1 a0123456789876543210 - instance SuppressUnusedWarnings T1aSym0 where - suppressUnusedWarnings = snd ((,) T1aSym0KindInference ()) - infixl 5 `T1aSym0` - data T1aSym1 a0123456789876543210 b0123456789876543210 - where - T1aSym1KindInference :: SameKind (Apply (T1aSym1 a0123456789876543210) arg) (T1aSym2 a0123456789876543210 arg) => - T1aSym1 a0123456789876543210 b0123456789876543210 - type instance Apply (T1aSym1 a0123456789876543210) b0123456789876543210 = T1a a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (T1aSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T1aSym1KindInference ()) - infixl 5 `T1aSym1` - type family T1aSym2 a0123456789876543210 b0123456789876543210 where - T1aSym2 a0123456789876543210 b0123456789876543210 = T1a a0123456789876543210 b0123456789876543210 - infixl 5 `T1aSym2` - data T1bSym0 a0123456789876543210 - where - T1bSym0KindInference :: SameKind (Apply T1bSym0 arg) (T1bSym1 arg) => - T1bSym0 a0123456789876543210 - type instance Apply T1bSym0 a0123456789876543210 = T1bSym1 a0123456789876543210 - instance SuppressUnusedWarnings T1bSym0 where - suppressUnusedWarnings = snd ((,) T1bSym0KindInference ()) - infixl 5 `T1bSym0` - data T1bSym1 a0123456789876543210 b0123456789876543210 - where - T1bSym1KindInference :: SameKind (Apply (T1bSym1 a0123456789876543210) arg) (T1bSym2 a0123456789876543210 arg) => - T1bSym1 a0123456789876543210 b0123456789876543210 - type instance Apply (T1bSym1 a0123456789876543210) b0123456789876543210 = T1b a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (T1bSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T1bSym1KindInference ()) - infixl 5 `T1bSym1` - type family T1bSym2 a0123456789876543210 b0123456789876543210 where - T1bSym2 a0123456789876543210 b0123456789876543210 = T1b a0123456789876543210 b0123456789876543210 - infixl 5 `T1bSym2` - type MkD1Sym0 :: forall a b. (~>) a ((~>) b (D1 a b)) - data MkD1Sym0 :: (~>) a ((~>) b (D1 a b)) - where - MkD1Sym0KindInference :: SameKind (Apply MkD1Sym0 arg) (MkD1Sym1 arg) => - MkD1Sym0 a0123456789876543210 - type instance Apply MkD1Sym0 a0123456789876543210 = MkD1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings MkD1Sym0 where - suppressUnusedWarnings = snd ((,) MkD1Sym0KindInference ()) - infixr 5 `MkD1Sym0` - type MkD1Sym1 :: forall a b. a -> (~>) b (D1 a b) - data MkD1Sym1 (a0123456789876543210 :: a) :: (~>) b (D1 a b) - where - MkD1Sym1KindInference :: SameKind (Apply (MkD1Sym1 a0123456789876543210) arg) (MkD1Sym2 a0123456789876543210 arg) => - MkD1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkD1Sym1 a0123456789876543210) a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkD1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkD1Sym1KindInference ()) - infixr 5 `MkD1Sym1` - type MkD1Sym2 :: forall a b. a -> b -> D1 a b - type family MkD1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: D1 a b where - MkD1Sym2 a0123456789876543210 a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210 - infixr 5 `MkD1Sym2` - type D1BSym0 :: forall a b. (~>) (D1 a b) b - data D1BSym0 :: (~>) (D1 a b) b - where - D1BSym0KindInference :: SameKind (Apply D1BSym0 arg) (D1BSym1 arg) => - D1BSym0 a0123456789876543210 - type instance Apply D1BSym0 a0123456789876543210 = D1B a0123456789876543210 - instance SuppressUnusedWarnings D1BSym0 where - suppressUnusedWarnings = snd ((,) D1BSym0KindInference ()) - infixr 5 `D1BSym0` - type D1BSym1 :: forall a b. D1 a b -> b - type family D1BSym1 (a0123456789876543210 :: D1 a b) :: b where - D1BSym1 a0123456789876543210 = D1B a0123456789876543210 - infixr 5 `D1BSym1` - type D1ASym0 :: forall a b. (~>) (D1 a b) a - data D1ASym0 :: (~>) (D1 a b) a - where - D1ASym0KindInference :: SameKind (Apply D1ASym0 arg) (D1ASym1 arg) => - D1ASym0 a0123456789876543210 - type instance Apply D1ASym0 a0123456789876543210 = D1A a0123456789876543210 - instance SuppressUnusedWarnings D1ASym0 where - suppressUnusedWarnings = snd ((,) D1ASym0KindInference ()) - infixr 5 `D1ASym0` - type D1ASym1 :: forall a b. D1 a b -> a - type family D1ASym1 (a0123456789876543210 :: D1 a b) :: a where - D1ASym1 a0123456789876543210 = D1A a0123456789876543210 - infixr 5 `D1ASym1` - type D1B :: forall a b. D1 a b -> b - type family D1B (a :: D1 a b) :: b where - D1B (MkD1 _ field) = field - type D1A :: forall a b. D1 a b -> a - type family D1A (a :: D1 a b) :: a where - D1A (MkD1 field _) = field - infixr 5 `D1B` - infixr 5 `D1A` - infix 5 `PC1` - type M1Sym0 :: forall a b. (~>) a ((~>) b Bool) - data M1Sym0 :: (~>) a ((~>) b Bool) - where - M1Sym0KindInference :: SameKind (Apply M1Sym0 arg) (M1Sym1 arg) => - M1Sym0 a0123456789876543210 - type instance Apply M1Sym0 a0123456789876543210 = M1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings M1Sym0 where - suppressUnusedWarnings = snd ((,) M1Sym0KindInference ()) - infix 6 `M1Sym0` - type M1Sym1 :: forall a b. a -> (~>) b Bool - data M1Sym1 (a0123456789876543210 :: a) :: (~>) b Bool - where - M1Sym1KindInference :: SameKind (Apply (M1Sym1 a0123456789876543210) arg) (M1Sym2 a0123456789876543210 arg) => - M1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (M1Sym1 a0123456789876543210) a0123456789876543210 = M1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (M1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) M1Sym1KindInference ()) - infix 6 `M1Sym1` - type M1Sym2 :: forall a b. a -> b -> Bool - type family M1Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Bool where - M1Sym2 a0123456789876543210 a0123456789876543210 = M1 a0123456789876543210 a0123456789876543210 - infix 6 `M1Sym2` - class PC1 a b where - type family M1 (arg :: a) (arg :: b) :: Bool - infix 6 `M1` - infixr 5 `sD1B` - infixr 5 `sD1A` - infixr 5 `SMkD1` - infix 5 `SC1` - sD1B :: - forall a b (t :: D1 a b). Sing t -> Sing (Apply D1BSym0 t :: b) - sD1A :: - forall a b (t :: D1 a b). Sing t -> Sing (Apply D1ASym0 t :: a) - sD1B (SMkD1 _ (sField :: Sing field)) = sField - sD1A (SMkD1 (sField :: Sing field) _) = sField - instance SingI (D1BSym0 :: (~>) (D1 a b) b) where - sing = singFun1 @D1BSym0 sD1B - instance SingI (D1ASym0 :: (~>) (D1 a b) a) where - sing = singFun1 @D1ASym0 sD1A - data SD1 :: forall a b. D1 a b -> Type - where - SMkD1 :: forall a b (n :: a) (n :: b). - (Sing n) -> (Sing n) -> SD1 (MkD1 n n :: D1 a b) - type instance Sing @(D1 a b) = SD1 - instance (SingKind a, SingKind b) => SingKind (D1 a b) where - type Demote (D1 a b) = D1 (Demote a) (Demote b) - fromSing (SMkD1 b b) = MkD1 (fromSing b) (fromSing b) - toSing (MkD1 (b :: Demote a) (b :: Demote b)) - = case (,) (toSing b :: SomeSing a) (toSing b :: SomeSing b) of - (,) (SomeSing c) (SomeSing c) -> SomeSing (SMkD1 c c) - class SC1 a b where - sM1 :: - (forall (t :: a) (t :: b). - Sing t - -> Sing t -> Sing (Apply (Apply M1Sym0 t) t :: Bool) :: Type) - infix 6 `sM1` - instance (SingI n, SingI n) => SingI (MkD1 (n :: a) (n :: b)) where - sing = SMkD1 sing sing - instance SingI n => SingI1 (MkD1 (n :: a)) where - liftSing = SMkD1 sing - instance SingI2 MkD1 where - liftSing2 = SMkD1 - instance SingI (MkD1Sym0 :: (~>) a ((~>) b (D1 a b))) where - sing = singFun2 @MkD1Sym0 SMkD1 - instance SingI d => - SingI (MkD1Sym1 (d :: a) :: (~>) b (D1 a b)) where - sing = singFun1 @(MkD1Sym1 (d :: a)) (SMkD1 (sing @d)) - instance SingI1 (MkD1Sym1 :: a -> (~>) b (D1 a b)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkD1Sym1 (d :: a)) (SMkD1 s) - instance SC1 a b => SingI (M1Sym0 :: (~>) a ((~>) b Bool)) where - sing = singFun2 @M1Sym0 sM1 - instance (SC1 a b, SingI d) => - SingI (M1Sym1 (d :: a) :: (~>) b Bool) where - sing = singFun1 @(M1Sym1 (d :: a)) (sM1 (sing @d)) - instance SC1 a b => SingI1 (M1Sym1 :: a -> (~>) b Bool) where - liftSing (s :: Sing (d :: a)) = singFun1 @(M1Sym1 (d :: a)) (sM1 s) -Singletons/T412.hs:0:0:: Splicing declarations - genSingletons [''C2, ''T2a, ''T2b, ''D2] - ======> - type M2Sym0 :: forall a b. (~>) a ((~>) b Bool) - data M2Sym0 :: (~>) a ((~>) b Bool) - where - M2Sym0KindInference :: SameKind (Apply M2Sym0 arg) (M2Sym1 arg) => - M2Sym0 a0123456789876543210 - type instance Apply M2Sym0 a0123456789876543210 = M2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings M2Sym0 where - suppressUnusedWarnings = snd ((,) M2Sym0KindInference ()) - infix 6 `M2Sym0` - type M2Sym1 :: forall a b. a -> (~>) b Bool - data M2Sym1 (a0123456789876543210 :: a) :: (~>) b Bool - where - M2Sym1KindInference :: SameKind (Apply (M2Sym1 a0123456789876543210) arg) (M2Sym2 a0123456789876543210 arg) => - M2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (M2Sym1 a0123456789876543210) a0123456789876543210 = M2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (M2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) M2Sym1KindInference ()) - infix 6 `M2Sym1` - type M2Sym2 :: forall a b. a -> b -> Bool - type family M2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Bool where - M2Sym2 a0123456789876543210 a0123456789876543210 = M2 a0123456789876543210 a0123456789876543210 - infix 6 `M2Sym2` - type PC2 :: Type -> Type -> Constraint - class PC2 (a :: Type) (b :: Type) where - type family M2 (arg :: a) (arg :: b) :: Bool - infix 5 `PC2` - infix 6 `M2` - class SC2 (a :: Type) (b :: Type) where - sM2 :: - (forall (t :: a) (t :: b). - Sing t - -> Sing t -> Sing (Apply (Apply M2Sym0 t) t :: Bool) :: Type) - type SC2 :: Type -> Type -> Constraint - infix 5 `SC2` - infix 6 `sM2` - instance SC2 a b => SingI (M2Sym0 :: (~>) a ((~>) b Bool)) where - sing = singFun2 @M2Sym0 sM2 - instance (SC2 a b, SingI d) => - SingI (M2Sym1 (d :: a) :: (~>) b Bool) where - sing = singFun1 @(M2Sym1 (d :: a)) (sM2 (sing @d)) - instance SC2 a b => SingI1 (M2Sym1 :: a -> (~>) b Bool) where - liftSing (s :: Sing (d :: a)) = singFun1 @(M2Sym1 (d :: a)) (sM2 s) - type T2aSym0 :: (~>) Type ((~>) Type Type) - data T2aSym0 :: (~>) Type ((~>) Type Type) - where - T2aSym0KindInference :: SameKind (Apply T2aSym0 arg) (T2aSym1 arg) => - T2aSym0 a0123456789876543210 - type instance Apply T2aSym0 a0123456789876543210 = T2aSym1 a0123456789876543210 - instance SuppressUnusedWarnings T2aSym0 where - suppressUnusedWarnings = snd ((,) T2aSym0KindInference ()) - infixl 5 `T2aSym0` - type T2aSym1 :: Type -> (~>) Type Type - data T2aSym1 (a0123456789876543210 :: Type) :: (~>) Type Type - where - T2aSym1KindInference :: SameKind (Apply (T2aSym1 a0123456789876543210) arg) (T2aSym2 a0123456789876543210 arg) => - T2aSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (T2aSym1 a0123456789876543210) a0123456789876543210 = T2a a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (T2aSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T2aSym1KindInference ()) - infixl 5 `T2aSym1` - type T2aSym2 :: Type -> Type -> Type - type family T2aSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Type where - T2aSym2 a0123456789876543210 a0123456789876543210 = T2a a0123456789876543210 a0123456789876543210 - infixl 5 `T2aSym2` - type T2bSym0 :: (~>) Type ((~>) Type Type) - data T2bSym0 :: (~>) Type ((~>) Type Type) - where - T2bSym0KindInference :: SameKind (Apply T2bSym0 arg) (T2bSym1 arg) => - T2bSym0 a0123456789876543210 - type instance Apply T2bSym0 a0123456789876543210 = T2bSym1 a0123456789876543210 - instance SuppressUnusedWarnings T2bSym0 where - suppressUnusedWarnings = snd ((,) T2bSym0KindInference ()) - infixl 5 `T2bSym0` - type T2bSym1 :: Type -> (~>) Type Type - data T2bSym1 (a0123456789876543210 :: Type) :: (~>) Type Type - where - T2bSym1KindInference :: SameKind (Apply (T2bSym1 a0123456789876543210) arg) (T2bSym2 a0123456789876543210 arg) => - T2bSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (T2bSym1 a0123456789876543210) a0123456789876543210 = T2b a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (T2bSym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T2bSym1KindInference ()) - infixl 5 `T2bSym1` - type T2bSym2 :: Type -> Type -> Type - type family T2bSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Type where - T2bSym2 a0123456789876543210 a0123456789876543210 = T2b a0123456789876543210 a0123456789876543210 - infixl 5 `T2bSym2` - type MkD2Sym0 :: forall (a :: Type) - (b :: Type). (~>) a ((~>) b (D2 (a :: Type) (b :: Type))) - data MkD2Sym0 :: (~>) a ((~>) b (D2 (a :: Type) (b :: Type))) - where - MkD2Sym0KindInference :: SameKind (Apply MkD2Sym0 arg) (MkD2Sym1 arg) => - MkD2Sym0 a0123456789876543210 - type instance Apply MkD2Sym0 a0123456789876543210 = MkD2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings MkD2Sym0 where - suppressUnusedWarnings = snd ((,) MkD2Sym0KindInference ()) - infixr 5 `MkD2Sym0` - type MkD2Sym1 :: forall (a :: Type) (b :: Type). a - -> (~>) b (D2 (a :: Type) (b :: Type)) - data MkD2Sym1 (a0123456789876543210 :: a) :: (~>) b (D2 (a :: Type) (b :: Type)) - where - MkD2Sym1KindInference :: SameKind (Apply (MkD2Sym1 a0123456789876543210) arg) (MkD2Sym2 a0123456789876543210 arg) => - MkD2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MkD2Sym1 a0123456789876543210) a0123456789876543210 = 'MkD2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MkD2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) MkD2Sym1KindInference ()) - infixr 5 `MkD2Sym1` - type MkD2Sym2 :: forall (a :: Type) (b :: Type). a - -> b -> D2 (a :: Type) (b :: Type) - type family MkD2Sym2 (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: D2 (a :: Type) (b :: Type) where - MkD2Sym2 a0123456789876543210 a0123456789876543210 = 'MkD2 a0123456789876543210 a0123456789876543210 - infixr 5 `MkD2Sym2` - infixr 5 `D2A` - infixr 5 `D2B` - type D2BSym0 :: forall (a :: Type) - (b :: Type). (~>) (D2 (a :: Type) (b :: Type)) b - data D2BSym0 :: (~>) (D2 (a :: Type) (b :: Type)) b - where - D2BSym0KindInference :: SameKind (Apply D2BSym0 arg) (D2BSym1 arg) => - D2BSym0 a0123456789876543210 - type instance Apply D2BSym0 a0123456789876543210 = D2B a0123456789876543210 - instance SuppressUnusedWarnings D2BSym0 where - suppressUnusedWarnings = snd ((,) D2BSym0KindInference ()) - type D2BSym1 :: forall (a :: Type) - (b :: Type). D2 (a :: Type) (b :: Type) -> b - type family D2BSym1 (a0123456789876543210 :: D2 (a :: Type) (b :: Type)) :: b where - D2BSym1 a0123456789876543210 = D2B a0123456789876543210 - type D2ASym0 :: forall (a :: Type) - (b :: Type). (~>) (D2 (a :: Type) (b :: Type)) a - data D2ASym0 :: (~>) (D2 (a :: Type) (b :: Type)) a - where - D2ASym0KindInference :: SameKind (Apply D2ASym0 arg) (D2ASym1 arg) => - D2ASym0 a0123456789876543210 - type instance Apply D2ASym0 a0123456789876543210 = D2A a0123456789876543210 - instance SuppressUnusedWarnings D2ASym0 where - suppressUnusedWarnings = snd ((,) D2ASym0KindInference ()) - type D2ASym1 :: forall (a :: Type) - (b :: Type). D2 (a :: Type) (b :: Type) -> a - type family D2ASym1 (a0123456789876543210 :: D2 (a :: Type) (b :: Type)) :: a where - D2ASym1 a0123456789876543210 = D2A a0123456789876543210 - type D2B :: forall (a :: Type) - (b :: Type). D2 (a :: Type) (b :: Type) -> b - type family D2B (a :: D2 (a :: Type) (b :: Type)) :: b where - D2B ('MkD2 _ field) = field - type D2A :: forall (a :: Type) - (b :: Type). D2 (a :: Type) (b :: Type) -> a - type family D2A (a :: D2 (a :: Type) (b :: Type)) :: a where - D2A ('MkD2 field _) = field - sD2B :: - forall (a :: Type) - (b :: Type) - (t :: D2 (a :: Type) (b :: Type)). Sing t - -> Sing (Apply D2BSym0 t :: b) - sD2A :: - forall (a :: Type) - (b :: Type) - (t :: D2 (a :: Type) (b :: Type)). Sing t - -> Sing (Apply D2ASym0 t :: a) - sD2B (SMkD2 _ (sField :: Sing field)) = sField - sD2A (SMkD2 (sField :: Sing field) _) = sField - instance SingI (D2BSym0 :: (~>) (D2 (a :: Type) (b :: Type)) b) where - sing = singFun1 @D2BSym0 sD2B - instance SingI (D2ASym0 :: (~>) (D2 (a :: Type) (b :: Type)) a) where - sing = singFun1 @D2ASym0 sD2A - type SD2 :: forall (a :: Type) (b :: Type). D2 a b -> Type - data SD2 :: forall (a :: Type) (b :: Type). D2 a b -> Type - where - SMkD2 :: forall (a :: Type) (b :: Type) (n :: a) (n :: b). - (Sing n) -> - (Sing n) -> - SD2 ('MkD2 n n :: D2 (a :: Type) (b :: Type)) - type instance Sing @(D2 a b) = SD2 - instance (SingKind a, SingKind b) => SingKind (D2 a b) where - type Demote (D2 a b) = D2 (Demote a) (Demote b) - fromSing (SMkD2 b b) = MkD2 (fromSing b) (fromSing b) - toSing (MkD2 (b :: Demote a) (b :: Demote b)) - = case (,) (toSing b :: SomeSing a) (toSing b :: SomeSing b) of - (,) (SomeSing c) (SomeSing c) -> SomeSing (SMkD2 c c) - infixr 5 `SMkD2` - infixr 5 `sD2A` - infixr 5 `sD2B` - instance (SingI n, SingI n) => - SingI ('MkD2 (n :: a) (n :: b)) where - sing = SMkD2 sing sing - instance SingI n => SingI1 ('MkD2 (n :: a)) where - liftSing = SMkD2 sing - instance SingI2 'MkD2 where - liftSing2 = SMkD2 - instance SingI (MkD2Sym0 :: (~>) a ((~>) b (D2 (a :: Type) (b :: Type)))) where - sing = singFun2 @MkD2Sym0 SMkD2 - instance SingI d => - SingI (MkD2Sym1 (d :: a) :: (~>) b (D2 (a :: Type) (b :: Type))) where - sing = singFun1 @(MkD2Sym1 (d :: a)) (SMkD2 (sing @d)) - instance SingI1 (MkD2Sym1 :: a - -> (~>) b (D2 (a :: Type) (b :: Type))) where - liftSing (s :: Sing (d :: a)) - = singFun1 @(MkD2Sym1 (d :: a)) (SMkD2 s) +Singletons/T412.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| infixr 5 `D1`, `MkD1`, `d1A`, `d1B`+ infixl 5 `T1a`, `T1b`+ infix 5 `C1`+ + class C1 a b where+ infix 6 `m1`+ m1 :: a -> b -> Bool+ type T1a a b = Either a b+ type family T1b a b where+ T1b a b = Either a b+ data D1 a b = MkD1 {d1A :: a, d1B :: b} |]+ ======>+ infix 5 `C1`+ class C1 a b where+ infix 6 `m1`+ m1 :: a -> b -> Bool+ infixl 5 `T1a`+ infixl 5 `T1b`+ type T1a a b = Either a b+ type family T1b a b where+ T1b a b = Either a b+ infixr 5 `D1`+ infixr 5 `MkD1`+ infixr 5 `d1A`+ infixr 5 `d1B`+ data D1 a b = MkD1 {d1A :: a, d1B :: b}+ data T1aSym0 a0123456789876543210+ where+ T1aSym0KindInference :: SameKind (Apply T1aSym0 arg) (T1aSym1 arg) =>+ T1aSym0 a0123456789876543210+ type instance Apply @_ @_ T1aSym0 a0123456789876543210 = T1aSym1 a0123456789876543210+ instance SuppressUnusedWarnings T1aSym0 where+ suppressUnusedWarnings = snd ((,) T1aSym0KindInference ())+ infixl 5 type `T1aSym0`+ data T1aSym1 a0123456789876543210 b0123456789876543210+ where+ T1aSym1KindInference :: SameKind (Apply (T1aSym1 a0123456789876543210) arg) (T1aSym2 a0123456789876543210 arg) =>+ T1aSym1 a0123456789876543210 b0123456789876543210+ type instance Apply @_ @_ (T1aSym1 a0123456789876543210) b0123456789876543210 = T1a a0123456789876543210 b0123456789876543210+ instance SuppressUnusedWarnings (T1aSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T1aSym1KindInference ())+ infixl 5 type `T1aSym1`+ type family T1aSym2 a0123456789876543210 b0123456789876543210 where+ T1aSym2 a0123456789876543210 b0123456789876543210 = T1a a0123456789876543210 b0123456789876543210+ infixl 5 type `T1aSym2`+ data T1bSym0 a0123456789876543210+ where+ T1bSym0KindInference :: SameKind (Apply T1bSym0 arg) (T1bSym1 arg) =>+ T1bSym0 a0123456789876543210+ type instance Apply @_ @_ T1bSym0 a0123456789876543210 = T1bSym1 a0123456789876543210+ instance SuppressUnusedWarnings T1bSym0 where+ suppressUnusedWarnings = snd ((,) T1bSym0KindInference ())+ infixl 5 type `T1bSym0`+ data T1bSym1 a0123456789876543210 b0123456789876543210+ where+ T1bSym1KindInference :: SameKind (Apply (T1bSym1 a0123456789876543210) arg) (T1bSym2 a0123456789876543210 arg) =>+ T1bSym1 a0123456789876543210 b0123456789876543210+ type instance Apply @_ @_ (T1bSym1 a0123456789876543210) b0123456789876543210 = T1b a0123456789876543210 b0123456789876543210+ instance SuppressUnusedWarnings (T1bSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T1bSym1KindInference ())+ infixl 5 type `T1bSym1`+ type family T1bSym2 a0123456789876543210 b0123456789876543210 where+ T1bSym2 a0123456789876543210 b0123456789876543210 = T1b a0123456789876543210 b0123456789876543210+ infixl 5 type `T1bSym2`+ type MkD1Sym0 :: forall a b. (~>) a ((~>) b (D1 a b))+ data MkD1Sym0 :: (~>) a ((~>) b (D1 a b))+ where+ MkD1Sym0KindInference :: SameKind (Apply MkD1Sym0 arg) (MkD1Sym1 arg) =>+ MkD1Sym0 a0123456789876543210+ type instance Apply @a @((~>) b (D1 a b)) MkD1Sym0 a0123456789876543210 = MkD1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkD1Sym0 where+ suppressUnusedWarnings = snd ((,) MkD1Sym0KindInference ())+ infixr 5 type `MkD1Sym0`+ type MkD1Sym1 :: forall a b. a -> (~>) b (D1 a b)+ data MkD1Sym1 (a0123456789876543210 :: a) :: (~>) b (D1 a b)+ where+ MkD1Sym1KindInference :: SameKind (Apply (MkD1Sym1 a0123456789876543210) arg) (MkD1Sym2 a0123456789876543210 arg) =>+ MkD1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(D1 a b) (MkD1Sym1 a0123456789876543210) a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkD1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkD1Sym1KindInference ())+ infixr 5 type `MkD1Sym1`+ type MkD1Sym2 :: forall a b. a -> b -> D1 a b+ type family MkD1Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: D1 a b where+ MkD1Sym2 a0123456789876543210 a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210+ infixr 5 type `MkD1Sym2`+ type D1BSym0 :: forall a b. (~>) (D1 a b) b+ data D1BSym0 :: (~>) (D1 a b) b+ where+ D1BSym0KindInference :: SameKind (Apply D1BSym0 arg) (D1BSym1 arg) =>+ D1BSym0 a0123456789876543210+ type instance Apply @(D1 a b) @b D1BSym0 a0123456789876543210 = D1B a0123456789876543210+ instance SuppressUnusedWarnings D1BSym0 where+ suppressUnusedWarnings = snd ((,) D1BSym0KindInference ())+ infixr 5 type `D1BSym0`+ type D1BSym1 :: forall a b. D1 a b -> b+ type family D1BSym1 @a @b (a0123456789876543210 :: D1 a b) :: b where+ D1BSym1 a0123456789876543210 = D1B a0123456789876543210+ infixr 5 type `D1BSym1`+ type D1ASym0 :: forall a b. (~>) (D1 a b) a+ data D1ASym0 :: (~>) (D1 a b) a+ where+ D1ASym0KindInference :: SameKind (Apply D1ASym0 arg) (D1ASym1 arg) =>+ D1ASym0 a0123456789876543210+ type instance Apply @(D1 a b) @a D1ASym0 a0123456789876543210 = D1A a0123456789876543210+ instance SuppressUnusedWarnings D1ASym0 where+ suppressUnusedWarnings = snd ((,) D1ASym0KindInference ())+ infixr 5 type `D1ASym0`+ type D1ASym1 :: forall a b. D1 a b -> a+ type family D1ASym1 @a @b (a0123456789876543210 :: D1 a b) :: a where+ D1ASym1 a0123456789876543210 = D1A a0123456789876543210+ infixr 5 type `D1ASym1`+ type D1B :: forall a b. D1 a b -> b+ type family D1B @a @b (a :: D1 a b) :: b where+ D1B @a @b (MkD1 _ field :: D1 a b) = field+ type D1A :: forall a b. D1 a b -> a+ type family D1A @a @b (a :: D1 a b) :: a where+ D1A @a @b (MkD1 field _ :: D1 a b) = field+ infixr 5 type `D1B`+ infixr 5 type `D1A`+ infix 5 type `PC1`+ type M1Sym0 :: forall a b. (~>) a ((~>) b Bool)+ data M1Sym0 :: (~>) a ((~>) b Bool)+ where+ M1Sym0KindInference :: SameKind (Apply M1Sym0 arg) (M1Sym1 arg) =>+ M1Sym0 a0123456789876543210+ type instance Apply @a @((~>) b Bool) M1Sym0 a0123456789876543210 = M1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings M1Sym0 where+ suppressUnusedWarnings = snd ((,) M1Sym0KindInference ())+ infix 6 type `M1Sym0`+ type M1Sym1 :: forall a b. a -> (~>) b Bool+ data M1Sym1 (a0123456789876543210 :: a) :: (~>) b Bool+ where+ M1Sym1KindInference :: SameKind (Apply (M1Sym1 a0123456789876543210) arg) (M1Sym2 a0123456789876543210 arg) =>+ M1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @Bool (M1Sym1 a0123456789876543210) a0123456789876543210 = M1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (M1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) M1Sym1KindInference ())+ infix 6 type `M1Sym1`+ type M1Sym2 :: forall a b. a -> b -> Bool+ type family M1Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Bool where+ M1Sym2 a0123456789876543210 a0123456789876543210 = M1 a0123456789876543210 a0123456789876543210+ infix 6 type `M1Sym2`+ class PC1 a b where+ type family M1 (arg :: a) (arg :: b) :: Bool+ infix 6 type `M1`+ infixr 5 data `sD1B`+ infixr 5 data `sD1A`+ infixr 5 data `SMkD1`+ infix 5 type `SC1`+ sD1B :: forall a b (t :: D1 a b). Sing t -> Sing (D1B t :: b)+ sD1A :: forall a b (t :: D1 a b). Sing t -> Sing (D1A t :: a)+ sD1B (SMkD1 _ (sField :: Sing field)) = sField+ sD1A (SMkD1 (sField :: Sing field) _) = sField+ instance SingI (D1BSym0 :: (~>) (D1 a b) b) where+ sing = singFun1 @D1BSym0 sD1B+ instance SingI (D1ASym0 :: (~>) (D1 a b) a) where+ sing = singFun1 @D1ASym0 sD1A+ data SD1 :: forall a b. D1 a b -> Type+ where+ SMkD1 :: forall a b (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SD1 (MkD1 n n :: D1 a b)+ type instance Sing @(D1 a b) = SD1+ instance (SingKind a, SingKind b) => SingKind (D1 a b) where+ type Demote (D1 a b) = D1 (Demote a) (Demote b)+ fromSing (SMkD1 b b) = MkD1 (fromSing b) (fromSing b)+ toSing (MkD1 (b :: Demote a) (b :: Demote b))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkD1 c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ class SC1 a b where+ sM1 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (M1 t t :: Bool) :: Type)+ infix 6 data `sM1`+ instance (SingI n, SingI n) => SingI (MkD1 (n :: a) (n :: b)) where+ sing = SMkD1 sing sing+ instance SingI n => SingI1 (MkD1 (n :: a)) where+ liftSing = SMkD1 sing+ instance SingI2 MkD1 where+ liftSing2 = SMkD1+ instance SingI (MkD1Sym0 :: (~>) a ((~>) b (D1 a b))) where+ sing = singFun2 @MkD1Sym0 SMkD1+ instance SingI d =>+ SingI (MkD1Sym1 (d :: a) :: (~>) b (D1 a b)) where+ sing = singFun1 @(MkD1Sym1 (d :: a)) (SMkD1 (sing @d))+ instance SingI1 (MkD1Sym1 :: a -> (~>) b (D1 a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkD1Sym1 (d :: a)) (SMkD1 s)+ instance SC1 a b => SingI (M1Sym0 :: (~>) a ((~>) b Bool)) where+ sing = singFun2 @M1Sym0 sM1+ instance (SC1 a b, SingI d) =>+ SingI (M1Sym1 (d :: a) :: (~>) b Bool) where+ sing = singFun1 @(M1Sym1 (d :: a)) (sM1 (sing @d))+ instance SC1 a b => SingI1 (M1Sym1 :: a -> (~>) b Bool) where+ liftSing (s :: Sing (d :: a)) = singFun1 @(M1Sym1 (d :: a)) (sM1 s)+Singletons/T412.hs:0:0:: Splicing declarations+ genSingletons [''C2, ''T2a, ''T2b, ''D2]+ ======>+ type M2Sym0 :: forall (a :: Type) (b :: Type). (~>) a ((~>) b Bool)+ data M2Sym0 :: (~>) a ((~>) b Bool)+ where+ M2Sym0KindInference :: SameKind (Apply M2Sym0 arg) (M2Sym1 arg) =>+ M2Sym0 a0123456789876543210+ type instance Apply @a @((~>) b Bool) M2Sym0 a0123456789876543210 = M2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings M2Sym0 where+ suppressUnusedWarnings = snd ((,) M2Sym0KindInference ())+ infix 6 type `M2Sym0`+ type M2Sym1 :: forall (a :: Type) (b :: Type). a -> (~>) b Bool+ data M2Sym1 (a0123456789876543210 :: a) :: (~>) b Bool+ where+ M2Sym1KindInference :: SameKind (Apply (M2Sym1 a0123456789876543210) arg) (M2Sym2 a0123456789876543210 arg) =>+ M2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @Bool (M2Sym1 a0123456789876543210) a0123456789876543210 = M2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (M2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) M2Sym1KindInference ())+ infix 6 type `M2Sym1`+ type M2Sym2 :: forall (a :: Type) (b :: Type). a -> b -> Bool+ type family M2Sym2 @(a :: Type) @(b :: Type) (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: Bool where+ M2Sym2 a0123456789876543210 a0123456789876543210 = M2 a0123456789876543210 a0123456789876543210+ infix 6 type `M2Sym2`+ type PC2 :: Type -> Type -> Constraint+ class PC2 (a :: Type) (b :: Type) where+ type family M2 (arg :: a) (arg :: b) :: Bool+ infix 5 type `PC2`+ infix 6 type `M2`+ class SC2 (a :: Type) (b :: Type) where+ sM2 ::+ (forall (t :: a) (t :: b).+ Sing t -> Sing t -> Sing (M2 t t :: Bool) :: Type)+ type SC2 :: Type -> Type -> Constraint+ infix 5 type `SC2`+ infix 6 data `sM2`+ instance SC2 a b => SingI (M2Sym0 :: (~>) a ((~>) b Bool)) where+ sing = singFun2 @M2Sym0 sM2+ instance (SC2 a b, SingI d) =>+ SingI (M2Sym1 (d :: a) :: (~>) b Bool) where+ sing = singFun1 @(M2Sym1 (d :: a)) (sM2 (sing @d))+ instance SC2 a b => SingI1 (M2Sym1 :: a -> (~>) b Bool) where+ liftSing (s :: Sing (d :: a)) = singFun1 @(M2Sym1 (d :: a)) (sM2 s)+ type T2aSym0 :: (~>) Type ((~>) Type Type)+ data T2aSym0 :: (~>) Type ((~>) Type Type)+ where+ T2aSym0KindInference :: SameKind (Apply T2aSym0 arg) (T2aSym1 arg) =>+ T2aSym0 a0123456789876543210+ type instance Apply @Type @((~>) Type Type) T2aSym0 a0123456789876543210 = T2aSym1 a0123456789876543210+ instance SuppressUnusedWarnings T2aSym0 where+ suppressUnusedWarnings = snd ((,) T2aSym0KindInference ())+ infixl 5 type `T2aSym0`+ type T2aSym1 :: Type -> (~>) Type Type+ data T2aSym1 (a0123456789876543210 :: Type) :: (~>) Type Type+ where+ T2aSym1KindInference :: SameKind (Apply (T2aSym1 a0123456789876543210) arg) (T2aSym2 a0123456789876543210 arg) =>+ T2aSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Type @Type (T2aSym1 a0123456789876543210) a0123456789876543210 = T2a a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (T2aSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T2aSym1KindInference ())+ infixl 5 type `T2aSym1`+ type T2aSym2 :: Type -> Type -> Type+ type family T2aSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Type where+ T2aSym2 a0123456789876543210 a0123456789876543210 = T2a a0123456789876543210 a0123456789876543210+ infixl 5 type `T2aSym2`+ type T2bSym0 :: (~>) Type ((~>) Type Type)+ data T2bSym0 :: (~>) Type ((~>) Type Type)+ where+ T2bSym0KindInference :: SameKind (Apply T2bSym0 arg) (T2bSym1 arg) =>+ T2bSym0 a0123456789876543210+ type instance Apply @Type @((~>) Type Type) T2bSym0 a0123456789876543210 = T2bSym1 a0123456789876543210+ instance SuppressUnusedWarnings T2bSym0 where+ suppressUnusedWarnings = snd ((,) T2bSym0KindInference ())+ infixl 5 type `T2bSym0`+ type T2bSym1 :: Type -> (~>) Type Type+ data T2bSym1 (a0123456789876543210 :: Type) :: (~>) Type Type+ where+ T2bSym1KindInference :: SameKind (Apply (T2bSym1 a0123456789876543210) arg) (T2bSym2 a0123456789876543210 arg) =>+ T2bSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Type @Type (T2bSym1 a0123456789876543210) a0123456789876543210 = T2b a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (T2bSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T2bSym1KindInference ())+ infixl 5 type `T2bSym1`+ type T2bSym2 :: Type -> Type -> Type+ type family T2bSym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) :: Type where+ T2bSym2 a0123456789876543210 a0123456789876543210 = T2b a0123456789876543210 a0123456789876543210+ infixl 5 type `T2bSym2`+ type MkD2Sym0 :: forall (a :: Type)+ (b :: Type). (~>) a ((~>) b (D2 a b))+ data MkD2Sym0 :: (~>) a ((~>) b (D2 a b))+ where+ MkD2Sym0KindInference :: SameKind (Apply MkD2Sym0 arg) (MkD2Sym1 arg) =>+ MkD2Sym0 a0123456789876543210+ type instance Apply @a @((~>) b (D2 a b)) MkD2Sym0 a0123456789876543210 = MkD2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkD2Sym0 where+ suppressUnusedWarnings = snd ((,) MkD2Sym0KindInference ())+ infixr 5 type `MkD2Sym0`+ type MkD2Sym1 :: forall (a :: Type) (b :: Type). a+ -> (~>) b (D2 a b)+ data MkD2Sym1 (a0123456789876543210 :: a) :: (~>) b (D2 a b)+ where+ MkD2Sym1KindInference :: SameKind (Apply (MkD2Sym1 a0123456789876543210) arg) (MkD2Sym2 a0123456789876543210 arg) =>+ MkD2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(D2 a b) (MkD2Sym1 a0123456789876543210) a0123456789876543210 = 'MkD2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkD2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkD2Sym1KindInference ())+ infixr 5 type `MkD2Sym1`+ type MkD2Sym2 :: forall (a :: Type) (b :: Type). a -> b -> D2 a b+ type family MkD2Sym2 @(a :: Type) @(b :: Type) (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: D2 a b where+ MkD2Sym2 a0123456789876543210 a0123456789876543210 = 'MkD2 a0123456789876543210 a0123456789876543210+ infixr 5 type `MkD2Sym2`+ infixr 5 type `D2A`+ infixr 5 type `D2B`+ type D2BSym0 :: forall (a :: Type) (b :: Type). (~>) (D2 a b) b+ data D2BSym0 :: (~>) (D2 a b) b+ where+ D2BSym0KindInference :: SameKind (Apply D2BSym0 arg) (D2BSym1 arg) =>+ D2BSym0 a0123456789876543210+ type instance Apply @(D2 a b) @b D2BSym0 a0123456789876543210 = D2B a0123456789876543210+ instance SuppressUnusedWarnings D2BSym0 where+ suppressUnusedWarnings = snd ((,) D2BSym0KindInference ())+ type D2BSym1 :: forall (a :: Type) (b :: Type). D2 a b -> b+ type family D2BSym1 @(a :: Type) @(b :: Type) (a0123456789876543210 :: D2 a b) :: b where+ D2BSym1 a0123456789876543210 = D2B a0123456789876543210+ type D2ASym0 :: forall (a :: Type) (b :: Type). (~>) (D2 a b) a+ data D2ASym0 :: (~>) (D2 a b) a+ where+ D2ASym0KindInference :: SameKind (Apply D2ASym0 arg) (D2ASym1 arg) =>+ D2ASym0 a0123456789876543210+ type instance Apply @(D2 a b) @a D2ASym0 a0123456789876543210 = D2A a0123456789876543210+ instance SuppressUnusedWarnings D2ASym0 where+ suppressUnusedWarnings = snd ((,) D2ASym0KindInference ())+ type D2ASym1 :: forall (a :: Type) (b :: Type). D2 a b -> a+ type family D2ASym1 @(a :: Type) @(b :: Type) (a0123456789876543210 :: D2 a b) :: a where+ D2ASym1 a0123456789876543210 = D2A a0123456789876543210+ type D2B :: forall (a :: Type) (b :: Type). D2 a b -> b+ type family D2B @(a :: Type) @(b :: Type) (a :: D2 a b) :: b where+ D2B @a @b ('MkD2 _ field :: D2 a b) = field+ type D2A :: forall (a :: Type) (b :: Type). D2 a b -> a+ type family D2A @(a :: Type) @(b :: Type) (a :: D2 a b) :: a where+ D2A @a @b ('MkD2 field _ :: D2 a b) = field+ sD2B ::+ forall (a :: Type) (b :: Type) (t :: D2 a b). Sing t+ -> Sing (D2B t :: b)+ sD2A ::+ forall (a :: Type) (b :: Type) (t :: D2 a b). Sing t+ -> Sing (D2A t :: a)+ sD2B (SMkD2 _ (sField :: Sing field)) = sField+ sD2A (SMkD2 (sField :: Sing field) _) = sField+ instance SingI (D2BSym0 :: (~>) (D2 a b) b) where+ sing = singFun1 @D2BSym0 sD2B+ instance SingI (D2ASym0 :: (~>) (D2 a b) a) where+ sing = singFun1 @D2ASym0 sD2A+ type SD2 :: forall (a :: Type) (b :: Type). D2 a b -> Type+ data SD2 :: forall (a :: Type) (b :: Type). D2 a b -> Type+ where+ SMkD2 :: forall (a :: Type) (b :: Type) (n :: a) (n :: b).+ (Sing n) -> (Sing n) -> SD2 ('MkD2 n n :: D2 a b)+ type instance Sing @(D2 a b) = SD2+ instance (SingKind a, SingKind b) => SingKind (D2 a b) where+ type Demote (D2 a b) = D2 (Demote a) (Demote b)+ fromSing (SMkD2 b b) = MkD2 (fromSing b) (fromSing b)+ toSing (MkD2 (b :: Demote a) (b :: Demote b))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SMkD2 c c))+ (toSing b :: SomeSing a) (toSing b :: SomeSing b)+ infixr 5 data `SMkD2`+ infixr 5 data `sD2A`+ infixr 5 data `sD2B`+ instance (SingI n, SingI n) =>+ SingI ('MkD2 (n :: a) (n :: b)) where+ sing = SMkD2 sing sing+ instance SingI n => SingI1 ('MkD2 (n :: a)) where+ liftSing = SMkD2 sing+ instance SingI2 'MkD2 where+ liftSing2 = SMkD2+ instance SingI (MkD2Sym0 :: (~>) a ((~>) b (D2 a b))) where+ sing = singFun2 @MkD2Sym0 SMkD2+ instance SingI d =>+ SingI (MkD2Sym1 (d :: a) :: (~>) b (D2 a b)) where+ sing = singFun1 @(MkD2Sym1 (d :: a)) (SMkD2 (sing @d))+ instance SingI1 (MkD2Sym1 :: a -> (~>) b (D2 a b)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(MkD2Sym1 (d :: a)) (SMkD2 s)
tests/compile-and-dump/Singletons/T412.hs view
@@ -1,33 +1,33 @@-module T412 where - -import Data.Singletons.TH - -$(singletons [d| - infix 5 `C1` - class C1 a b where - infix 6 `m1` - m1 :: a -> b -> Bool - - infixl 5 `T1a`, `T1b` - type T1a a b = Either a b - type family T1b a b where - T1b a b = Either a b - - infixr 5 `D1`, `MkD1`, `d1A`, `d1B` - data D1 a b = MkD1 { d1A :: a, d1B :: b } - |]) - -infix 5 `C2` -class C2 a b where - infix 6 `m2` - m2 :: a -> b -> Bool - -infixl 5 `T2a`, `T2b` -type T2a a b = Either a b -type family T2b a b where - T2b a b = Either a b - -infixr 5 `D2`, `MkD2`, `d2A`, `d2B` -data D2 a b = MkD2 { d2A :: a, d2B :: b } - -$(genSingletons [''C2, ''T2a, ''T2b, ''D2]) +module T412 where++import Data.Singletons.TH++$(singletons [d|+ infix 5 `C1`+ class C1 a b where+ infix 6 `m1`+ m1 :: a -> b -> Bool++ infixl 5 `T1a`, `T1b`+ type T1a a b = Either a b+ type family T1b a b where+ T1b a b = Either a b++ infixr 5 `D1`, `MkD1`, `d1A`, `d1B`+ data D1 a b = MkD1 { d1A :: a, d1B :: b }+ |])++infix 5 `C2`+class C2 a b where+ infix 6 `m2`+ m2 :: a -> b -> Bool++infixl 5 `T2a`, `T2b`+type T2a a b = Either a b+type family T2b a b where+ T2b a b = Either a b++infixr 5 `D2`, `MkD2`, `d2A`, `d2B`+data D2 a b = MkD2 { d2A :: a, d2B :: b }++$(genSingletons [''C2, ''T2a, ''T2b, ''D2])
tests/compile-and-dump/Singletons/T414.golden view
@@ -1,77 +1,77 @@-Singletons/T414.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| type C3 :: Bool -> Constraint - - class C1 (a :: Bool) where - type T1 a b - class C2 a where - type T2 a b - class C3 a where - type T3 a b |] - ======> - class C1 (a :: Bool) where - type family T1 a b - class C2 a where - type family T2 a b - type C3 :: Bool -> Constraint - class C3 a where - type family T3 a b - data T1Sym0 a0123456789876543210 - where - T1Sym0KindInference :: SameKind (Apply T1Sym0 arg) (T1Sym1 arg) => - T1Sym0 a0123456789876543210 - type instance Apply T1Sym0 a0123456789876543210 = T1Sym1 a0123456789876543210 - instance SuppressUnusedWarnings T1Sym0 where - suppressUnusedWarnings = snd ((,) T1Sym0KindInference ()) - data T1Sym1 (a0123456789876543210 :: Bool) b0123456789876543210 - where - T1Sym1KindInference :: SameKind (Apply (T1Sym1 a0123456789876543210) arg) (T1Sym2 a0123456789876543210 arg) => - T1Sym1 a0123456789876543210 b0123456789876543210 - type instance Apply (T1Sym1 a0123456789876543210) b0123456789876543210 = T1 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (T1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T1Sym1KindInference ()) - type family T1Sym2 (a0123456789876543210 :: Bool) b0123456789876543210 where - T1Sym2 a0123456789876543210 b0123456789876543210 = T1 a0123456789876543210 b0123456789876543210 - class PC1 (a :: Bool) - data T2Sym0 a0123456789876543210 - where - T2Sym0KindInference :: SameKind (Apply T2Sym0 arg) (T2Sym1 arg) => - T2Sym0 a0123456789876543210 - type instance Apply T2Sym0 a0123456789876543210 = T2Sym1 a0123456789876543210 - instance SuppressUnusedWarnings T2Sym0 where - suppressUnusedWarnings = snd ((,) T2Sym0KindInference ()) - data T2Sym1 a0123456789876543210 b0123456789876543210 - where - T2Sym1KindInference :: SameKind (Apply (T2Sym1 a0123456789876543210) arg) (T2Sym2 a0123456789876543210 arg) => - T2Sym1 a0123456789876543210 b0123456789876543210 - type instance Apply (T2Sym1 a0123456789876543210) b0123456789876543210 = T2 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (T2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T2Sym1KindInference ()) - type family T2Sym2 a0123456789876543210 b0123456789876543210 where - T2Sym2 a0123456789876543210 b0123456789876543210 = T2 a0123456789876543210 b0123456789876543210 - class PC2 a - type T3Sym0 :: (~>) Bool ((~>) Type Type) - data T3Sym0 :: (~>) Bool ((~>) Type Type) - where - T3Sym0KindInference :: SameKind (Apply T3Sym0 arg) (T3Sym1 arg) => - T3Sym0 a0123456789876543210 - type instance Apply T3Sym0 a0123456789876543210 = T3Sym1 a0123456789876543210 - instance SuppressUnusedWarnings T3Sym0 where - suppressUnusedWarnings = snd ((,) T3Sym0KindInference ()) - type T3Sym1 :: Bool -> (~>) Type Type - data T3Sym1 (a0123456789876543210 :: Bool) :: (~>) Type Type - where - T3Sym1KindInference :: SameKind (Apply (T3Sym1 a0123456789876543210) arg) (T3Sym2 a0123456789876543210 arg) => - T3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (T3Sym1 a0123456789876543210) a0123456789876543210 = T3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (T3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd ((,) T3Sym1KindInference ()) - type T3Sym2 :: Bool -> Type -> Type - type family T3Sym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Type) :: Type where - T3Sym2 a0123456789876543210 a0123456789876543210 = T3 a0123456789876543210 a0123456789876543210 - type PC3 :: Bool -> Constraint - class PC3 a - class SC1 (a :: Bool) - class SC2 a - class SC3 a - type SC3 :: Bool -> Constraint +Singletons/T414.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| type C3 :: Bool -> Constraint+ + class C1 (a :: Bool) where+ type T1 a b+ class C2 a where+ type T2 a b+ class C3 a where+ type T3 a b |]+ ======>+ class C1 (a :: Bool) where+ type family T1 a b+ class C2 a where+ type family T2 a b+ type C3 :: Bool -> Constraint+ class C3 a where+ type family T3 a b+ data T1Sym0 a0123456789876543210+ where+ T1Sym0KindInference :: SameKind (Apply T1Sym0 arg) (T1Sym1 arg) =>+ T1Sym0 a0123456789876543210+ type instance Apply @Bool @_ T1Sym0 a0123456789876543210 = T1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings T1Sym0 where+ suppressUnusedWarnings = snd ((,) T1Sym0KindInference ())+ data T1Sym1 (a0123456789876543210 :: Bool) b0123456789876543210+ where+ T1Sym1KindInference :: SameKind (Apply (T1Sym1 a0123456789876543210) arg) (T1Sym2 a0123456789876543210 arg) =>+ T1Sym1 a0123456789876543210 b0123456789876543210+ type instance Apply @_ @_ (T1Sym1 a0123456789876543210) b0123456789876543210 = T1 a0123456789876543210 b0123456789876543210+ instance SuppressUnusedWarnings (T1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T1Sym1KindInference ())+ type family T1Sym2 (a0123456789876543210 :: Bool) b0123456789876543210 where+ T1Sym2 a0123456789876543210 b0123456789876543210 = T1 a0123456789876543210 b0123456789876543210+ class PC1 (a :: Bool)+ data T2Sym0 a0123456789876543210+ where+ T2Sym0KindInference :: SameKind (Apply T2Sym0 arg) (T2Sym1 arg) =>+ T2Sym0 a0123456789876543210+ type instance Apply @_ @_ T2Sym0 a0123456789876543210 = T2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings T2Sym0 where+ suppressUnusedWarnings = snd ((,) T2Sym0KindInference ())+ data T2Sym1 a0123456789876543210 b0123456789876543210+ where+ T2Sym1KindInference :: SameKind (Apply (T2Sym1 a0123456789876543210) arg) (T2Sym2 a0123456789876543210 arg) =>+ T2Sym1 a0123456789876543210 b0123456789876543210+ type instance Apply @_ @_ (T2Sym1 a0123456789876543210) b0123456789876543210 = T2 a0123456789876543210 b0123456789876543210+ instance SuppressUnusedWarnings (T2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T2Sym1KindInference ())+ type family T2Sym2 a0123456789876543210 b0123456789876543210 where+ T2Sym2 a0123456789876543210 b0123456789876543210 = T2 a0123456789876543210 b0123456789876543210+ class PC2 a+ type T3Sym0 :: (~>) Bool ((~>) Type Type)+ data T3Sym0 :: (~>) Bool ((~>) Type Type)+ where+ T3Sym0KindInference :: SameKind (Apply T3Sym0 arg) (T3Sym1 arg) =>+ T3Sym0 a0123456789876543210+ type instance Apply @Bool @((~>) Type Type) T3Sym0 a0123456789876543210 = T3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings T3Sym0 where+ suppressUnusedWarnings = snd ((,) T3Sym0KindInference ())+ type T3Sym1 :: Bool -> (~>) Type Type+ data T3Sym1 (a0123456789876543210 :: Bool) :: (~>) Type Type+ where+ T3Sym1KindInference :: SameKind (Apply (T3Sym1 a0123456789876543210) arg) (T3Sym2 a0123456789876543210 arg) =>+ T3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Type @Type (T3Sym1 a0123456789876543210) a0123456789876543210 = T3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (T3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) T3Sym1KindInference ())+ type T3Sym2 :: Bool -> Type -> Type+ type family T3Sym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Type) :: Type where+ T3Sym2 a0123456789876543210 a0123456789876543210 = T3 a0123456789876543210 a0123456789876543210+ type PC3 :: Bool -> Constraint+ class PC3 a+ class SC1 (a :: Bool)+ class SC2 a+ class SC3 a+ type SC3 :: Bool -> Constraint
tests/compile-and-dump/Singletons/T414.hs view
@@ -1,16 +1,16 @@-module T414 where - -import Data.Kind -import Data.Singletons.TH - -$(singletons [d| - class C1 (a :: Bool) where - type T1 a b - - class C2 a where - type T2 a b - - type C3 :: Bool -> Constraint - class C3 a where - type T3 a b - |]) +module T414 where++import Data.Kind+import Data.Singletons.TH++$(singletons [d|+ class C1 (a :: Bool) where+ type T1 a b++ class C2 a where+ type T2 a b++ type C3 :: Bool -> Constraint+ class C3 a where+ type T3 a b+ |])
+ tests/compile-and-dump/Singletons/T433.golden view
@@ -0,0 +1,285 @@+Singletons/T433.hs:(0,0)-(0,0): Splicing declarations+ promote+ [d| konst1 :: a -> Bool -> a+ konst1 x _ = x+ konst2 :: a -> Maybe Bool -> a+ konst2 x _ = x+ f local+ = g+ where+ g :: forall a. a -> a+ g x = konst1 (x :: a) local+ foo :: forall a. a -> ()+ foo x = const () (Nothing :: Maybe a)+ id2 :: forall a. a -> a+ id2 x = id (x :: a)+ id3 :: a -> a+ id3 (x :: b) = id (x :: b)+ id4 :: forall a. a -> a+ id4 (x :: a) = id (x :: a)+ id5 :: forall a. a -> a+ id5+ = g+ where+ g = id :: a -> a+ id6 :: a -> a+ id6 (x :: b)+ = g+ where+ g = (x :: b)+ id7 (x :: b)+ = g+ where+ g = (x :: b)+ id8 :: a -> a+ id8 x+ = g x True+ where+ g :: b -> a -> b+ g y _ = y |]+ ======>+ konst1 :: a -> Bool -> a+ konst1 x _ = x+ konst2 :: a -> Maybe Bool -> a+ konst2 x _ = x+ f local+ = g+ where+ g :: forall a. a -> a+ g x = konst1 (x :: a) local+ foo :: forall a. a -> ()+ foo x = const () (Nothing :: Maybe a)+ id2 :: forall a. a -> a+ id2 x = id (x :: a)+ id3 :: a -> a+ id3 (x :: b) = id (x :: b)+ id4 :: forall a. a -> a+ id4 (x :: a) = id (x :: a)+ id5 :: forall a. a -> a+ id5+ = g+ where+ g = id :: a -> a+ id6 :: a -> a+ id6 (x :: b)+ = g+ where+ g = x :: b+ id7 (x :: b)+ = g+ where+ g = x :: b+ id8 :: a -> a+ id8 x+ = g x True+ where+ g :: b -> a -> b+ g y _ = y+ data Let0123456789876543210GSym0 (x0123456789876543210 :: a0123456789876543210) :: (~>) b0123456789876543210 ((~>) a0123456789876543210 b0123456789876543210)+ where+ Let0123456789876543210GSym0KindInference :: SameKind (Apply (Let0123456789876543210GSym0 x0123456789876543210) arg) (Let0123456789876543210GSym1 x0123456789876543210 arg) =>+ Let0123456789876543210GSym0 x0123456789876543210 a0123456789876543210+ type instance Apply @b0123456789876543210 @((~>) a0123456789876543210 b0123456789876543210) (Let0123456789876543210GSym0 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210GSym0 x0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210GSym0KindInference ())+ data Let0123456789876543210GSym1 (x0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210+ where+ Let0123456789876543210GSym1KindInference :: SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 arg) =>+ Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210 a0123456789876543210+ type instance Apply @a0123456789876543210 @b0123456789876543210 (Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210GSym1KindInference ())+ type family Let0123456789876543210GSym2 (x0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) :: b0123456789876543210 where+ Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 = Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210+ type family Let0123456789876543210G (x0123456789876543210 :: a0123456789876543210) (a :: b) (a :: a) :: b where+ Let0123456789876543210G x y _ = y+ type family Let0123456789876543210GSym0 b0123456789876543210 (x0123456789876543210 :: b0123456789876543210) where+ Let0123456789876543210GSym0 b0123456789876543210 x0123456789876543210 = Let0123456789876543210G b0123456789876543210 x0123456789876543210+ type family Let0123456789876543210G b0123456789876543210 (x0123456789876543210 :: b0123456789876543210) where+ Let0123456789876543210G b x = x :: b+ type family Let0123456789876543210GSym0 b0123456789876543210 (x0123456789876543210 :: b0123456789876543210) where+ Let0123456789876543210GSym0 b0123456789876543210 x0123456789876543210 = Let0123456789876543210G b0123456789876543210 x0123456789876543210+ type family Let0123456789876543210G b0123456789876543210 (x0123456789876543210 :: b0123456789876543210) where+ Let0123456789876543210G b x = x :: b+ type family Let0123456789876543210GSym0 a0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) where+ Let0123456789876543210GSym0 a0123456789876543210 a_01234567898765432100123456789876543210 = Let0123456789876543210G a0123456789876543210 a_01234567898765432100123456789876543210+ type family Let0123456789876543210G a0123456789876543210 (a_01234567898765432100123456789876543210 :: a0123456789876543210) where+ Let0123456789876543210G a a_0123456789876543210 = IdSym0 :: (~>) a a+ data Let0123456789876543210GSym0 local0123456789876543210 :: (~>) a0123456789876543210 a0123456789876543210+ where+ Let0123456789876543210GSym0KindInference :: SameKind (Apply (Let0123456789876543210GSym0 local0123456789876543210) arg) (Let0123456789876543210GSym1 local0123456789876543210 arg) =>+ Let0123456789876543210GSym0 local0123456789876543210 a0123456789876543210+ type instance Apply @a0123456789876543210 @a0123456789876543210 (Let0123456789876543210GSym0 local0123456789876543210) a0123456789876543210 = Let0123456789876543210G local0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Let0123456789876543210GSym0 local0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) Let0123456789876543210GSym0KindInference ())+ type family Let0123456789876543210GSym1 local0123456789876543210 (a0123456789876543210 :: a0123456789876543210) :: a0123456789876543210 where+ Let0123456789876543210GSym1 local0123456789876543210 a0123456789876543210 = Let0123456789876543210G local0123456789876543210 a0123456789876543210+ type family Let0123456789876543210G local0123456789876543210 (a :: a) :: a where+ Let0123456789876543210G local (x :: a) = Apply (Apply Konst1Sym0 (x :: a)) local+ type Id8Sym0 :: (~>) a a+ data Id8Sym0 :: (~>) a a+ where+ Id8Sym0KindInference :: SameKind (Apply Id8Sym0 arg) (Id8Sym1 arg) =>+ Id8Sym0 a0123456789876543210+ type instance Apply @a @a Id8Sym0 a0123456789876543210 = Id8 a0123456789876543210+ instance SuppressUnusedWarnings Id8Sym0 where+ suppressUnusedWarnings = snd ((,) Id8Sym0KindInference ())+ type Id8Sym1 :: a -> a+ type family Id8Sym1 @a (a0123456789876543210 :: a) :: a where+ Id8Sym1 a0123456789876543210 = Id8 a0123456789876543210+ data Id7Sym0 a0123456789876543210+ where+ Id7Sym0KindInference :: SameKind (Apply Id7Sym0 arg) (Id7Sym1 arg) =>+ Id7Sym0 a0123456789876543210+ type instance Apply @_ @_ Id7Sym0 a0123456789876543210 = Id7 a0123456789876543210+ instance SuppressUnusedWarnings Id7Sym0 where+ suppressUnusedWarnings = snd ((,) Id7Sym0KindInference ())+ type family Id7Sym1 a0123456789876543210 where+ Id7Sym1 a0123456789876543210 = Id7 a0123456789876543210+ type Id6Sym0 :: (~>) a a+ data Id6Sym0 :: (~>) a a+ where+ Id6Sym0KindInference :: SameKind (Apply Id6Sym0 arg) (Id6Sym1 arg) =>+ Id6Sym0 a0123456789876543210+ type instance Apply @a @a Id6Sym0 a0123456789876543210 = Id6 a0123456789876543210+ instance SuppressUnusedWarnings Id6Sym0 where+ suppressUnusedWarnings = snd ((,) Id6Sym0KindInference ())+ type Id6Sym1 :: a -> a+ type family Id6Sym1 @a (a0123456789876543210 :: a) :: a where+ Id6Sym1 a0123456789876543210 = Id6 a0123456789876543210+ type Id5Sym0 :: forall a. (~>) a a+ data Id5Sym0 :: (~>) a a+ where+ Id5Sym0KindInference :: SameKind (Apply Id5Sym0 arg) (Id5Sym1 arg) =>+ Id5Sym0 a0123456789876543210+ type instance Apply @a @a Id5Sym0 a0123456789876543210 = Id5 a0123456789876543210+ instance SuppressUnusedWarnings Id5Sym0 where+ suppressUnusedWarnings = snd ((,) Id5Sym0KindInference ())+ type Id5Sym1 :: forall a. a -> a+ type family Id5Sym1 @a (a0123456789876543210 :: a) :: a where+ Id5Sym1 a0123456789876543210 = Id5 a0123456789876543210+ type Id4Sym0 :: forall a. (~>) a a+ data Id4Sym0 :: (~>) a a+ where+ Id4Sym0KindInference :: SameKind (Apply Id4Sym0 arg) (Id4Sym1 arg) =>+ Id4Sym0 a0123456789876543210+ type instance Apply @a @a Id4Sym0 a0123456789876543210 = Id4 a0123456789876543210+ instance SuppressUnusedWarnings Id4Sym0 where+ suppressUnusedWarnings = snd ((,) Id4Sym0KindInference ())+ type Id4Sym1 :: forall a. a -> a+ type family Id4Sym1 @a (a0123456789876543210 :: a) :: a where+ Id4Sym1 a0123456789876543210 = Id4 a0123456789876543210+ type Id3Sym0 :: (~>) a a+ data Id3Sym0 :: (~>) a a+ where+ Id3Sym0KindInference :: SameKind (Apply Id3Sym0 arg) (Id3Sym1 arg) =>+ Id3Sym0 a0123456789876543210+ type instance Apply @a @a Id3Sym0 a0123456789876543210 = Id3 a0123456789876543210+ instance SuppressUnusedWarnings Id3Sym0 where+ suppressUnusedWarnings = snd ((,) Id3Sym0KindInference ())+ type Id3Sym1 :: a -> a+ type family Id3Sym1 @a (a0123456789876543210 :: a) :: a where+ Id3Sym1 a0123456789876543210 = Id3 a0123456789876543210+ type Id2Sym0 :: forall a. (~>) a a+ data Id2Sym0 :: (~>) a a+ where+ Id2Sym0KindInference :: SameKind (Apply Id2Sym0 arg) (Id2Sym1 arg) =>+ Id2Sym0 a0123456789876543210+ type instance Apply @a @a Id2Sym0 a0123456789876543210 = Id2 a0123456789876543210+ instance SuppressUnusedWarnings Id2Sym0 where+ suppressUnusedWarnings = snd ((,) Id2Sym0KindInference ())+ type Id2Sym1 :: forall a. a -> a+ type family Id2Sym1 @a (a0123456789876543210 :: a) :: a where+ Id2Sym1 a0123456789876543210 = Id2 a0123456789876543210+ type FooSym0 :: forall a. (~>) a ()+ data FooSym0 :: (~>) a ()+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @a @() FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: forall a. a -> ()+ type family FooSym1 @a (a0123456789876543210 :: a) :: () where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ data FSym0 a0123456789876543210+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @_ @_ FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type family FSym1 a0123456789876543210 where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type Konst2Sym0 :: (~>) a ((~>) (Maybe Bool) a)+ data Konst2Sym0 :: (~>) a ((~>) (Maybe Bool) a)+ where+ Konst2Sym0KindInference :: SameKind (Apply Konst2Sym0 arg) (Konst2Sym1 arg) =>+ Konst2Sym0 a0123456789876543210+ type instance Apply @a @((~>) (Maybe Bool) a) Konst2Sym0 a0123456789876543210 = Konst2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Konst2Sym0 where+ suppressUnusedWarnings = snd ((,) Konst2Sym0KindInference ())+ type Konst2Sym1 :: a -> (~>) (Maybe Bool) a+ data Konst2Sym1 (a0123456789876543210 :: a) :: (~>) (Maybe Bool) a+ where+ Konst2Sym1KindInference :: SameKind (Apply (Konst2Sym1 a0123456789876543210) arg) (Konst2Sym2 a0123456789876543210 arg) =>+ Konst2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Maybe Bool) @a (Konst2Sym1 a0123456789876543210) a0123456789876543210 = Konst2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Konst2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Konst2Sym1KindInference ())+ type Konst2Sym2 :: a -> Maybe Bool -> a+ type family Konst2Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Maybe Bool) :: a where+ Konst2Sym2 a0123456789876543210 a0123456789876543210 = Konst2 a0123456789876543210 a0123456789876543210+ type Konst1Sym0 :: (~>) a ((~>) Bool a)+ data Konst1Sym0 :: (~>) a ((~>) Bool a)+ where+ Konst1Sym0KindInference :: SameKind (Apply Konst1Sym0 arg) (Konst1Sym1 arg) =>+ Konst1Sym0 a0123456789876543210+ type instance Apply @a @((~>) Bool a) Konst1Sym0 a0123456789876543210 = Konst1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings Konst1Sym0 where+ suppressUnusedWarnings = snd ((,) Konst1Sym0KindInference ())+ type Konst1Sym1 :: a -> (~>) Bool a+ data Konst1Sym1 (a0123456789876543210 :: a) :: (~>) Bool a+ where+ Konst1Sym1KindInference :: SameKind (Apply (Konst1Sym1 a0123456789876543210) arg) (Konst1Sym2 a0123456789876543210 arg) =>+ Konst1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @a (Konst1Sym1 a0123456789876543210) a0123456789876543210 = Konst1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (Konst1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) Konst1Sym1KindInference ())+ type Konst1Sym2 :: a -> Bool -> a+ type family Konst1Sym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: Bool) :: a where+ Konst1Sym2 a0123456789876543210 a0123456789876543210 = Konst1 a0123456789876543210 a0123456789876543210+ type Id8 :: a -> a+ type family Id8 @a (a :: a) :: a where+ Id8 x = Apply (Apply (Let0123456789876543210GSym0 x) x) TrueSym0+ type family Id7 a where+ Id7 (x :: b) = Let0123456789876543210GSym0 b x+ type Id6 :: a -> a+ type family Id6 @a (a :: a) :: a where+ Id6 (x :: b) = Let0123456789876543210GSym0 b x+ type Id5 :: forall a. a -> a+ type family Id5 @a (a :: a) :: a where+ Id5 @a (a_0123456789876543210 :: a) = Apply (Let0123456789876543210GSym0 a a_0123456789876543210) a_0123456789876543210+ type Id4 :: forall a. a -> a+ type family Id4 @a (a :: a) :: a where+ Id4 @a (x :: a :: a) = Apply IdSym0 (x :: a)+ type Id3 :: a -> a+ type family Id3 @a (a :: a) :: a where+ Id3 (x :: b) = Apply IdSym0 (x :: b)+ type Id2 :: forall a. a -> a+ type family Id2 @a (a :: a) :: a where+ Id2 @a (x :: a) = Apply IdSym0 (x :: a)+ type Foo :: forall a. a -> ()+ type family Foo @a (a :: a) :: () where+ Foo @a (x :: a) = Apply (Apply ConstSym0 Tuple0Sym0) (NothingSym0 :: Maybe a)+ type family F a where+ F local = Let0123456789876543210GSym0 local+ type Konst2 :: a -> Maybe Bool -> a+ type family Konst2 @a (a :: a) (a :: Maybe Bool) :: a where+ Konst2 x _ = x+ type Konst1 :: a -> Bool -> a+ type family Konst1 @a (a :: a) (a :: Bool) :: a where+ Konst1 x _ = x
+ tests/compile-and-dump/Singletons/T433.hs view
@@ -0,0 +1,72 @@+module T433 where++import Data.Kind (Type)+import Data.Singletons.Base.TH+import Prelude.Singletons++$(promote [d|+ konst1 :: a -> Bool -> a+ konst1 x _ = x++ konst2 :: a -> Maybe Bool -> a+ konst2 x _ = x++ f local = g+ where+ g :: forall a. a -> a+ g x = konst1 (x :: a) local++ foo :: forall a. a -> ()+ foo x = const () (Nothing :: Maybe a)++ id2 :: forall a. a -> a+ id2 x = id (x :: a)++ id3 :: a -> a+ id3 (x :: b) = id (x :: b)++ id4 :: forall a. a -> a+ id4 (x :: a) = id (x :: a)++ id5 :: forall a. a -> a+ id5 = g+ where+ g = id :: a -> a++ id6 :: a -> a+ id6 (x :: b) = g+ where+ g = (x :: b)++ id7 (x :: b) = g+ where+ g = (x :: b)++ id8 :: a -> a+ id8 x = g x True+ where+ g :: b -> a -> b+ g y _ = y++ -- These version will not work. See the singletons README for more about these+ -- limitations.++ -- This will not work because the `a` in `forall a` scopes over the body of+ -- the function, but the `(x :: b)` pattern refers to `b` instead of `a`.+ {-+ id9 :: forall a. a -> a+ id9 (x :: b) = id (x :: b)+ -}++ -- This will not work because the `b` in `Nothing :: Maybe b` is bound by the+ -- type signature for `g`, a local variable that closes over `x`. Moreover,+ -- `b` is only mentioned in the return type (and not the arguments) of the+ -- type signature.+ {-+ id10 :: forall a. a -> a+ id10 x = konst2 x y+ where+ y :: forall b. Maybe b+ y = Nothing :: Maybe b+ -}+ |])
tests/compile-and-dump/Singletons/T443.golden view
@@ -1,127 +1,126 @@-Singletons/T443.hs:(0,0)-(0,0): Splicing declarations - withOptions defaultOptions {genSingKindInsts = False} - $ singletons - [d| data Nat = Z | S Nat - data Vec :: Nat -> Type -> Type - where - VNil :: Vec Z a - (:>) :: {head :: a, tail :: Vec n a} -> Vec (S n) a |] - ======> - data Nat = Z | S Nat - data Vec :: Nat -> Type -> Type - where - VNil :: Vec 'Z a - (:>) :: {head :: a, tail :: (Vec n a)} -> Vec ('S n) a - type ZSym0 :: Nat - type family ZSym0 :: Nat where - ZSym0 = Z - type SSym0 :: (~>) Nat Nat - data SSym0 :: (~>) Nat Nat - where - SSym0KindInference :: SameKind (Apply SSym0 arg) (SSym1 arg) => - SSym0 a0123456789876543210 - type instance Apply SSym0 a0123456789876543210 = S a0123456789876543210 - instance SuppressUnusedWarnings SSym0 where - suppressUnusedWarnings = snd ((,) SSym0KindInference ()) - type SSym1 :: Nat -> Nat - type family SSym1 (a0123456789876543210 :: Nat) :: Nat where - SSym1 a0123456789876543210 = S a0123456789876543210 - type VNilSym0 :: Vec Z a - type family VNilSym0 :: Vec Z a where - VNilSym0 = VNil - type (:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a)) - data (:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a)) - where - (::>@#@$###) :: SameKind (Apply (:>@#@$) arg) ((:>@#@$$) arg) => - (:>@#@$) a0123456789876543210 - type instance Apply (:>@#@$) a0123456789876543210 = (:>@#@$$) a0123456789876543210 - instance SuppressUnusedWarnings (:>@#@$) where - suppressUnusedWarnings = snd ((,) (::>@#@$###) ()) - type (:>@#@$$) :: a -> (~>) (Vec n a) (Vec (S n) a) - data (:>@#@$$) (a0123456789876543210 :: a) :: (~>) (Vec n a) (Vec (S n) a) - where - (::>@#@$$###) :: SameKind (Apply ((:>@#@$$) a0123456789876543210) arg) ((:>@#@$$$) a0123456789876543210 arg) => - (:>@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((:>@#@$$) a0123456789876543210) a0123456789876543210 = (:>) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((:>@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd ((,) (::>@#@$$###) ()) - type (:>@#@$$$) :: a -> Vec n a -> Vec (S n) a - type family (:>@#@$$$) (a0123456789876543210 :: a) (a0123456789876543210 :: Vec n a) :: Vec (S n) a where - (:>@#@$$$) a0123456789876543210 a0123456789876543210 = (:>) a0123456789876543210 a0123456789876543210 - type TailSym0 :: (~>) (Vec (S n) a) (Vec n a) - data TailSym0 :: (~>) (Vec (S n) a) (Vec n a) - where - TailSym0KindInference :: SameKind (Apply TailSym0 arg) (TailSym1 arg) => - TailSym0 a0123456789876543210 - type instance Apply TailSym0 a0123456789876543210 = Tail a0123456789876543210 - instance SuppressUnusedWarnings TailSym0 where - suppressUnusedWarnings = snd ((,) TailSym0KindInference ()) - type TailSym1 :: Vec (S n) a -> Vec n a - type family TailSym1 (a0123456789876543210 :: Vec (S n) a) :: Vec n a where - TailSym1 a0123456789876543210 = Tail a0123456789876543210 - type HeadSym0 :: (~>) (Vec (S n) a) a - data HeadSym0 :: (~>) (Vec (S n) a) a - where - HeadSym0KindInference :: SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => - HeadSym0 a0123456789876543210 - type instance Apply HeadSym0 a0123456789876543210 = Head a0123456789876543210 - instance SuppressUnusedWarnings HeadSym0 where - suppressUnusedWarnings = snd ((,) HeadSym0KindInference ()) - type HeadSym1 :: Vec (S n) a -> a - type family HeadSym1 (a0123456789876543210 :: Vec (S n) a) :: a where - HeadSym1 a0123456789876543210 = Head a0123456789876543210 - type Tail :: Vec (S n) a -> Vec n a - type family Tail (a :: Vec (S n) a) :: Vec n a where - Tail ((:>) _ field) = field - type Head :: Vec (S n) a -> a - type family Head (a :: Vec (S n) a) :: a where - Head ((:>) field _) = field - sTail :: - (forall (t :: Vec (S n) a). - Sing t -> Sing (Apply TailSym0 t :: Vec n a) :: Type) - sHead :: - (forall (t :: Vec (S n) a). - Sing t -> Sing (Apply HeadSym0 t :: a) :: Type) - sTail ((:%>) _ (sField :: Sing field)) = sField - sHead ((:%>) (sField :: Sing field) _) = sField - instance SingI (TailSym0 :: (~>) (Vec (S n) a) (Vec n a)) where - sing = singFun1 @TailSym0 sTail - instance SingI (HeadSym0 :: (~>) (Vec (S n) a) a) where - sing = singFun1 @HeadSym0 sHead - data SNat :: Nat -> Type - where - SZ :: SNat (Z :: Nat) - SS :: forall (n :: Nat). (Sing n) -> SNat (S n :: Nat) - type instance Sing @Nat = SNat - data SVec :: forall (a :: Nat) (a :: Type). Vec a a -> Type - where - SVNil :: forall a. SVec (VNil :: Vec Z a) - (:%>) :: forall a n (n :: a) (n :: Vec n a). - (Sing n) -> (Sing n) -> SVec ((:>) n n :: Vec (S n) a) - type instance Sing @(Vec a a) = SVec - instance SingI Z where - sing = SZ - instance SingI n => SingI (S (n :: Nat)) where - sing = SS sing - instance SingI1 S where - liftSing = SS - instance SingI (SSym0 :: (~>) Nat Nat) where - sing = singFun1 @SSym0 SS - instance SingI VNil where - sing = SVNil - instance (SingI n, SingI n) => - SingI ((:>) (n :: a) (n :: Vec n a)) where - sing = (:%>) sing sing - instance SingI n => SingI1 ((:>) (n :: a)) where - liftSing = (:%>) sing - instance SingI2 (:>) where - liftSing2 = (:%>) - instance SingI ((:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a))) where - sing = singFun2 @(:>@#@$) (:%>) - instance SingI d => - SingI ((:>@#@$$) (d :: a) :: (~>) (Vec n a) (Vec (S n) a)) where - sing = singFun1 @((:>@#@$$) (d :: a)) ((:%>) (sing @d)) - instance SingI1 ((:>@#@$$) :: a - -> (~>) (Vec n a) (Vec (S n) a)) where - liftSing (s :: Sing (d :: a)) - = singFun1 @((:>@#@$$) (d :: a)) ((:%>) s) +Singletons/T443.hs:(0,0)-(0,0): Splicing declarations+ withOptions defaultOptions {genSingKindInsts = False}+ $ singletons+ [d| data Nat = Z | S Nat+ data Vec :: Nat -> Type -> Type+ where+ VNil :: Vec Z a+ (:>) :: {head :: a, tail :: Vec n a} -> Vec (S n) a |]+ ======>+ data Nat = Z | S Nat+ data Vec :: Nat -> Type -> Type+ where+ VNil :: Vec 'Z a+ (:>) :: {head :: a, tail :: (Vec n a)} -> Vec ('S n) a+ type ZSym0 :: Nat+ type family ZSym0 :: Nat where+ ZSym0 = Z+ type SSym0 :: (~>) Nat Nat+ data SSym0 :: (~>) Nat Nat+ where+ SSym0KindInference :: SameKind (Apply SSym0 arg) (SSym1 arg) =>+ SSym0 a0123456789876543210+ type instance Apply @Nat @Nat SSym0 a0123456789876543210 = S a0123456789876543210+ instance SuppressUnusedWarnings SSym0 where+ suppressUnusedWarnings = snd ((,) SSym0KindInference ())+ type SSym1 :: Nat -> Nat+ type family SSym1 (a0123456789876543210 :: Nat) :: Nat where+ SSym1 a0123456789876543210 = S a0123456789876543210+ type VNilSym0 :: Vec Z a+ type family VNilSym0 @a :: Vec Z a where+ VNilSym0 = VNil+ type (:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a))+ data (:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a))+ where+ (::>@#@$###) :: SameKind (Apply (:>@#@$) arg) ((:>@#@$$) arg) =>+ (:>@#@$) a0123456789876543210+ type instance Apply @a @((~>) (Vec n a) (Vec (S n) a)) (:>@#@$) a0123456789876543210 = (:>@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (:>@#@$) where+ suppressUnusedWarnings = snd ((,) (::>@#@$###) ())+ type (:>@#@$$) :: a -> (~>) (Vec n a) (Vec (S n) a)+ data (:>@#@$$) (a0123456789876543210 :: a) :: (~>) (Vec n a) (Vec (S n) a)+ where+ (::>@#@$$###) :: SameKind (Apply ((:>@#@$$) a0123456789876543210) arg) ((:>@#@$$$) a0123456789876543210 arg) =>+ (:>@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @(Vec n a) @(Vec (S n) a) ((:>@#@$$) a0123456789876543210) a0123456789876543210 = (:>) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((:>@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (::>@#@$$###) ())+ type (:>@#@$$$) :: a -> Vec n a -> Vec (S n) a+ type family (:>@#@$$$) @a @n (a0123456789876543210 :: a) (a0123456789876543210 :: Vec n a) :: Vec (S n) a where+ (:>@#@$$$) a0123456789876543210 a0123456789876543210 = (:>) a0123456789876543210 a0123456789876543210+ type TailSym0 :: (~>) (Vec (S n) a) (Vec n a)+ data TailSym0 :: (~>) (Vec (S n) a) (Vec n a)+ where+ TailSym0KindInference :: SameKind (Apply TailSym0 arg) (TailSym1 arg) =>+ TailSym0 a0123456789876543210+ type instance Apply @(Vec (S n) a) @(Vec n a) TailSym0 a0123456789876543210 = Tail a0123456789876543210+ instance SuppressUnusedWarnings TailSym0 where+ suppressUnusedWarnings = snd ((,) TailSym0KindInference ())+ type TailSym1 :: Vec (S n) a -> Vec n a+ type family TailSym1 @n @a (a0123456789876543210 :: Vec (S n) a) :: Vec n a where+ TailSym1 a0123456789876543210 = Tail a0123456789876543210+ type HeadSym0 :: (~>) (Vec (S n) a) a+ data HeadSym0 :: (~>) (Vec (S n) a) a+ where+ HeadSym0KindInference :: SameKind (Apply HeadSym0 arg) (HeadSym1 arg) =>+ HeadSym0 a0123456789876543210+ type instance Apply @(Vec (S n) a) @a HeadSym0 a0123456789876543210 = Head a0123456789876543210+ instance SuppressUnusedWarnings HeadSym0 where+ suppressUnusedWarnings = snd ((,) HeadSym0KindInference ())+ type HeadSym1 :: Vec (S n) a -> a+ type family HeadSym1 @n @a (a0123456789876543210 :: Vec (S n) a) :: a where+ HeadSym1 a0123456789876543210 = Head a0123456789876543210+ type Tail :: Vec (S n) a -> Vec n a+ type family Tail @n @a (a :: Vec (S n) a) :: Vec n a where+ Tail ((:>) _ field) = field+ type Head :: Vec (S n) a -> a+ type family Head @n @a (a :: Vec (S n) a) :: a where+ Head ((:>) field _) = field+ sTail ::+ (forall (t :: Vec (S n) a).+ Sing t -> Sing (Tail t :: Vec n a) :: Type)+ sHead ::+ (forall (t :: Vec (S n) a). Sing t -> Sing (Head t :: a) :: Type)+ sTail ((:%>) _ (sField :: Sing field)) = sField+ sHead ((:%>) (sField :: Sing field) _) = sField+ instance SingI (TailSym0 :: (~>) (Vec (S n) a) (Vec n a)) where+ sing = singFun1 @TailSym0 sTail+ instance SingI (HeadSym0 :: (~>) (Vec (S n) a) a) where+ sing = singFun1 @HeadSym0 sHead+ data SNat :: Nat -> Type+ where+ SZ :: SNat (Z :: Nat)+ SS :: forall (n :: Nat). (Sing n) -> SNat (S n :: Nat)+ type instance Sing @Nat = SNat+ data SVec :: forall (a :: Nat) (a :: Type). Vec a a -> Type+ where+ SVNil :: forall a. SVec (VNil :: Vec Z a)+ (:%>) :: forall a n (n :: a) (n :: Vec n a).+ (Sing n) -> (Sing n) -> SVec ((:>) n n :: Vec (S n) a)+ type instance Sing @(Vec a a) = SVec+ instance SingI Z where+ sing = SZ+ instance SingI n => SingI (S (n :: Nat)) where+ sing = SS sing+ instance SingI1 S where+ liftSing = SS+ instance SingI (SSym0 :: (~>) Nat Nat) where+ sing = singFun1 @SSym0 SS+ instance SingI VNil where+ sing = SVNil+ instance (SingI n, SingI n) =>+ SingI ((:>) (n :: a) (n :: Vec n a)) where+ sing = (:%>) sing sing+ instance SingI n => SingI1 ((:>) (n :: a)) where+ liftSing = (:%>) sing+ instance SingI2 (:>) where+ liftSing2 = (:%>)+ instance SingI ((:>@#@$) :: (~>) a ((~>) (Vec n a) (Vec (S n) a))) where+ sing = singFun2 @(:>@#@$) (:%>)+ instance SingI d =>+ SingI ((:>@#@$$) (d :: a) :: (~>) (Vec n a) (Vec (S n) a)) where+ sing = singFun1 @((:>@#@$$) (d :: a)) ((:%>) (sing @d))+ instance SingI1 ((:>@#@$$) :: a+ -> (~>) (Vec n a) (Vec (S n) a)) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((:>@#@$$) (d :: a)) ((:%>) s)
tests/compile-and-dump/Singletons/T443.hs view
@@ -1,14 +1,14 @@-module T443 where - -import Data.Kind -import Data.Singletons.TH -import Data.Singletons.TH.Options - -$(withOptions defaultOptions{genSingKindInsts = False} $ - singletons [d| - data Nat = Z | S Nat - - data Vec :: Nat -> Type -> Type where - VNil :: Vec Z a - (:>) :: { head :: a, tail :: Vec n a } -> Vec (S n) a - |]) +module T443 where++import Data.Kind+import Data.Singletons.TH+import Data.Singletons.TH.Options++$(withOptions defaultOptions{genSingKindInsts = False} $+ singletons [d|+ data Nat = Z | S Nat++ data Vec :: Nat -> Type -> Type where+ VNil :: Vec Z a+ (:>) :: { head :: a, tail :: Vec n a } -> Vec (S n) a+ |])
tests/compile-and-dump/Singletons/T445.golden view
@@ -1,74 +1,66 @@-Singletons/T445.hs:0:0:: Splicing declarations - genDefunSymbols [''Lit] - ======> - type LitSym0 :: (~>) Natural Nat - data LitSym0 :: (~>) Natural Nat - where - LitSym0KindInference :: SameKind (Apply LitSym0 arg) (LitSym1 arg) => - LitSym0 a0123456789876543210 - type instance Apply LitSym0 a0123456789876543210 = Lit a0123456789876543210 - instance SuppressUnusedWarnings LitSym0 where - suppressUnusedWarnings = snd ((,) LitSym0KindInference ()) - type LitSym1 :: Natural -> Nat - type family LitSym1 (a0123456789876543210 :: Natural) :: Nat where - LitSym1 a0123456789876543210 = Lit a0123456789876543210 -Singletons/T445.hs:(0,0)-(0,0): Splicing declarations - promoteOnly - [d| evenb :: Nat -> Bool - evenb Zero = True - evenb (Succ Zero) = False - evenb (Succ (Succ n)) = evenb n - filterEvenGt7 :: [Nat] -> [Nat] - filterEvenGt7 = filter (\ x -> evenb x && x > lit 7) |] - ======> - type family Lambda_0123456789876543210 a_0123456789876543210 x where - Lambda_0123456789876543210 a_0123456789876543210 x = Apply (Apply (&&@#@$) (Apply EvenbSym0 x)) (Apply (Apply (>@#@$) x) (Apply LitSym0 (FromInteger 7))) - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym0KindInference ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) x0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd ((,) Lambda_0123456789876543210Sym1KindInference ()) - type family Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 - type FilterEvenGt7Sym0 :: (~>) [Nat] [Nat] - data FilterEvenGt7Sym0 :: (~>) [Nat] [Nat] - where - FilterEvenGt7Sym0KindInference :: SameKind (Apply FilterEvenGt7Sym0 arg) (FilterEvenGt7Sym1 arg) => - FilterEvenGt7Sym0 a0123456789876543210 - type instance Apply FilterEvenGt7Sym0 a0123456789876543210 = FilterEvenGt7 a0123456789876543210 - instance SuppressUnusedWarnings FilterEvenGt7Sym0 where - suppressUnusedWarnings - = snd ((,) FilterEvenGt7Sym0KindInference ()) - type FilterEvenGt7Sym1 :: [Nat] -> [Nat] - type family FilterEvenGt7Sym1 (a0123456789876543210 :: [Nat]) :: [Nat] where - FilterEvenGt7Sym1 a0123456789876543210 = FilterEvenGt7 a0123456789876543210 - type EvenbSym0 :: (~>) Nat Bool - data EvenbSym0 :: (~>) Nat Bool - where - EvenbSym0KindInference :: SameKind (Apply EvenbSym0 arg) (EvenbSym1 arg) => - EvenbSym0 a0123456789876543210 - type instance Apply EvenbSym0 a0123456789876543210 = Evenb a0123456789876543210 - instance SuppressUnusedWarnings EvenbSym0 where - suppressUnusedWarnings = snd ((,) EvenbSym0KindInference ()) - type EvenbSym1 :: Nat -> Bool - type family EvenbSym1 (a0123456789876543210 :: Nat) :: Bool where - EvenbSym1 a0123456789876543210 = Evenb a0123456789876543210 - type FilterEvenGt7 :: [Nat] -> [Nat] - type family FilterEvenGt7 (a :: [Nat]) :: [Nat] where - FilterEvenGt7 a_0123456789876543210 = Apply (Apply FilterSym0 (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210)) a_0123456789876543210 - type Evenb :: Nat -> Bool - type family Evenb (a :: Nat) :: Bool where - Evenb 'Zero = TrueSym0 - Evenb ('Succ 'Zero) = FalseSym0 - Evenb ('Succ ('Succ n)) = Apply EvenbSym0 n +Singletons/T445.hs:0:0:: Splicing declarations+ genDefunSymbols [''Lit]+ ======>+ type LitSym0 :: (~>) Natural Nat+ data LitSym0 :: (~>) Natural Nat+ where+ LitSym0KindInference :: SameKind (Apply LitSym0 arg) (LitSym1 arg) =>+ LitSym0 a0123456789876543210+ type instance Apply @Natural @Nat LitSym0 a0123456789876543210 = Lit a0123456789876543210+ instance SuppressUnusedWarnings LitSym0 where+ suppressUnusedWarnings = snd ((,) LitSym0KindInference ())+ type LitSym1 :: Natural -> Nat+ type family LitSym1 (a0123456789876543210 :: Natural) :: Nat where+ LitSym1 a0123456789876543210 = Lit a0123456789876543210+Singletons/T445.hs:(0,0)-(0,0): Splicing declarations+ promoteOnly+ [d| evenb :: Nat -> Bool+ evenb Zero = True+ evenb (Succ Zero) = False+ evenb (Succ (Succ n)) = evenb n+ filterEvenGt7 :: [Nat] -> [Nat]+ filterEvenGt7 = filter (\ x -> evenb x && x > lit 7) |]+ ======>+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: [Nat]) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 x = Apply (Apply (&&@#@$) (Apply EvenbSym0 x)) (Apply (Apply (>@#@$) x) (Apply LitSym0 (FromInteger 7)))+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: [Nat]) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: [Nat]) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type FilterEvenGt7Sym0 :: (~>) [Nat] [Nat]+ data FilterEvenGt7Sym0 :: (~>) [Nat] [Nat]+ where+ FilterEvenGt7Sym0KindInference :: SameKind (Apply FilterEvenGt7Sym0 arg) (FilterEvenGt7Sym1 arg) =>+ FilterEvenGt7Sym0 a0123456789876543210+ type instance Apply @[Nat] @[Nat] FilterEvenGt7Sym0 a0123456789876543210 = FilterEvenGt7 a0123456789876543210+ instance SuppressUnusedWarnings FilterEvenGt7Sym0 where+ suppressUnusedWarnings+ = snd ((,) FilterEvenGt7Sym0KindInference ())+ type FilterEvenGt7Sym1 :: [Nat] -> [Nat]+ type family FilterEvenGt7Sym1 (a0123456789876543210 :: [Nat]) :: [Nat] where+ FilterEvenGt7Sym1 a0123456789876543210 = FilterEvenGt7 a0123456789876543210+ type EvenbSym0 :: (~>) Nat Bool+ data EvenbSym0 :: (~>) Nat Bool+ where+ EvenbSym0KindInference :: SameKind (Apply EvenbSym0 arg) (EvenbSym1 arg) =>+ EvenbSym0 a0123456789876543210+ type instance Apply @Nat @Bool EvenbSym0 a0123456789876543210 = Evenb a0123456789876543210+ instance SuppressUnusedWarnings EvenbSym0 where+ suppressUnusedWarnings = snd ((,) EvenbSym0KindInference ())+ type EvenbSym1 :: Nat -> Bool+ type family EvenbSym1 (a0123456789876543210 :: Nat) :: Bool where+ EvenbSym1 a0123456789876543210 = Evenb a0123456789876543210+ type FilterEvenGt7 :: [Nat] -> [Nat]+ type family FilterEvenGt7 (a :: [Nat]) :: [Nat] where+ FilterEvenGt7 a_0123456789876543210 = Apply (Apply FilterSym0 (LamCases_0123456789876543210Sym0 a_0123456789876543210)) a_0123456789876543210+ type Evenb :: Nat -> Bool+ type family Evenb (a :: Nat) :: Bool where+ Evenb 'Zero = TrueSym0+ Evenb ('Succ 'Zero) = FalseSym0+ Evenb ('Succ ('Succ n)) = Apply EvenbSym0 n
tests/compile-and-dump/Singletons/T445.hs view
@@ -1,26 +1,26 @@-module T445 where - -import Data.Singletons.TH -import qualified GHC.TypeLits as Lit -import Numeric.Natural (Natural) -import Prelude.Singletons -import Singletons.Nat - -type Lit :: Natural -> Nat -type family Lit n where - Lit 0 = Zero - Lit n = Succ (Lit (n Lit.- 1)) -$(genDefunSymbols [''Lit]) - -$(promoteOnly [d| - evenb :: Nat -> Bool - evenb Zero = True - evenb (Succ Zero) = False - evenb (Succ (Succ n)) = evenb n - - filterEvenGt7 :: [Nat] -> [Nat] - filterEvenGt7 = filter (\x -> evenb x && x > lit 7) - |]) - -testFilterEvenGt7 :: FilterEvenGt7 (Map LitSym0 '[5,2,6,19,129]) :~: '[] -testFilterEvenGt7 = Refl +module T445 where++import Data.Singletons.TH+import qualified GHC.TypeLits as Lit+import Numeric.Natural (Natural)+import Prelude.Singletons+import Singletons.Nat++type Lit :: Natural -> Nat+type family Lit n where+ Lit 0 = Zero+ Lit n = Succ (Lit (n Lit.- 1))+$(genDefunSymbols [''Lit])++$(promoteOnly [d|+ evenb :: Nat -> Bool+ evenb Zero = True+ evenb (Succ Zero) = False+ evenb (Succ (Succ n)) = evenb n++ filterEvenGt7 :: [Nat] -> [Nat]+ filterEvenGt7 = filter (\x -> evenb x && x > lit 7)+ |])++testFilterEvenGt7 :: FilterEvenGt7 (Map LitSym0 '[5,2,6,19,129]) :~: '[]+testFilterEvenGt7 = Refl
tests/compile-and-dump/Singletons/T450.golden view
@@ -1,212 +1,210 @@-Singletons/T450.hs:(0,0)-(0,0): Splicing declarations - do let customPromote :: [(Name, Name)] -> Name -> Name - customPromote customs n = fromMaybe n $ lookup n customs - customOptions :: [(Name, Name)] -> Options - customOptions customs - = defaultOptions - {promotedDataTypeOrConName = \ n - -> promotedDataTypeOrConName - defaultOptions (customPromote customs n), - defunctionalizedName = \ n sat - -> defunctionalizedName - defaultOptions (customPromote customs n) sat} - messageDecs <- withOptions - (customOptions - [(''Message, ''PMessage), ('MkMessage, 'PMkMessage), - (''Text, ''Symbol)]) - $ do messageDecs1 <- genSingletons [''Message] - messageDecs2 <- singletons - [d| appendMessage :: Message -> Message -> Message - appendMessage - (MkMessage (x :: Text)) - (MkMessage (y :: Text)) - = MkMessage (x <> y :: Text) |] - pure $ messageDecs1 ++ messageDecs2 - functionDecs <- withOptions - (customOptions - [(''Function, ''PFunction), ('MkFunction, 'PMkFunction)]) - $ do functionDecs1 <- genSingletons [''Function] - functionDecs2 <- singletons - [d| composeFunction :: - Function b c -> Function a b -> Function a c - composeFunction - (MkFunction (f :: b -> c)) - (MkFunction (g :: a -> b)) - = MkFunction (f . g :: a -> c) |] - pure $ functionDecs1 ++ functionDecs2 - pure $ messageDecs ++ functionDecs - ======> - type PMkMessageSym0 :: (~>) Symbol PMessage - data PMkMessageSym0 :: (~>) Symbol PMessage - where - PMkMessageSym0KindInference :: SameKind (Apply PMkMessageSym0 arg) (PMkMessageSym1 arg) => - PMkMessageSym0 a0123456789876543210 - type instance Apply PMkMessageSym0 a0123456789876543210 = 'PMkMessage a0123456789876543210 - instance SuppressUnusedWarnings PMkMessageSym0 where - suppressUnusedWarnings = snd ((,) PMkMessageSym0KindInference ()) - type PMkMessageSym1 :: Symbol -> PMessage - type family PMkMessageSym1 (a0123456789876543210 :: Symbol) :: PMessage where - PMkMessageSym1 a0123456789876543210 = 'PMkMessage a0123456789876543210 - type SMessage :: PMessage -> Type - data SMessage :: PMessage -> Type - where - SMkMessage :: forall (n :: Symbol). - (Sing n) -> SMessage ('PMkMessage n :: PMessage) - type instance Sing @PMessage = SMessage - instance SingKind PMessage where - type Demote PMessage = Message - fromSing (SMkMessage b) = MkMessage (fromSing b) - toSing (MkMessage (b :: Demote Symbol)) - = case toSing b :: SomeSing Symbol of - SomeSing c -> SomeSing (SMkMessage c) - instance SingI n => SingI ('PMkMessage (n :: Symbol)) where - sing = SMkMessage sing - instance SingI1 'PMkMessage where - liftSing = SMkMessage - instance SingI (PMkMessageSym0 :: (~>) Symbol PMessage) where - sing = singFun1 @PMkMessageSym0 SMkMessage - appendMessage :: Message -> Message -> Message - appendMessage (MkMessage (x :: Text)) (MkMessage (y :: Text)) - = MkMessage ((x <> y) :: Text) - type AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage) - data AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage) - where - AppendMessageSym0KindInference :: SameKind (Apply AppendMessageSym0 arg) (AppendMessageSym1 arg) => - AppendMessageSym0 a0123456789876543210 - type instance Apply AppendMessageSym0 a0123456789876543210 = AppendMessageSym1 a0123456789876543210 - instance SuppressUnusedWarnings AppendMessageSym0 where - suppressUnusedWarnings - = snd ((,) AppendMessageSym0KindInference ()) - type AppendMessageSym1 :: PMessage -> (~>) PMessage PMessage - data AppendMessageSym1 (a0123456789876543210 :: PMessage) :: (~>) PMessage PMessage - where - AppendMessageSym1KindInference :: SameKind (Apply (AppendMessageSym1 a0123456789876543210) arg) (AppendMessageSym2 a0123456789876543210 arg) => - AppendMessageSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AppendMessageSym1 a0123456789876543210) a0123456789876543210 = AppendMessage a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AppendMessageSym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) AppendMessageSym1KindInference ()) - type AppendMessageSym2 :: PMessage -> PMessage -> PMessage - type family AppendMessageSym2 (a0123456789876543210 :: PMessage) (a0123456789876543210 :: PMessage) :: PMessage where - AppendMessageSym2 a0123456789876543210 a0123456789876543210 = AppendMessage a0123456789876543210 a0123456789876543210 - type AppendMessage :: PMessage -> PMessage -> PMessage - type family AppendMessage (a :: PMessage) (a :: PMessage) :: PMessage where - AppendMessage ('PMkMessage (x :: Symbol)) ('PMkMessage (y :: Symbol)) = Apply PMkMessageSym0 (Apply (Apply (<>@#@$) x) y :: Symbol) - sAppendMessage :: - (forall (t :: PMessage) (t :: PMessage). - Sing t - -> Sing t - -> Sing (Apply (Apply AppendMessageSym0 t) t :: PMessage) :: Type) - sAppendMessage - (SMkMessage (sX :: Sing x)) - (SMkMessage (sY :: Sing y)) - = case (,) (sX :: Sing x) (sY :: Sing y) of - (,) (_ :: Sing (x :: Symbol)) (_ :: Sing (y :: Symbol)) - -> applySing - (singFun1 @PMkMessageSym0 SMkMessage) - (applySing (applySing (singFun2 @(<>@#@$) (%<>)) sX) sY :: - Sing (Apply (Apply (<>@#@$) x) y :: Symbol)) - instance SingI (AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage)) where - sing = singFun2 @AppendMessageSym0 sAppendMessage - instance SingI d => - SingI (AppendMessageSym1 (d :: PMessage) :: (~>) PMessage PMessage) where - sing - = singFun1 - @(AppendMessageSym1 (d :: PMessage)) (sAppendMessage (sing @d)) - instance SingI1 (AppendMessageSym1 :: PMessage - -> (~>) PMessage PMessage) where - liftSing (s :: Sing (d :: PMessage)) - = singFun1 @(AppendMessageSym1 (d :: PMessage)) (sAppendMessage s) - type PMkFunctionSym0 :: forall (a :: Type) - (b :: Type). (~>) ((~>) a b) (PFunction (a :: Type) (b :: Type)) - data PMkFunctionSym0 :: (~>) ((~>) a b) (PFunction (a :: Type) (b :: Type)) - where - PMkFunctionSym0KindInference :: SameKind (Apply PMkFunctionSym0 arg) (PMkFunctionSym1 arg) => - PMkFunctionSym0 a0123456789876543210 - type instance Apply PMkFunctionSym0 a0123456789876543210 = 'PMkFunction a0123456789876543210 - instance SuppressUnusedWarnings PMkFunctionSym0 where - suppressUnusedWarnings = snd ((,) PMkFunctionSym0KindInference ()) - type PMkFunctionSym1 :: forall (a :: Type) (b :: Type). (~>) a b - -> PFunction (a :: Type) (b :: Type) - type family PMkFunctionSym1 (a0123456789876543210 :: (~>) a b) :: PFunction (a :: Type) (b :: Type) where - PMkFunctionSym1 a0123456789876543210 = 'PMkFunction a0123456789876543210 - type SFunction :: forall (a :: Type) (b :: Type). PFunction a b - -> Type - data SFunction :: forall (a :: Type) (b :: Type). - PFunction a b -> Type - where - SMkFunction :: forall (a :: Type) (b :: Type) (n :: (~>) a b). - (Sing n) -> - SFunction ('PMkFunction n :: PFunction (a :: Type) (b :: Type)) - type instance Sing @(PFunction a b) = SFunction - instance (SingKind a, SingKind b) => SingKind (PFunction a b) where - type Demote (PFunction a b) = Function (Demote a) (Demote b) - fromSing (SMkFunction b) = MkFunction (fromSing b) - toSing (MkFunction (b :: Demote ((~>) a b))) - = case toSing b :: SomeSing ((~>) a b) of - SomeSing c -> SomeSing (SMkFunction c) - instance SingI n => SingI ('PMkFunction (n :: (~>) a b)) where - sing = SMkFunction sing - instance SingI1 'PMkFunction where - liftSing = SMkFunction - instance SingI (PMkFunctionSym0 :: (~>) ((~>) a b) (PFunction (a :: Type) (b :: Type))) where - sing = singFun1 @PMkFunctionSym0 SMkFunction - composeFunction :: Function b c -> Function a b -> Function a c - composeFunction - (MkFunction (f :: b -> c)) - (MkFunction (g :: a -> b)) - = MkFunction ((f . g) :: a -> c) - type ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c)) - data ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c)) - where - ComposeFunctionSym0KindInference :: SameKind (Apply ComposeFunctionSym0 arg) (ComposeFunctionSym1 arg) => - ComposeFunctionSym0 a0123456789876543210 - type instance Apply ComposeFunctionSym0 a0123456789876543210 = ComposeFunctionSym1 a0123456789876543210 - instance SuppressUnusedWarnings ComposeFunctionSym0 where - suppressUnusedWarnings - = snd ((,) ComposeFunctionSym0KindInference ()) - type ComposeFunctionSym1 :: PFunction b c - -> (~>) (PFunction a b) (PFunction a c) - data ComposeFunctionSym1 (a0123456789876543210 :: PFunction b c) :: (~>) (PFunction a b) (PFunction a c) - where - ComposeFunctionSym1KindInference :: SameKind (Apply (ComposeFunctionSym1 a0123456789876543210) arg) (ComposeFunctionSym2 a0123456789876543210 arg) => - ComposeFunctionSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ComposeFunctionSym1 a0123456789876543210) a0123456789876543210 = ComposeFunction a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ComposeFunctionSym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ComposeFunctionSym1KindInference ()) - type ComposeFunctionSym2 :: PFunction b c - -> PFunction a b -> PFunction a c - type family ComposeFunctionSym2 (a0123456789876543210 :: PFunction b c) (a0123456789876543210 :: PFunction a b) :: PFunction a c where - ComposeFunctionSym2 a0123456789876543210 a0123456789876543210 = ComposeFunction a0123456789876543210 a0123456789876543210 - type ComposeFunction :: PFunction b c - -> PFunction a b -> PFunction a c - type family ComposeFunction (a :: PFunction b c) (a :: PFunction a b) :: PFunction a c where - ComposeFunction ('PMkFunction (f :: (~>) b c)) ('PMkFunction (g :: (~>) a b)) = Apply PMkFunctionSym0 (Apply (Apply (.@#@$) f) g :: (~>) a c) - sComposeFunction :: - (forall (t :: PFunction b c) (t :: PFunction a b). - Sing t - -> Sing t - -> Sing (Apply (Apply ComposeFunctionSym0 t) t :: PFunction a c) :: Type) - sComposeFunction - (SMkFunction (sF :: Sing f)) - (SMkFunction (sG :: Sing g)) - = case (,) (sF :: Sing f) (sG :: Sing g) of - (,) (_ :: Sing (f :: (~>) b c)) (_ :: Sing (g :: (~>) a b)) - -> applySing - (singFun1 @PMkFunctionSym0 SMkFunction) - (applySing (applySing (singFun3 @(.@#@$) (%.)) sF) sG :: - Sing (Apply (Apply (.@#@$) f) g :: (~>) a c)) - instance SingI (ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c))) where - sing = singFun2 @ComposeFunctionSym0 sComposeFunction - instance SingI d => - SingI (ComposeFunctionSym1 (d :: PFunction b c) :: (~>) (PFunction a b) (PFunction a c)) where - sing - = singFun1 - @(ComposeFunctionSym1 (d :: PFunction b c)) - (sComposeFunction (sing @d)) - instance SingI1 (ComposeFunctionSym1 :: PFunction b c - -> (~>) (PFunction a b) (PFunction a c)) where - liftSing (s :: Sing (d :: PFunction b c)) - = singFun1 - @(ComposeFunctionSym1 (d :: PFunction b c)) (sComposeFunction s) +Singletons/T450.hs:(0,0)-(0,0): Splicing declarations+ do let customPromote :: [(Name, Name)] -> Name -> Name+ customPromote customs n = fromMaybe n $ lookup n customs+ customOptions :: [(Name, Name)] -> Options+ customOptions customs+ = defaultOptions+ {promotedDataTypeOrConName = \ n+ -> promotedDataTypeOrConName+ defaultOptions (customPromote customs n),+ defunctionalizedName = \ n sat+ -> defunctionalizedName+ defaultOptions (customPromote customs n) sat}+ messageDecs <- withOptions+ (customOptions+ [(''Message, ''PMessage), ('MkMessage, 'PMkMessage),+ (''Text, ''Symbol)])+ $ do messageDecs1 <- genSingletons [''Message]+ messageDecs2 <- singletons+ [d| appendMessage :: Message -> Message -> Message+ appendMessage+ (MkMessage (x :: Text))+ (MkMessage (y :: Text))+ = MkMessage (x <> y :: Text) |]+ pure $ messageDecs1 ++ messageDecs2+ functionDecs <- withOptions+ (customOptions+ [(''Function, ''PFunction), ('MkFunction, 'PMkFunction)])+ $ do functionDecs1 <- genSingletons [''Function]+ functionDecs2 <- singletons+ [d| composeFunction ::+ Function b c -> Function a b -> Function a c+ composeFunction+ (MkFunction (f :: b -> c))+ (MkFunction (g :: a -> b))+ = MkFunction (f . g :: a -> c) |]+ pure $ functionDecs1 ++ functionDecs2+ pure $ messageDecs ++ functionDecs+ ======>+ type PMkMessageSym0 :: (~>) Symbol PMessage+ data PMkMessageSym0 :: (~>) Symbol PMessage+ where+ PMkMessageSym0KindInference :: SameKind (Apply PMkMessageSym0 arg) (PMkMessageSym1 arg) =>+ PMkMessageSym0 a0123456789876543210+ type instance Apply @Symbol @PMessage PMkMessageSym0 a0123456789876543210 = 'PMkMessage a0123456789876543210+ instance SuppressUnusedWarnings PMkMessageSym0 where+ suppressUnusedWarnings = snd ((,) PMkMessageSym0KindInference ())+ type PMkMessageSym1 :: Symbol -> PMessage+ type family PMkMessageSym1 (a0123456789876543210 :: Symbol) :: PMessage where+ PMkMessageSym1 a0123456789876543210 = 'PMkMessage a0123456789876543210+ type SMessage :: PMessage -> Type+ data SMessage :: PMessage -> Type+ where+ SMkMessage :: forall (n :: Symbol).+ (Sing n) -> SMessage ('PMkMessage n :: PMessage)+ type instance Sing @PMessage = SMessage+ instance SingKind PMessage where+ type Demote PMessage = Message+ fromSing (SMkMessage b) = MkMessage (fromSing b)+ toSing (MkMessage (b :: Demote Symbol))+ = (\cases (SomeSing c) -> SomeSing (SMkMessage c))+ (toSing b :: SomeSing Symbol)+ instance SingI n => SingI ('PMkMessage (n :: Symbol)) where+ sing = SMkMessage sing+ instance SingI1 'PMkMessage where+ liftSing = SMkMessage+ instance SingI (PMkMessageSym0 :: (~>) Symbol PMessage) where+ sing = singFun1 @PMkMessageSym0 SMkMessage+ appendMessage :: Message -> Message -> Message+ appendMessage (MkMessage (x :: Text)) (MkMessage (y :: Text))+ = MkMessage ((x <> y) :: Text)+ type AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage)+ data AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage)+ where+ AppendMessageSym0KindInference :: SameKind (Apply AppendMessageSym0 arg) (AppendMessageSym1 arg) =>+ AppendMessageSym0 a0123456789876543210+ type instance Apply @PMessage @((~>) PMessage PMessage) AppendMessageSym0 a0123456789876543210 = AppendMessageSym1 a0123456789876543210+ instance SuppressUnusedWarnings AppendMessageSym0 where+ suppressUnusedWarnings+ = snd ((,) AppendMessageSym0KindInference ())+ type AppendMessageSym1 :: PMessage -> (~>) PMessage PMessage+ data AppendMessageSym1 (a0123456789876543210 :: PMessage) :: (~>) PMessage PMessage+ where+ AppendMessageSym1KindInference :: SameKind (Apply (AppendMessageSym1 a0123456789876543210) arg) (AppendMessageSym2 a0123456789876543210 arg) =>+ AppendMessageSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @PMessage @PMessage (AppendMessageSym1 a0123456789876543210) a0123456789876543210 = AppendMessage a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (AppendMessageSym1 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) AppendMessageSym1KindInference ())+ type AppendMessageSym2 :: PMessage -> PMessage -> PMessage+ type family AppendMessageSym2 (a0123456789876543210 :: PMessage) (a0123456789876543210 :: PMessage) :: PMessage where+ AppendMessageSym2 a0123456789876543210 a0123456789876543210 = AppendMessage a0123456789876543210 a0123456789876543210+ type AppendMessage :: PMessage -> PMessage -> PMessage+ type family AppendMessage (a :: PMessage) (a :: PMessage) :: PMessage where+ AppendMessage ('PMkMessage (x :: Symbol)) ('PMkMessage (y :: Symbol)) = Apply PMkMessageSym0 (Apply (Apply (<>@#@$) x) y :: Symbol)+ sAppendMessage ::+ (forall (t :: PMessage) (t :: PMessage).+ Sing t -> Sing t -> Sing (AppendMessage t t :: PMessage) :: Type)+ sAppendMessage+ (SMkMessage (sX :: Sing x))+ (SMkMessage (sY :: Sing y))+ = (\cases+ (_ :: Sing (x :: Symbol)) (_ :: Sing (y :: Symbol))+ -> applySing+ (singFun1 @PMkMessageSym0 SMkMessage)+ (applySing (applySing (singFun2 @(<>@#@$) (%<>)) sX) sY ::+ Sing (Apply (Apply (<>@#@$) x) y :: Symbol)))+ (sX :: Sing x) (sY :: Sing y)+ instance SingI (AppendMessageSym0 :: (~>) PMessage ((~>) PMessage PMessage)) where+ sing = singFun2 @AppendMessageSym0 sAppendMessage+ instance SingI d =>+ SingI (AppendMessageSym1 (d :: PMessage) :: (~>) PMessage PMessage) where+ sing+ = singFun1+ @(AppendMessageSym1 (d :: PMessage)) (sAppendMessage (sing @d))+ instance SingI1 (AppendMessageSym1 :: PMessage+ -> (~>) PMessage PMessage) where+ liftSing (s :: Sing (d :: PMessage))+ = singFun1 @(AppendMessageSym1 (d :: PMessage)) (sAppendMessage s)+ type PMkFunctionSym0 :: forall (a :: Type)+ (b :: Type). (~>) ((~>) a b) (PFunction a b)+ data PMkFunctionSym0 :: (~>) ((~>) a b) (PFunction a b)+ where+ PMkFunctionSym0KindInference :: SameKind (Apply PMkFunctionSym0 arg) (PMkFunctionSym1 arg) =>+ PMkFunctionSym0 a0123456789876543210+ type instance Apply @((~>) a b) @(PFunction a b) PMkFunctionSym0 a0123456789876543210 = 'PMkFunction a0123456789876543210+ instance SuppressUnusedWarnings PMkFunctionSym0 where+ suppressUnusedWarnings = snd ((,) PMkFunctionSym0KindInference ())+ type PMkFunctionSym1 :: forall (a :: Type) (b :: Type). (~>) a b+ -> PFunction a b+ type family PMkFunctionSym1 @(a :: Type) @(b :: Type) (a0123456789876543210 :: (~>) a b) :: PFunction a b where+ PMkFunctionSym1 a0123456789876543210 = 'PMkFunction a0123456789876543210+ type SFunction :: forall (a :: Type) (b :: Type). PFunction a b+ -> Type+ data SFunction :: forall (a :: Type) (b :: Type).+ PFunction a b -> Type+ where+ SMkFunction :: forall (a :: Type) (b :: Type) (n :: (~>) a b).+ (Sing n) -> SFunction ('PMkFunction n :: PFunction a b)+ type instance Sing @(PFunction a b) = SFunction+ instance (SingKind a, SingKind b) => SingKind (PFunction a b) where+ type Demote (PFunction a b) = Function (Demote a) (Demote b)+ fromSing (SMkFunction b) = MkFunction (fromSing b)+ toSing (MkFunction (b :: Demote ((~>) a b)))+ = (\cases (SomeSing c) -> SomeSing (SMkFunction c))+ (toSing b :: SomeSing ((~>) a b))+ instance SingI n => SingI ('PMkFunction (n :: (~>) a b)) where+ sing = SMkFunction sing+ instance SingI1 'PMkFunction where+ liftSing = SMkFunction+ instance SingI (PMkFunctionSym0 :: (~>) ((~>) a b) (PFunction a b)) where+ sing = singFun1 @PMkFunctionSym0 SMkFunction+ composeFunction :: Function b c -> Function a b -> Function a c+ composeFunction+ (MkFunction (f :: b -> c))+ (MkFunction (g :: a -> b))+ = MkFunction ((f . g) :: a -> c)+ type ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c))+ data ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c))+ where+ ComposeFunctionSym0KindInference :: SameKind (Apply ComposeFunctionSym0 arg) (ComposeFunctionSym1 arg) =>+ ComposeFunctionSym0 a0123456789876543210+ type instance Apply @(PFunction b c) @((~>) (PFunction a b) (PFunction a c)) ComposeFunctionSym0 a0123456789876543210 = ComposeFunctionSym1 a0123456789876543210+ instance SuppressUnusedWarnings ComposeFunctionSym0 where+ suppressUnusedWarnings+ = snd ((,) ComposeFunctionSym0KindInference ())+ type ComposeFunctionSym1 :: PFunction b c+ -> (~>) (PFunction a b) (PFunction a c)+ data ComposeFunctionSym1 (a0123456789876543210 :: PFunction b c) :: (~>) (PFunction a b) (PFunction a c)+ where+ ComposeFunctionSym1KindInference :: SameKind (Apply (ComposeFunctionSym1 a0123456789876543210) arg) (ComposeFunctionSym2 a0123456789876543210 arg) =>+ ComposeFunctionSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(PFunction a b) @(PFunction a c) (ComposeFunctionSym1 a0123456789876543210) a0123456789876543210 = ComposeFunction a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (ComposeFunctionSym1 a0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) ComposeFunctionSym1KindInference ())+ type ComposeFunctionSym2 :: PFunction b c+ -> PFunction a b -> PFunction a c+ type family ComposeFunctionSym2 @b @c @a (a0123456789876543210 :: PFunction b c) (a0123456789876543210 :: PFunction a b) :: PFunction a c where+ ComposeFunctionSym2 a0123456789876543210 a0123456789876543210 = ComposeFunction a0123456789876543210 a0123456789876543210+ type ComposeFunction :: PFunction b c+ -> PFunction a b -> PFunction a c+ type family ComposeFunction @b @c @a (a :: PFunction b c) (a :: PFunction a b) :: PFunction a c where+ ComposeFunction ('PMkFunction (f :: (~>) b c)) ('PMkFunction (g :: (~>) a b)) = Apply PMkFunctionSym0 (Apply (Apply (.@#@$) f) g :: (~>) a c)+ sComposeFunction ::+ (forall (t :: PFunction b c) (t :: PFunction a b).+ Sing t+ -> Sing t -> Sing (ComposeFunction t t :: PFunction a c) :: Type)+ sComposeFunction+ (SMkFunction (sF :: Sing f))+ (SMkFunction (sG :: Sing g))+ = (\cases+ (_ :: Sing (f :: (~>) b c)) (_ :: Sing (g :: (~>) a b))+ -> applySing+ (singFun1 @PMkFunctionSym0 SMkFunction)+ (applySing (applySing (singFun3 @(.@#@$) (%.)) sF) sG ::+ Sing (Apply (Apply (.@#@$) f) g :: (~>) a c)))+ (sF :: Sing f) (sG :: Sing g)+ instance SingI (ComposeFunctionSym0 :: (~>) (PFunction b c) ((~>) (PFunction a b) (PFunction a c))) where+ sing = singFun2 @ComposeFunctionSym0 sComposeFunction+ instance SingI d =>+ SingI (ComposeFunctionSym1 (d :: PFunction b c) :: (~>) (PFunction a b) (PFunction a c)) where+ sing+ = singFun1+ @(ComposeFunctionSym1 (d :: PFunction b c))+ (sComposeFunction (sing @d))+ instance SingI1 (ComposeFunctionSym1 :: PFunction b c+ -> (~>) (PFunction a b) (PFunction a c)) where+ liftSing (s :: Sing (d :: PFunction b c))+ = singFun1+ @(ComposeFunctionSym1 (d :: PFunction b c)) (sComposeFunction s)
tests/compile-and-dump/Singletons/T450.hs view
@@ -1,53 +1,53 @@-module T450 where - -import Data.Maybe -import Data.Singletons.TH -import Data.Singletons.TH.Options -import Data.Text (Text) -import Language.Haskell.TH (Name) -import Prelude.Singletons - -newtype Message = MkMessage Text -newtype PMessage = PMkMessage Symbol - -newtype Function a b = MkFunction (a -> b) -newtype PFunction a b = PMkFunction (a ~> b) - -$(do let customPromote :: [(Name, Name)] -> Name -> Name - customPromote customs n = fromMaybe n $ lookup n customs - - customOptions :: [(Name, Name)] -> Options - customOptions customs = - defaultOptions{ promotedDataTypeOrConName = \n -> - promotedDataTypeOrConName defaultOptions - (customPromote customs n) - , defunctionalizedName = \n sat -> - defunctionalizedName defaultOptions - (customPromote customs n) sat - } - - messageDecs <- - withOptions (customOptions [ (''Message, ''PMessage) - , ('MkMessage, 'PMkMessage) - , (''Text, ''Symbol) - ]) $ do - messageDecs1 <- genSingletons [''Message] - messageDecs2 <- singletons [d| - appendMessage :: Message -> Message -> Message - appendMessage (MkMessage (x :: Text)) (MkMessage (y :: Text)) = - MkMessage (x <> y :: Text) - |] - pure $ messageDecs1 ++ messageDecs2 - - functionDecs <- - withOptions (customOptions [ (''Function, ''PFunction) - , ('MkFunction, 'PMkFunction) - ]) $ do - functionDecs1 <- genSingletons [''Function] - functionDecs2 <- singletons [d| - composeFunction :: Function b c -> Function a b -> Function a c - composeFunction (MkFunction (f :: b -> c)) (MkFunction (g :: a -> b)) = - MkFunction (f . g :: a -> c) - |] - pure $ functionDecs1 ++ functionDecs2 - pure $ messageDecs ++ functionDecs) +module T450 where++import Data.Maybe+import Data.Singletons.TH+import Data.Singletons.TH.Options+import Data.Text (Text)+import Language.Haskell.TH (Name)+import Prelude.Singletons++newtype Message = MkMessage Text+newtype PMessage = PMkMessage Symbol++newtype Function a b = MkFunction (a -> b)+newtype PFunction a b = PMkFunction (a ~> b)++$(do let customPromote :: [(Name, Name)] -> Name -> Name+ customPromote customs n = fromMaybe n $ lookup n customs++ customOptions :: [(Name, Name)] -> Options+ customOptions customs =+ defaultOptions{ promotedDataTypeOrConName = \n ->+ promotedDataTypeOrConName defaultOptions+ (customPromote customs n)+ , defunctionalizedName = \n sat ->+ defunctionalizedName defaultOptions+ (customPromote customs n) sat+ }++ messageDecs <-+ withOptions (customOptions [ (''Message, ''PMessage)+ , ('MkMessage, 'PMkMessage)+ , (''Text, ''Symbol)+ ]) $ do+ messageDecs1 <- genSingletons [''Message]+ messageDecs2 <- singletons [d|+ appendMessage :: Message -> Message -> Message+ appendMessage (MkMessage (x :: Text)) (MkMessage (y :: Text)) =+ MkMessage (x <> y :: Text)+ |]+ pure $ messageDecs1 ++ messageDecs2++ functionDecs <-+ withOptions (customOptions [ (''Function, ''PFunction)+ , ('MkFunction, 'PMkFunction)+ ]) $ do+ functionDecs1 <- genSingletons [''Function]+ functionDecs2 <- singletons [d|+ composeFunction :: Function b c -> Function a b -> Function a c+ composeFunction (MkFunction (f :: b -> c)) (MkFunction (g :: a -> b)) =+ MkFunction (f . g :: a -> c)+ |]+ pure $ functionDecs1 ++ functionDecs2+ pure $ messageDecs ++ functionDecs)
tests/compile-and-dump/Singletons/T453.golden view
@@ -1,19 +1,19 @@-Singletons/T453.hs:(0,0)-(0,0): Splicing declarations - withOptions defaultOptions {genSingKindInsts = False} - $ singletons - [d| type T1 :: forall k. k -> Type - type T2 :: k -> Type - - data T1 a - data T2 a |] - ======> - type T1 :: forall k. k -> Type - data T1 a - type T2 :: k -> Type - data T2 a - type ST1 :: forall k (a :: k). T1 a -> Type - data ST1 :: forall k (a :: k). T1 a -> Type - type instance Sing @(T1 a) = ST1 - type ST2 :: forall k (a :: k). T2 a -> Type - data ST2 :: forall k (a :: k). T2 a -> Type - type instance Sing @(T2 a) = ST2 +Singletons/T453.hs:(0,0)-(0,0): Splicing declarations+ withOptions defaultOptions {genSingKindInsts = False}+ $ singletons+ [d| type T1 :: forall k. k -> Type+ type T2 :: k -> Type+ + data T1 a+ data T2 a |]+ ======>+ type T1 :: forall k. k -> Type+ data T1 a+ type T2 :: k -> Type+ data T2 a+ type ST1 :: forall k (a :: k). T1 a -> Type+ data ST1 :: forall k (a :: k). T1 a -> Type+ type instance Sing @(T1 a) = ST1+ type ST2 :: forall k (a :: k). T2 a -> Type+ data ST2 :: forall k (a :: k). T2 a -> Type+ type instance Sing @(T2 a) = ST2
tests/compile-and-dump/Singletons/T453.hs view
@@ -1,15 +1,15 @@-module T453 where - -import Control.Monad.Trans.Class -import Data.Kind -import Data.Singletons.TH -import Data.Singletons.TH.Options - -$(withOptions defaultOptions{genSingKindInsts = False} $ - singletons [d| - type T1 :: forall k. k -> Type - data T1 a - - type T2 :: k -> Type - data T2 a - |]) +module T453 where++import Control.Monad.Trans.Class+import Data.Kind+import Data.Singletons.TH+import Data.Singletons.TH.Options++$(withOptions defaultOptions{genSingKindInsts = False} $+ singletons [d|+ type T1 :: forall k. k -> Type+ data T1 a++ type T2 :: k -> Type+ data T2 a+ |])
tests/compile-and-dump/Singletons/T470.golden view
@@ -1,96 +1,98 @@-Singletons/T470.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| type T :: Type -> Type - - data T a - where - MkT1 :: a -> T a - MkT2 :: !Void -> T a - data S = MkS {-# UNPACK #-} !Bool |] - ======> - type T :: Type -> Type - data T a - where - MkT1 :: a -> T a - MkT2 :: !Void -> T a - data S = MkS {-# UNPACK #-} !Bool - type MkT1Sym0 :: (~>) a (T a) - data MkT1Sym0 :: (~>) a (T a) - where - MkT1Sym0KindInference :: SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => - MkT1Sym0 a0123456789876543210 - type instance Apply MkT1Sym0 a0123456789876543210 = MkT1 a0123456789876543210 - instance SuppressUnusedWarnings MkT1Sym0 where - suppressUnusedWarnings = snd ((,) MkT1Sym0KindInference ()) - type MkT1Sym1 :: a -> T a - type family MkT1Sym1 (a0123456789876543210 :: a) :: T a where - MkT1Sym1 a0123456789876543210 = MkT1 a0123456789876543210 - type MkT2Sym0 :: (~>) Void (T a) - data MkT2Sym0 :: (~>) Void (T a) - where - MkT2Sym0KindInference :: SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) => - MkT2Sym0 a0123456789876543210 - type instance Apply MkT2Sym0 a0123456789876543210 = MkT2 a0123456789876543210 - instance SuppressUnusedWarnings MkT2Sym0 where - suppressUnusedWarnings = snd ((,) MkT2Sym0KindInference ()) - type MkT2Sym1 :: Void -> T a - type family MkT2Sym1 (a0123456789876543210 :: Void) :: T a where - MkT2Sym1 a0123456789876543210 = MkT2 a0123456789876543210 - type MkSSym0 :: (~>) Bool S - data MkSSym0 :: (~>) Bool S - where - MkSSym0KindInference :: SameKind (Apply MkSSym0 arg) (MkSSym1 arg) => - MkSSym0 a0123456789876543210 - type instance Apply MkSSym0 a0123456789876543210 = MkS a0123456789876543210 - instance SuppressUnusedWarnings MkSSym0 where - suppressUnusedWarnings = snd ((,) MkSSym0KindInference ()) - type MkSSym1 :: Bool -> S - type family MkSSym1 (a0123456789876543210 :: Bool) :: S where - MkSSym1 a0123456789876543210 = MkS a0123456789876543210 - type ST :: forall (a :: Type). T a -> Type - data ST :: forall (a :: Type). T a -> Type - where - SMkT1 :: forall a (n :: a). (Sing n) -> ST (MkT1 n :: T a) - SMkT2 :: forall a (n :: Void). !(Sing n) -> ST (MkT2 n :: T a) - type instance Sing @(T a) = ST - instance SingKind a => SingKind (T a) where - type Demote (T a) = T (Demote a) - fromSing (SMkT1 b) = MkT1 (fromSing b) - fromSing (SMkT2 b) = MkT2 (fromSing b) - toSing (MkT1 (b :: Demote a)) - = case toSing b :: SomeSing a of SomeSing c -> SomeSing (SMkT1 c) - toSing (MkT2 (b :: Demote Void)) - = case toSing b :: SomeSing Void of - SomeSing c -> SomeSing (SMkT2 c) - data SS :: S -> Type - where SMkS :: forall (n :: Bool). !(Sing n) -> SS (MkS n :: S) - type instance Sing @S = SS - instance SingKind S where - type Demote S = S - fromSing (SMkS b) = MkS (fromSing b) - toSing (MkS (b :: Demote Bool)) - = case toSing b :: SomeSing Bool of SomeSing c -> SomeSing (SMkS c) - instance SingI n => SingI (MkT1 (n :: a)) where - sing = SMkT1 sing - instance SingI1 MkT1 where - liftSing = SMkT1 - instance SingI (MkT1Sym0 :: (~>) a (T a)) where - sing = singFun1 @MkT1Sym0 SMkT1 - instance SingI n => SingI (MkT2 (n :: Void)) where - sing = SMkT2 sing - instance SingI1 MkT2 where - liftSing = SMkT2 - instance SingI (MkT2Sym0 :: (~>) Void (T a)) where - sing = singFun1 @MkT2Sym0 SMkT2 - instance SingI n => SingI (MkS (n :: Bool)) where - sing = SMkS sing - instance SingI1 MkS where - liftSing = SMkS - instance SingI (MkSSym0 :: (~>) Bool S) where - sing = singFun1 @MkSSym0 SMkS - -Singletons/T470.hs:0:0: warning: [GHC-39584] - {-# UNPACK #-} pragmas are ignored by `singletons-th`. - | -6 | $(singletons [d| - | ^^^^^^^^^^^^^^^... +Singletons/T470.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| type T :: Type -> Type+ + data T a+ where+ MkT1 :: a -> T a+ MkT2 :: !Void -> T a+ data S = MkS {-# UNPACK #-} !Bool |]+ ======>+ type T :: Type -> Type+ data T a+ where+ MkT1 :: a -> T a+ MkT2 :: !Void -> T a+ data S = MkS {-# UNPACK #-} !Bool+ type MkT1Sym0 :: (~>) a (T a)+ data MkT1Sym0 :: (~>) a (T a)+ where+ MkT1Sym0KindInference :: SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) =>+ MkT1Sym0 a0123456789876543210+ type instance Apply @a @(T a) MkT1Sym0 a0123456789876543210 = MkT1 a0123456789876543210+ instance SuppressUnusedWarnings MkT1Sym0 where+ suppressUnusedWarnings = snd ((,) MkT1Sym0KindInference ())+ type MkT1Sym1 :: a -> T a+ type family MkT1Sym1 @a (a0123456789876543210 :: a) :: T a where+ MkT1Sym1 a0123456789876543210 = MkT1 a0123456789876543210+ type MkT2Sym0 :: (~>) Void (T a)+ data MkT2Sym0 :: (~>) Void (T a)+ where+ MkT2Sym0KindInference :: SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) =>+ MkT2Sym0 a0123456789876543210+ type instance Apply @Void @(T a) MkT2Sym0 a0123456789876543210 = MkT2 a0123456789876543210+ instance SuppressUnusedWarnings MkT2Sym0 where+ suppressUnusedWarnings = snd ((,) MkT2Sym0KindInference ())+ type MkT2Sym1 :: Void -> T a+ type family MkT2Sym1 @a (a0123456789876543210 :: Void) :: T a where+ MkT2Sym1 a0123456789876543210 = MkT2 a0123456789876543210+ type MkSSym0 :: (~>) Bool S+ data MkSSym0 :: (~>) Bool S+ where+ MkSSym0KindInference :: SameKind (Apply MkSSym0 arg) (MkSSym1 arg) =>+ MkSSym0 a0123456789876543210+ type instance Apply @Bool @S MkSSym0 a0123456789876543210 = MkS a0123456789876543210+ instance SuppressUnusedWarnings MkSSym0 where+ suppressUnusedWarnings = snd ((,) MkSSym0KindInference ())+ type MkSSym1 :: Bool -> S+ type family MkSSym1 (a0123456789876543210 :: Bool) :: S where+ MkSSym1 a0123456789876543210 = MkS a0123456789876543210+ type ST :: forall (a :: Type). T a -> Type+ data ST :: forall (a :: Type). T a -> Type+ where+ SMkT1 :: forall a (n :: a). (Sing n) -> ST (MkT1 n :: T a)+ SMkT2 :: forall a (n :: Void). !(Sing n) -> ST (MkT2 n :: T a)+ type instance Sing @(T a) = ST+ instance SingKind a => SingKind (T a) where+ type Demote (T a) = T (Demote a)+ fromSing (SMkT1 b) = MkT1 (fromSing b)+ fromSing (SMkT2 b) = MkT2 (fromSing b)+ toSing (MkT1 (b :: Demote a))+ = (\cases (SomeSing c) -> SomeSing (SMkT1 c))+ (toSing b :: SomeSing a)+ toSing (MkT2 (b :: Demote Void))+ = (\cases (SomeSing c) -> SomeSing (SMkT2 c))+ (toSing b :: SomeSing Void)+ data SS :: S -> Type+ where SMkS :: forall (n :: Bool). !(Sing n) -> SS (MkS n :: S)+ type instance Sing @S = SS+ instance SingKind S where+ type Demote S = S+ fromSing (SMkS b) = MkS (fromSing b)+ toSing (MkS (b :: Demote Bool))+ = (\cases (SomeSing c) -> SomeSing (SMkS c))+ (toSing b :: SomeSing Bool)+ instance SingI n => SingI (MkT1 (n :: a)) where+ sing = SMkT1 sing+ instance SingI1 MkT1 where+ liftSing = SMkT1+ instance SingI (MkT1Sym0 :: (~>) a (T a)) where+ sing = singFun1 @MkT1Sym0 SMkT1+ instance SingI n => SingI (MkT2 (n :: Void)) where+ sing = SMkT2 sing+ instance SingI1 MkT2 where+ liftSing = SMkT2+ instance SingI (MkT2Sym0 :: (~>) Void (T a)) where+ sing = singFun1 @MkT2Sym0 SMkT2+ instance SingI n => SingI (MkS (n :: Bool)) where+ sing = SMkS sing+ instance SingI1 MkS where+ liftSing = SMkS+ instance SingI (MkSSym0 :: (~>) Bool S) where+ sing = singFun1 @MkSSym0 SMkS+Singletons/T470.hs:0:0: warning: [GHC-39584]+ {-# UNPACK #-} pragmas are ignored by `singletons-th`.+ |+6 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...+
tests/compile-and-dump/Singletons/T470.hs view
@@ -1,24 +1,24 @@-module T470 where - -import Data.Kind -import Data.Singletons.Base.TH - -$(singletons [d| - type T :: Type -> Type - data T a where - MkT1 :: a -> T a - MkT2 :: !Void -> T a - - data S = MkS {-# UNPACK #-} !Bool - |]) - -f :: T a -> a -f (MkT1 x) = x - -type F :: T a -> a -type family F x where - F ('MkT1 x) = x - -sF :: forall a (x :: T a). - Sing x -> Sing (F x) -sF (SMkT1 sx) = sx +module T470 where++import Data.Kind+import Data.Singletons.Base.TH++$(singletons [d|+ type T :: Type -> Type+ data T a where+ MkT1 :: a -> T a+ MkT2 :: !Void -> T a++ data S = MkS {-# UNPACK #-} !Bool+ |])++f :: T a -> a+f (MkT1 x) = x++type F :: T a -> a+type family F x where+ F ('MkT1 x) = x++sF :: forall a (x :: T a).+ Sing x -> Sing (F x)+sF (SMkT1 sx) = sx
tests/compile-and-dump/Singletons/T480.golden view
@@ -1,14 +1,14 @@- -Singletons/T480.hs:0:0: error: [GHC-39584] Q monad failure - | -5 | $(singletons - | ^^^^^^^^^^^... - -Singletons/T480.hs:0:0: error: [GHC-39584] - `singletons-th` does not support wildcard types - unless they appear in visible type patterns of data constructors - In the type: _ - - | -5 | $(singletons - | ^^^^^^^^^^^... ++Singletons/T480.hs:0:0: error: [GHC-39584] Q monad failure+ |+5 | $(singletons+ | ^^^^^^^^^^^...++Singletons/T480.hs:0:0: error: [GHC-39584]+ `singletons-th` does not support wildcard types+ unless they appear in visible type patterns of data constructors+ In the type: _++ |+5 | $(singletons+ | ^^^^^^^^^^^...
tests/compile-and-dump/Singletons/T480.hs view
@@ -1,8 +1,8 @@-module T480 where - -import Data.Singletons.TH - -$(singletons - [d| f :: _ -> _ - f x = x - |]) +module T480 where++import Data.Singletons.TH++$(singletons+ [d| f :: _ -> _+ f x = x+ |])
tests/compile-and-dump/Singletons/T487.golden view
@@ -1,74 +1,73 @@-Singletons/T487.hs:(0,0)-(0,0): Splicing declarations - singletonsOnly - [d| exprEx :: Char - exprEx = 'a' - consEx :: Char -> Symbol - consEx x = consSymbol x "bc" - unconsEx :: Maybe (Char, Symbol) - unconsEx = unconsSymbol "abc" - natToCharEx :: Char - natToCharEx = natToChar 97 - charToNatEx :: Natural - charToNatEx = charToNat 'a' |] - ======> - type CharToNatExSym0 :: Natural - type family CharToNatExSym0 :: Natural where - CharToNatExSym0 = CharToNatEx - type NatToCharExSym0 :: Char - type family NatToCharExSym0 :: Char where - NatToCharExSym0 = NatToCharEx - type UnconsExSym0 :: Maybe (Char, Symbol) - type family UnconsExSym0 :: Maybe (Char, Symbol) where - UnconsExSym0 = UnconsEx - type ConsExSym0 :: (~>) Char Symbol - data ConsExSym0 :: (~>) Char Symbol - where - ConsExSym0KindInference :: SameKind (Apply ConsExSym0 arg) (ConsExSym1 arg) => - ConsExSym0 a0123456789876543210 - type instance Apply ConsExSym0 a0123456789876543210 = ConsEx a0123456789876543210 - instance SuppressUnusedWarnings ConsExSym0 where - suppressUnusedWarnings = snd ((,) ConsExSym0KindInference ()) - type ConsExSym1 :: Char -> Symbol - type family ConsExSym1 (a0123456789876543210 :: Char) :: Symbol where - ConsExSym1 a0123456789876543210 = ConsEx a0123456789876543210 - type ExprExSym0 :: Char - type family ExprExSym0 :: Char where - ExprExSym0 = ExprEx - type CharToNatEx :: Natural - type family CharToNatEx :: Natural where - CharToNatEx = Apply CharToNatSym0 'a' - type NatToCharEx :: Char - type family NatToCharEx :: Char where - NatToCharEx = Apply NatToCharSym0 (FromInteger 97) - type UnconsEx :: Maybe (Char, Symbol) - type family UnconsEx :: Maybe (Char, Symbol) where - UnconsEx = Apply UnconsSymbolSym0 "abc" - type ConsEx :: Char -> Symbol - type family ConsEx (a :: Char) :: Symbol where - ConsEx x = Apply (Apply ConsSymbolSym0 x) "bc" - type ExprEx :: Char - type family ExprEx :: Char where - ExprEx = 'a' - sCharToNatEx :: (Sing (CharToNatExSym0 :: Natural) :: Type) - sNatToCharEx :: (Sing (NatToCharExSym0 :: Char) :: Type) - sUnconsEx :: (Sing (UnconsExSym0 :: Maybe (Char, Symbol)) :: Type) - sConsEx :: - (forall (t :: Char). - Sing t -> Sing (Apply ConsExSym0 t :: Symbol) :: Type) - sExprEx :: (Sing (ExprExSym0 :: Char) :: Type) - sCharToNatEx - = applySing (singFun1 @CharToNatSym0 sCharToNat) (sing :: Sing 'a') - sNatToCharEx - = applySing - (singFun1 @NatToCharSym0 sNatToChar) - (sFromInteger (sing :: Sing 97)) - sUnconsEx - = applySing - (singFun1 @UnconsSymbolSym0 sUnconsSymbol) (sing :: Sing "abc") - sConsEx (sX :: Sing x) - = applySing - (applySing (singFun2 @ConsSymbolSym0 sConsSymbol) sX) - (sing :: Sing "bc") - sExprEx = sing :: Sing 'a' - instance SingI (ConsExSym0 :: (~>) Char Symbol) where - sing = singFun1 @ConsExSym0 sConsEx +Singletons/T487.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| exprEx :: Char+ exprEx = 'a'+ consEx :: Char -> Symbol+ consEx x = consSymbol x "bc"+ unconsEx :: Maybe (Char, Symbol)+ unconsEx = unconsSymbol "abc"+ natToCharEx :: Char+ natToCharEx = natToChar 97+ charToNatEx :: Natural+ charToNatEx = charToNat 'a' |]+ ======>+ type CharToNatExSym0 :: Natural+ type family CharToNatExSym0 :: Natural where+ CharToNatExSym0 = CharToNatEx+ type NatToCharExSym0 :: Char+ type family NatToCharExSym0 :: Char where+ NatToCharExSym0 = NatToCharEx+ type UnconsExSym0 :: Maybe (Char, Symbol)+ type family UnconsExSym0 :: Maybe (Char, Symbol) where+ UnconsExSym0 = UnconsEx+ type ConsExSym0 :: (~>) Char Symbol+ data ConsExSym0 :: (~>) Char Symbol+ where+ ConsExSym0KindInference :: SameKind (Apply ConsExSym0 arg) (ConsExSym1 arg) =>+ ConsExSym0 a0123456789876543210+ type instance Apply @Char @Symbol ConsExSym0 a0123456789876543210 = ConsEx a0123456789876543210+ instance SuppressUnusedWarnings ConsExSym0 where+ suppressUnusedWarnings = snd ((,) ConsExSym0KindInference ())+ type ConsExSym1 :: Char -> Symbol+ type family ConsExSym1 (a0123456789876543210 :: Char) :: Symbol where+ ConsExSym1 a0123456789876543210 = ConsEx a0123456789876543210+ type ExprExSym0 :: Char+ type family ExprExSym0 :: Char where+ ExprExSym0 = ExprEx+ type CharToNatEx :: Natural+ type family CharToNatEx :: Natural where+ CharToNatEx = Apply CharToNatSym0 'a'+ type NatToCharEx :: Char+ type family NatToCharEx :: Char where+ NatToCharEx = Apply NatToCharSym0 (FromInteger 97)+ type UnconsEx :: Maybe (Char, Symbol)+ type family UnconsEx :: Maybe (Char, Symbol) where+ UnconsEx = Apply UnconsSymbolSym0 "abc"+ type ConsEx :: Char -> Symbol+ type family ConsEx (a :: Char) :: Symbol where+ ConsEx x = Apply (Apply ConsSymbolSym0 x) "bc"+ type ExprEx :: Char+ type family ExprEx :: Char where+ ExprEx = 'a'+ sCharToNatEx :: (Sing (CharToNatEx :: Natural) :: Type)+ sNatToCharEx :: (Sing (NatToCharEx :: Char) :: Type)+ sUnconsEx :: (Sing (UnconsEx :: Maybe (Char, Symbol)) :: Type)+ sConsEx ::+ (forall (t :: Char). Sing t -> Sing (ConsEx t :: Symbol) :: Type)+ sExprEx :: (Sing (ExprEx :: Char) :: Type)+ sCharToNatEx+ = applySing (singFun1 @CharToNatSym0 sCharToNat) (sing :: Sing 'a')+ sNatToCharEx+ = applySing+ (singFun1 @NatToCharSym0 sNatToChar)+ (sFromInteger (sing :: Sing 97))+ sUnconsEx+ = applySing+ (singFun1 @UnconsSymbolSym0 sUnconsSymbol) (sing :: Sing "abc")+ sConsEx (sX :: Sing x)+ = applySing+ (applySing (singFun2 @ConsSymbolSym0 sConsSymbol) sX)+ (sing :: Sing "bc")+ sExprEx = sing :: Sing 'a'+ instance SingI (ConsExSym0 :: (~>) Char Symbol) where+ sing = singFun1 @ConsExSym0 sConsEx
tests/compile-and-dump/Singletons/T487.hs view
@@ -1,40 +1,40 @@-module T487 where - -import Data.Singletons.Base.TH -import GHC.TypeLits.Singletons -import Text.Show.Singletons - -$(singletonsOnly [d| - exprEx :: Char - exprEx = 'a' - - consEx :: Char -> Symbol - consEx x = consSymbol x "bc" - - unconsEx :: Maybe (Char, Symbol) - unconsEx = unconsSymbol "abc" - - natToCharEx :: Char - natToCharEx = natToChar 97 - - charToNatEx :: Natural - charToNatEx = charToNat 'a' - |]) - -showCharTest :: Show_ ExprEx :~: "'a'" -showCharTest = Refl - -showSymbolTest :: Show_ "Hello, World!" :~: "\"Hello, World!\"" -showSymbolTest = Refl - -consSymbolTest :: ConsEx 'a' :~: "abc" -consSymbolTest = Refl - -unconsSymbolTest :: UnconsEx :~: Just '( 'a', "bc" ) -unconsSymbolTest = Refl - -natToCharTest :: NatToCharEx :~: 'a' -natToCharTest = Refl - -charToNatTest :: CharToNatEx :~: 97 -charToNatTest = Refl +module T487 where++import Data.Singletons.Base.TH+import GHC.TypeLits.Singletons+import Text.Show.Singletons++$(singletonsOnly [d|+ exprEx :: Char+ exprEx = 'a'++ consEx :: Char -> Symbol+ consEx x = consSymbol x "bc"++ unconsEx :: Maybe (Char, Symbol)+ unconsEx = unconsSymbol "abc"++ natToCharEx :: Char+ natToCharEx = natToChar 97++ charToNatEx :: Natural+ charToNatEx = charToNat 'a'+ |])++showCharTest :: Show_ ExprEx :~: "'a'"+showCharTest = Refl++showSymbolTest :: Show_ "Hello, World!" :~: "\"Hello, World!\""+showSymbolTest = Refl++consSymbolTest :: ConsEx 'a' :~: "abc"+consSymbolTest = Refl++unconsSymbolTest :: UnconsEx :~: Just '( 'a', "bc" )+unconsSymbolTest = Refl++natToCharTest :: NatToCharEx :~: 'a'+natToCharTest = Refl++charToNatTest :: CharToNatEx :~: 97+charToNatTest = Refl
tests/compile-and-dump/Singletons/T489.golden view
@@ -1,61 +1,59 @@-Singletons/T489.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| blah :: Maybe a -> [a] - blah (Just @a x) = [x :: a] - blah (Nothing @a) = [] :: [a] - flurmp :: Maybe () -> () - flurmp (Nothing @_) = () - flurmp (Just ()) = () |] - ======> - blah :: Maybe a -> [a] - blah (Just @a x) = [x :: a] - blah (Nothing @a) = [] :: [a] - flurmp :: Maybe () -> () - flurmp (Nothing @_) = () - flurmp (Just ()) = () - type FlurmpSym0 :: (~>) (Maybe ()) () - data FlurmpSym0 :: (~>) (Maybe ()) () - where - FlurmpSym0KindInference :: SameKind (Apply FlurmpSym0 arg) (FlurmpSym1 arg) => - FlurmpSym0 a0123456789876543210 - type instance Apply FlurmpSym0 a0123456789876543210 = Flurmp a0123456789876543210 - instance SuppressUnusedWarnings FlurmpSym0 where - suppressUnusedWarnings = snd ((,) FlurmpSym0KindInference ()) - type FlurmpSym1 :: Maybe () -> () - type family FlurmpSym1 (a0123456789876543210 :: Maybe ()) :: () where - FlurmpSym1 a0123456789876543210 = Flurmp a0123456789876543210 - type BlahSym0 :: (~>) (Maybe a) [a] - data BlahSym0 :: (~>) (Maybe a) [a] - where - BlahSym0KindInference :: SameKind (Apply BlahSym0 arg) (BlahSym1 arg) => - BlahSym0 a0123456789876543210 - type instance Apply BlahSym0 a0123456789876543210 = Blah a0123456789876543210 - instance SuppressUnusedWarnings BlahSym0 where - suppressUnusedWarnings = snd ((,) BlahSym0KindInference ()) - type BlahSym1 :: Maybe a -> [a] - type family BlahSym1 (a0123456789876543210 :: Maybe a) :: [a] where - BlahSym1 a0123456789876543210 = Blah a0123456789876543210 - type Flurmp :: Maybe () -> () - type family Flurmp (a :: Maybe ()) :: () where - Flurmp ('Nothing @_) = Tuple0Sym0 - Flurmp ('Just '()) = Tuple0Sym0 - type Blah :: Maybe a -> [a] - type family Blah (a :: Maybe a) :: [a] where - Blah ('Just @a x) = Apply (Apply (:@#@$) (x :: a)) NilSym0 - Blah ('Nothing @a) = NilSym0 :: [a] - sFlurmp :: - (forall (t :: Maybe ()). - Sing t -> Sing (Apply FlurmpSym0 t :: ()) :: Type) - sBlah :: - (forall (t :: Maybe a). - Sing t -> Sing (Apply BlahSym0 t :: [a]) :: Type) - sFlurmp (SNothing @_) = STuple0 - sFlurmp (SJust STuple0) = STuple0 - sBlah (SJust @a (sX :: Sing x)) - = applySing - (applySing (singFun2 @(:@#@$) SCons) (sX :: Sing (x :: a))) SNil - sBlah (SNothing @a) = SNil :: Sing (NilSym0 :: [a]) - instance SingI (FlurmpSym0 :: (~>) (Maybe ()) ()) where - sing = singFun1 @FlurmpSym0 sFlurmp - instance SingI (BlahSym0 :: (~>) (Maybe a) [a]) where - sing = singFun1 @BlahSym0 sBlah +Singletons/T489.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| blah :: Maybe a -> [a]+ blah (Just @a x) = [x :: a]+ blah (Nothing @a) = [] :: [a]+ flurmp :: Maybe () -> ()+ flurmp (Nothing @_) = ()+ flurmp (Just ()) = () |]+ ======>+ blah :: Maybe a -> [a]+ blah (Just @a x) = [x :: a]+ blah (Nothing @a) = [] :: [a]+ flurmp :: Maybe () -> ()+ flurmp (Nothing @_) = ()+ flurmp (Just ()) = ()+ type FlurmpSym0 :: (~>) (Maybe ()) ()+ data FlurmpSym0 :: (~>) (Maybe ()) ()+ where+ FlurmpSym0KindInference :: SameKind (Apply FlurmpSym0 arg) (FlurmpSym1 arg) =>+ FlurmpSym0 a0123456789876543210+ type instance Apply @(Maybe ()) @() FlurmpSym0 a0123456789876543210 = Flurmp a0123456789876543210+ instance SuppressUnusedWarnings FlurmpSym0 where+ suppressUnusedWarnings = snd ((,) FlurmpSym0KindInference ())+ type FlurmpSym1 :: Maybe () -> ()+ type family FlurmpSym1 (a0123456789876543210 :: Maybe ()) :: () where+ FlurmpSym1 a0123456789876543210 = Flurmp a0123456789876543210+ type BlahSym0 :: (~>) (Maybe a) [a]+ data BlahSym0 :: (~>) (Maybe a) [a]+ where+ BlahSym0KindInference :: SameKind (Apply BlahSym0 arg) (BlahSym1 arg) =>+ BlahSym0 a0123456789876543210+ type instance Apply @(Maybe a) @[a] BlahSym0 a0123456789876543210 = Blah a0123456789876543210+ instance SuppressUnusedWarnings BlahSym0 where+ suppressUnusedWarnings = snd ((,) BlahSym0KindInference ())+ type BlahSym1 :: Maybe a -> [a]+ type family BlahSym1 @a (a0123456789876543210 :: Maybe a) :: [a] where+ BlahSym1 a0123456789876543210 = Blah a0123456789876543210+ type Flurmp :: Maybe () -> ()+ type family Flurmp (a :: Maybe ()) :: () where+ Flurmp ('Nothing @_) = Tuple0Sym0+ Flurmp ('Just '()) = Tuple0Sym0+ type Blah :: Maybe a -> [a]+ type family Blah @a (a :: Maybe a) :: [a] where+ Blah ('Just @a x) = Apply (Apply (:@#@$) (x :: a)) NilSym0+ Blah ('Nothing @a) = NilSym0 :: [a]+ sFlurmp ::+ (forall (t :: Maybe ()). Sing t -> Sing (Flurmp t :: ()) :: Type)+ sBlah ::+ (forall (t :: Maybe a). Sing t -> Sing (Blah t :: [a]) :: Type)+ sFlurmp (SNothing @_) = STuple0+ sFlurmp (SJust STuple0) = STuple0+ sBlah (SJust @a (sX :: Sing x))+ = applySing+ (applySing (singFun2 @(:@#@$) SCons) (sX :: Sing (x :: a))) SNil+ sBlah (SNothing @a) = SNil :: Sing (NilSym0 :: [a])+ instance SingI (FlurmpSym0 :: (~>) (Maybe ()) ()) where+ sing = singFun1 @FlurmpSym0 sFlurmp+ instance SingI (BlahSym0 :: (~>) (Maybe a) [a]) where+ sing = singFun1 @BlahSym0 sBlah
tests/compile-and-dump/Singletons/T489.hs view
@@ -1,14 +1,14 @@-module T489 where - -import Data.Singletons.Base.TH -import Prelude.Singletons - -$(singletons [d| - blah :: Maybe a -> [a] - blah (Just @a x) = [x :: a] - blah (Nothing @a) = [] :: [a] - - flurmp :: Maybe () -> () - flurmp (Nothing @_) = () - flurmp (Just ()) = () - |]) +module T489 where++import Data.Singletons.Base.TH+import Prelude.Singletons++$(singletons [d|+ blah :: Maybe a -> [a]+ blah (Just @a x) = [x :: a]+ blah (Nothing @a) = [] :: [a]++ flurmp :: Maybe () -> ()+ flurmp (Nothing @_) = ()+ flurmp (Just ()) = ()+ |])
tests/compile-and-dump/Singletons/T492.hs view
@@ -1,25 +1,25 @@-module T492 where - -import Data.Functor.Const -import Data.Functor.Const.Singletons -import Data.Proxy -import Data.Proxy.Singletons -import Prelude.Singletons hiding (Const, ConstSym0, ConstSym1) - -f :: Const Bool Ordering -f = Const @Bool @Ordering True - -sF1 :: SConst ('Const @Bool @Ordering True) -sF1 = SConst @Bool @Ordering STrue - -sF2 :: SConst (ConstSym0 @Bool @Ordering @@ True) -sF2 = singFun1 @(ConstSym0 @Bool @Ordering) SConst @@ STrue - -sF3 :: SConst (ConstSym1 @Bool @Ordering True) -sF3 = SConst @Bool @Ordering STrue - -sP1 :: SProxy ('Proxy @Bool) -sP1 = SProxy @Bool - -sP2 :: SProxy (ProxySym0 @Bool) -sP2 = SProxy @Bool +module T492 where++import Data.Functor.Const+import Data.Functor.Const.Singletons+import Data.Proxy+import Data.Proxy.Singletons+import Prelude.Singletons hiding (Const, ConstSym0, ConstSym1)++f :: Const Bool Ordering+f = Const @Bool @Ordering True++sF1 :: SConst ('Const @Bool @Ordering True)+sF1 = SConst @Bool @Ordering STrue++sF2 :: SConst (ConstSym0 @Bool @Ordering @@ True)+sF2 = singFun1 @(ConstSym0 @Bool @Ordering) SConst @@ STrue++sF3 :: SConst (ConstSym1 @Bool @Ordering True)+sF3 = SConst @Bool @Ordering STrue++sP1 :: SProxy ('Proxy @Bool)+sP1 = SProxy @Bool++sP2 :: SProxy (ProxySym0 @Bool)+sP2 = SProxy @Bool
tests/compile-and-dump/Singletons/T511.golden view
@@ -1,13 +1,13 @@- -Singletons/T511.hs:0:0: error: [GHC-39584] Q monad failure - | -7 | $(singletons [d| - | ^^^^^^^^^^^^^^^... - -Singletons/T511.hs:0:0: error: [GHC-39584] - `singletons-th` does not support partial applications of (->) - In the type: Data.Proxy.Proxy (->) - - | -7 | $(singletons [d| - | ^^^^^^^^^^^^^^^... +Singletons/T511.hs:0:0: error: [GHC-39584] Q monad failure+ |+7 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...++Singletons/T511.hs:0:0: error: [GHC-39584]+ `singletons-th` does not support partial applications of (->)+ In the type: GHC.Internal.Data.Proxy.Proxy (->)++ |+7 | $(singletons [d|+ | ^^^^^^^^^^^^^^^...+
tests/compile-and-dump/Singletons/T511.hs view
@@ -1,9 +1,9 @@-module T511 where - -import Data.Proxy -import Data.Proxy.Singletons -import Data.Singletons.TH - -$(singletons [d| - data Foo = MkFoo (Proxy (->)) - |]) +module T511 where++import Data.Proxy+import Data.Proxy.Singletons+import Data.Singletons.TH++$(singletons [d|+ data Foo = MkFoo (Proxy (->))+ |])
tests/compile-and-dump/Singletons/T536.golden view
@@ -1,97 +1,101 @@-Singletons/T536.hs:(0,0)-(0,0): Splicing declarations - let - customPromote :: Name -> Name - customPromote n - | n == ''Message = ''PMessage - | n == 'MkMessage = 'PMkMessage - | n == ''Text = ''Symbol - | otherwise = promotedDataTypeOrConName defaultOptions n - customDefun :: Name -> Int -> Name - customDefun n sat - = defunctionalizedName defaultOptions (customPromote n) sat - in - withOptions - defaultOptions - {promotedDataTypeOrConName = customPromote, - defunctionalizedName = customDefun} - $ do decs1 <- genSingletons [''Message] - decs2 <- singletons - [d| hello :: Message - hello = MkMessage "hello" |] - decs3 <- singDecideInstances [''Message] - decs4 <- showSingInstances [''Message] - return $ decs1 ++ decs2 ++ decs3 ++ decs4 - ======> - type PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage - data PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage - where - PMkMessageSym0KindInference :: Data.Singletons.SameKind (Data.Singletons.Apply PMkMessageSym0 arg) (PMkMessageSym1 arg) => - PMkMessageSym0 a0123456789876543210 - type instance Data.Singletons.Apply PMkMessageSym0 a0123456789876543210 = 'PMkMessage a0123456789876543210 - instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings PMkMessageSym0 where - Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings - = snd ((,) PMkMessageSym0KindInference ()) - type PMkMessageSym1 :: Symbol -> PMessage - type family PMkMessageSym1 (a0123456789876543210 :: Symbol) :: PMessage where - PMkMessageSym1 a0123456789876543210 = 'PMkMessage a0123456789876543210 - type SMessage :: PMessage -> Type - data SMessage :: PMessage -> Type - where - SMkMessage :: forall (n :: Symbol). - (Data.Singletons.Sing n) -> SMessage ('PMkMessage n :: PMessage) - type instance Data.Singletons.Sing @PMessage = SMessage - instance Data.Singletons.SingKind PMessage where - type Data.Singletons.Demote PMessage = Message - Data.Singletons.fromSing (SMkMessage b) - = MkMessage (Data.Singletons.fromSing b) - Data.Singletons.toSing - (MkMessage (b :: Data.Singletons.Demote Symbol)) - = case Data.Singletons.toSing b :: Data.Singletons.SomeSing Symbol - of - Data.Singletons.SomeSing c - -> Data.Singletons.SomeSing (SMkMessage c) - instance Data.Singletons.SingI n => - Data.Singletons.SingI ('PMkMessage (n :: Symbol)) where - Data.Singletons.sing = SMkMessage Data.Singletons.sing - instance Data.Singletons.SingI1 'PMkMessage where - Data.Singletons.liftSing = SMkMessage - instance Data.Singletons.SingI (PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage) where - Data.Singletons.sing - = Data.Singletons.singFun1 @PMkMessageSym0 SMkMessage - hello :: Message - hello = MkMessage "hello" - type HelloSym0 :: PMessage - type family HelloSym0 :: PMessage where - HelloSym0 = Hello - type Hello :: PMessage - type family Hello :: PMessage where - Hello = Data.Singletons.Apply PMkMessageSym0 (FromString "hello") - sHello :: (Data.Singletons.Sing (HelloSym0 :: PMessage) :: Type) - sHello - = Data.Singletons.applySing - (Data.Singletons.singFun1 @PMkMessageSym0 SMkMessage) - (sFromString - (Data.Singletons.sing :: Data.Singletons.Sing "hello")) - instance Data.Singletons.Decide.SDecide Text => - Data.Singletons.Decide.SDecide PMessage where - (Data.Singletons.Decide.%~) (SMkMessage a) (SMkMessage b) - = case (Data.Singletons.Decide.%~) a b of - Data.Singletons.Decide.Proved Data.Type.Equality.Refl - -> Data.Singletons.Decide.Proved Data.Type.Equality.Refl - Data.Singletons.Decide.Disproved contra - -> Data.Singletons.Decide.Disproved - (\ refl - -> case refl of - Data.Type.Equality.Refl -> contra Data.Type.Equality.Refl) - instance Data.Singletons.Decide.SDecide Text => - Data.Type.Equality.TestEquality (SMessage :: PMessage - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Singletons.Decide.SDecide Text => - Data.Type.Coercion.TestCoercion (SMessage :: PMessage - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Data.Singletons.ShowSing.ShowSing Text => - Show (SMessage (z :: PMessage)) +Singletons/T536.hs:(0,0)-(0,0): Splicing declarations+ let+ customPromote :: Name -> Name+ customPromote n+ | n == ''Message = ''PMessage+ | n == 'MkMessage = 'PMkMessage+ | n == ''Text = ''Symbol+ | otherwise = promotedDataTypeOrConName defaultOptions n+ customDefun :: Name -> Int -> Name+ customDefun n sat+ = defunctionalizedName defaultOptions (customPromote n) sat+ in+ withOptions+ defaultOptions+ {promotedDataTypeOrConName = customPromote,+ defunctionalizedName = customDefun}+ $ do decs1 <- genSingletons [''Message]+ decs2 <- singletons+ [d| hello :: Message+ hello = MkMessage "hello" |]+ decs3 <- singDecideInstances [''Message]+ decs4 <- showSingInstances [''Message]+ return $ decs1 ++ decs2 ++ decs3 ++ decs4+ ======>+ type PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage+ data PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage+ where+ PMkMessageSym0KindInference :: Data.Singletons.SameKind (Data.Singletons.Apply PMkMessageSym0 arg) (PMkMessageSym1 arg) =>+ PMkMessageSym0 a0123456789876543210+ type instance Data.Singletons.Apply @Symbol @PMessage PMkMessageSym0 a0123456789876543210 = 'PMkMessage a0123456789876543210+ instance Data.Singletons.TH.SuppressUnusedWarnings.SuppressUnusedWarnings PMkMessageSym0 where+ Data.Singletons.TH.SuppressUnusedWarnings.suppressUnusedWarnings+ = snd ((,) PMkMessageSym0KindInference ())+ type PMkMessageSym1 :: Symbol -> PMessage+ type family PMkMessageSym1 (a0123456789876543210 :: Symbol) :: PMessage where+ PMkMessageSym1 a0123456789876543210 = 'PMkMessage a0123456789876543210+ type SMessage :: PMessage -> Type+ data SMessage :: PMessage -> Type+ where+ SMkMessage :: forall (n :: Symbol).+ (Data.Singletons.Sing n) -> SMessage ('PMkMessage n :: PMessage)+ type instance Data.Singletons.Sing @PMessage = SMessage+ instance Data.Singletons.SingKind PMessage where+ type Data.Singletons.Demote PMessage = Message+ Data.Singletons.fromSing (SMkMessage b)+ = MkMessage (Data.Singletons.fromSing b)+ Data.Singletons.toSing+ (MkMessage (b :: Data.Singletons.Demote Symbol))+ = (\cases+ (Data.Singletons.SomeSing c)+ -> Data.Singletons.SomeSing (SMkMessage c))+ (Data.Singletons.toSing b :: Data.Singletons.SomeSing Symbol)+ instance Data.Singletons.SingI n =>+ Data.Singletons.SingI ('PMkMessage (n :: Symbol)) where+ Data.Singletons.sing = SMkMessage Data.Singletons.sing+ instance Data.Singletons.SingI1 'PMkMessage where+ Data.Singletons.liftSing = SMkMessage+ instance Data.Singletons.SingI (PMkMessageSym0 :: (Data.Singletons.~>) Symbol PMessage) where+ Data.Singletons.sing+ = Data.Singletons.singFun1 @PMkMessageSym0 SMkMessage+ hello :: Message+ hello = MkMessage "hello"+ type HelloSym0 :: PMessage+ type family HelloSym0 :: PMessage where+ HelloSym0 = Hello+ type Hello :: PMessage+ type family Hello :: PMessage where+ Hello = Data.Singletons.Apply PMkMessageSym0 (FromString "hello")+ sHello :: (Data.Singletons.Sing (Hello :: PMessage) :: Type)+ sHello+ = Data.Singletons.applySing+ (Data.Singletons.singFun1 @PMkMessageSym0 SMkMessage)+ (sFromString+ (Data.Singletons.sing :: Data.Singletons.Sing "hello"))+ instance Data.Singletons.Decide.SDecide Text =>+ Data.Singletons.Decide.SDecide PMessage where+ (Data.Singletons.Decide.%~) (SMkMessage a) (SMkMessage b)+ = (\cases+ (Data.Singletons.Decide.Proved GHC.Internal.Data.Type.Equality.Refl)+ -> Data.Singletons.Decide.Proved+ GHC.Internal.Data.Type.Equality.Refl+ (Data.Singletons.Decide.Disproved contra)+ -> Data.Singletons.Decide.Disproved+ (\cases+ GHC.Internal.Data.Type.Equality.Refl+ -> contra GHC.Internal.Data.Type.Equality.Refl))+ ((Data.Singletons.Decide.%~) a b)+ instance Eq (SMessage (z :: PMessage)) where+ (==) _ _ = True+ instance Data.Singletons.Decide.SDecide Text =>+ GHC.Internal.Data.Type.Equality.TestEquality (SMessage :: PMessage+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance Data.Singletons.Decide.SDecide Text =>+ GHC.Internal.Data.Type.Coercion.TestCoercion (SMessage :: PMessage+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ deriving instance Data.Singletons.ShowSing.ShowSing Text =>+ Show (SMessage (z :: PMessage))
tests/compile-and-dump/Singletons/T536.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE OverloadedStrings #-} -module T536 where - -import Data.Singletons.TH (genSingletons, showSingInstances, - singDecideInstances, singletons) -import Data.Singletons.TH.Options (defaultOptions, - defunctionalizedName, - promotedDataTypeOrConName, - withOptions) -import Data.String (fromString) -import Data.String.Singletons (FromString, sFromString) -import Data.Text (Text) -import GHC.TypeLits.Singletons (Symbol) -import Language.Haskell.TH (Name) - --- Term-level -newtype Message = MkMessage Text --- Type-level -newtype PMessage = PMkMessage Symbol - -$(let customPromote :: Name -> Name - customPromote n - | n == ''Message = ''PMessage - | n == 'MkMessage = 'PMkMessage - | n == ''Text = ''Symbol - | otherwise = promotedDataTypeOrConName defaultOptions n - - customDefun :: Name -> Int -> Name - customDefun n sat = defunctionalizedName defaultOptions (customPromote n) sat in - - withOptions defaultOptions{ promotedDataTypeOrConName = customPromote - , defunctionalizedName = customDefun - } $ do - decs1 <- genSingletons [''Message] - decs2 <- singletons [d| - hello :: Message - hello = MkMessage "hello" - |] - decs3 <- singDecideInstances [''Message] - decs4 <- showSingInstances [''Message] - return $ decs1 ++ decs2 ++ decs3 ++ decs4) +{-# LANGUAGE OverloadedStrings #-}+module T536 where++import Data.Singletons.TH (genSingletons, showSingInstances,+ singDecideInstances, singletons)+import Data.Singletons.TH.Options (defaultOptions,+ defunctionalizedName,+ promotedDataTypeOrConName,+ withOptions)+import Data.String (fromString)+import Data.String.Singletons (FromString, sFromString)+import Data.Text (Text)+import GHC.TypeLits.Singletons (Symbol)+import Language.Haskell.TH (Name)++-- Term-level+newtype Message = MkMessage Text+-- Type-level+newtype PMessage = PMkMessage Symbol++$(let customPromote :: Name -> Name+ customPromote n+ | n == ''Message = ''PMessage+ | n == 'MkMessage = 'PMkMessage+ | n == ''Text = ''Symbol+ | otherwise = promotedDataTypeOrConName defaultOptions n++ customDefun :: Name -> Int -> Name+ customDefun n sat = defunctionalizedName defaultOptions (customPromote n) sat in++ withOptions defaultOptions{ promotedDataTypeOrConName = customPromote+ , defunctionalizedName = customDefun+ } $ do+ decs1 <- genSingletons [''Message]+ decs2 <- singletons [d|+ hello :: Message+ hello = MkMessage "hello"+ |]+ decs3 <- singDecideInstances [''Message]+ decs4 <- showSingInstances [''Message]+ return $ decs1 ++ decs2 ++ decs3 ++ decs4)
tests/compile-and-dump/Singletons/T54.golden view
@@ -1,57 +1,46 @@-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 - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - ((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference - ()) - type family Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 - type family Let0123456789876543210Scrutinee_0123456789876543210 e where - Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) NilSym0 - type family Case_0123456789876543210 e t where - Case_0123456789876543210 e '[_] = NotSym0 - type GSym0 :: (~>) Bool Bool - data GSym0 :: (~>) Bool Bool - where - GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0 a0123456789876543210 - type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings = snd ((,) GSym0KindInference ()) - type GSym1 :: Bool -> Bool - type family GSym1 (a0123456789876543210 :: Bool) :: Bool where - GSym1 a0123456789876543210 = G a0123456789876543210 - type G :: Bool -> Bool - 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) :: Type) - sG (sE :: Sing e) - = applySing - (let - sScrutinee_0123456789876543210 :: - Sing @_ (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) - sScrutinee_0123456789876543210 - = applySing - (applySing (singFun2 @(:@#@$) SCons) (singFun1 @NotSym0 sNot)) SNil - in - id - @(Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e))) - (case sScrutinee_0123456789876543210 of - SCons _ SNil -> singFun1 @NotSym0 sNot)) - sE - instance SingI (GSym0 :: (~>) Bool Bool) where - sing = singFun1 @GSym0 sG +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 family LamCases_0123456789876543210 (e0123456789876543210 :: Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 e '[_] = NotSym0+ data LamCases_0123456789876543210Sym0 (e0123456789876543210 :: Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 e0123456789876543210) arg) (LamCases_0123456789876543210Sym1 e0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 e0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 e0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 e0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 e0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (e0123456789876543210 :: Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 e0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 e0123456789876543210 a_01234567898765432100123456789876543210+ type GSym0 :: (~>) Bool Bool+ data GSym0 :: (~>) Bool Bool+ where+ GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) =>+ GSym0 a0123456789876543210+ type instance Apply @Bool @Bool GSym0 a0123456789876543210 = G a0123456789876543210+ instance SuppressUnusedWarnings GSym0 where+ suppressUnusedWarnings = snd ((,) GSym0KindInference ())+ type GSym1 :: Bool -> Bool+ type family GSym1 (a0123456789876543210 :: Bool) :: Bool where+ GSym1 a0123456789876543210 = G a0123456789876543210+ type G :: Bool -> Bool+ type family G (a :: Bool) :: Bool where+ G e = Apply (Apply (LamCases_0123456789876543210Sym0 e) (Apply (Apply (:@#@$) NotSym0) NilSym0)) e+ sG :: (forall (t :: Bool). Sing t -> Sing (G t :: Bool) :: Type)+ sG (sE :: Sing e)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 e)+ (\cases (SCons _ SNil) -> singFun1 @NotSym0 sNot))+ (applySing+ (applySing (singFun2 @(:@#@$) SCons) (singFun1 @NotSym0 sNot))+ SNil))+ sE+ instance SingI (GSym0 :: (~>) Bool Bool) where+ sing = singFun1 @GSym0 sG
tests/compile-and-dump/Singletons/T54.hs view
@@ -1,12 +1,12 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Singletons.T54 where - -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - g :: Bool -> Bool - g e = (case [not] of - [_] -> not) e - |]) +{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++module Singletons.T54 where++import Data.Singletons.TH+import Prelude.Singletons++$(singletons [d|+ g :: Bool -> Bool+ g e = (case [not] of+ [_] -> not) e+ |])
tests/compile-and-dump/Singletons/T555.golden view
@@ -1,203 +1,110 @@-Singletons/T555.hs:(0,0)-(0,0): Splicing declarations - singletons - [d| data MyPropKind - = Location | Quaternion - deriving (Eq, Ord, Show) |] - ======> - data MyPropKind - = Location | Quaternion - deriving (Eq, Ord, Show) - type LocationSym0 :: MyPropKind - type family LocationSym0 :: MyPropKind where - LocationSym0 = Location - type QuaternionSym0 :: MyPropKind - type family QuaternionSym0 :: MyPropKind where - QuaternionSym0 = Quaternion - type TFHelper_0123456789876543210 :: MyPropKind - -> MyPropKind -> Bool - type family TFHelper_0123456789876543210 (a :: MyPropKind) (a :: MyPropKind) :: Bool where - TFHelper_0123456789876543210 Location Location = TrueSym0 - TFHelper_0123456789876543210 Location Quaternion = FalseSym0 - TFHelper_0123456789876543210 Quaternion Location = FalseSym0 - TFHelper_0123456789876543210 Quaternion Quaternion = TrueSym0 - type TFHelper_0123456789876543210Sym0 :: (~>) MyPropKind ((~>) MyPropKind Bool) - data TFHelper_0123456789876543210Sym0 :: (~>) MyPropKind ((~>) MyPropKind Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym0KindInference ()) - type TFHelper_0123456789876543210Sym1 :: MyPropKind - -> (~>) MyPropKind Bool - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: MyPropKind) :: (~>) MyPropKind Bool - where - TFHelper_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) TFHelper_0123456789876543210Sym1KindInference ()) - type TFHelper_0123456789876543210Sym2 :: MyPropKind - -> MyPropKind -> Bool - type family TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: MyPropKind) (a0123456789876543210 :: MyPropKind) :: Bool where - TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PEq MyPropKind where - type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a - type Compare_0123456789876543210 :: MyPropKind - -> MyPropKind -> Ordering - type family Compare_0123456789876543210 (a :: MyPropKind) (a :: MyPropKind) :: Ordering where - Compare_0123456789876543210 Location Location = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 Quaternion Quaternion = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0 - Compare_0123456789876543210 Location Quaternion = LTSym0 - Compare_0123456789876543210 Quaternion Location = GTSym0 - type Compare_0123456789876543210Sym0 :: (~>) MyPropKind ((~>) MyPropKind Ordering) - data Compare_0123456789876543210Sym0 :: (~>) MyPropKind ((~>) MyPropKind Ordering) - where - Compare_0123456789876543210Sym0KindInference :: SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym0KindInference ()) - type Compare_0123456789876543210Sym1 :: MyPropKind - -> (~>) MyPropKind Ordering - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: MyPropKind) :: (~>) MyPropKind Ordering - where - Compare_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) Compare_0123456789876543210Sym1KindInference ()) - type Compare_0123456789876543210Sym2 :: MyPropKind - -> MyPropKind -> Ordering - type family Compare_0123456789876543210Sym2 (a0123456789876543210 :: MyPropKind) (a0123456789876543210 :: MyPropKind) :: Ordering where - Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance POrd MyPropKind where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type ShowsPrec_0123456789876543210 :: GHC.Num.Natural.Natural - -> MyPropKind -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210 (a :: GHC.Num.Natural.Natural) (a :: MyPropKind) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 _ Location a_0123456789876543210 = Apply (Apply ShowStringSym0 "Location") a_0123456789876543210 - ShowsPrec_0123456789876543210 _ Quaternion a_0123456789876543210 = Apply (Apply ShowStringSym0 "Quaternion") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) MyPropKind ((~>) Symbol Symbol)) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural ((~>) MyPropKind ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym0KindInference ()) - type ShowsPrec_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> (~>) MyPropKind ((~>) Symbol Symbol) - data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: (~>) MyPropKind ((~>) Symbol Symbol) - where - ShowsPrec_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym1KindInference ()) - type ShowsPrec_0123456789876543210Sym2 :: GHC.Num.Natural.Natural - -> MyPropKind -> (~>) Symbol Symbol - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: MyPropKind) :: (~>) Symbol Symbol - where - ShowsPrec_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings - = snd ((,) ShowsPrec_0123456789876543210Sym2KindInference ()) - type ShowsPrec_0123456789876543210Sym3 :: GHC.Num.Natural.Natural - -> MyPropKind -> Symbol -> Symbol - type family ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Num.Natural.Natural) (a0123456789876543210 :: MyPropKind) (a0123456789876543210 :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance PShow MyPropKind where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - data SMyPropKind :: MyPropKind -> Type - where - SLocation :: SMyPropKind (Location :: MyPropKind) - SQuaternion :: SMyPropKind (Quaternion :: MyPropKind) - type instance Sing @MyPropKind = SMyPropKind - instance SingKind MyPropKind where - type Demote MyPropKind = MyPropKind - fromSing SLocation = Location - fromSing SQuaternion = Quaternion - toSing Location = SomeSing SLocation - toSing Quaternion = SomeSing SQuaternion - instance SEq MyPropKind where - (%==) :: - forall (t1 :: MyPropKind) (t2 :: MyPropKind). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply ((==@#@$) :: TyFun MyPropKind ((~>) MyPropKind Bool) - -> Type) t1) t2) - (%==) SLocation SLocation = STrue - (%==) SLocation SQuaternion = SFalse - (%==) SQuaternion SLocation = SFalse - (%==) SQuaternion SQuaternion = STrue - instance SOrd MyPropKind where - sCompare :: - forall (t1 :: MyPropKind) (t2 :: MyPropKind). Sing t1 - -> Sing t2 - -> Sing (Apply (Apply (CompareSym0 :: TyFun MyPropKind ((~>) MyPropKind Ordering) - -> Type) t1) t2) - sCompare SLocation SLocation - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SQuaternion SQuaternion - = applySing - (applySing - (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>))) - SEQ) - SNil - sCompare SLocation SQuaternion = SLT - sCompare SQuaternion SLocation = SGT - instance SShow MyPropKind where - sShowsPrec :: - forall (t1 :: GHC.Num.Natural.Natural) - (t2 :: MyPropKind) - (t3 :: Symbol). Sing t1 - -> Sing t2 - -> Sing t3 - -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Num.Natural.Natural ((~>) MyPropKind ((~>) Symbol Symbol)) - -> Type) t1) t2) t3) - sShowsPrec - _ - SLocation - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Location")) - sA_0123456789876543210 - sShowsPrec - _ - SQuaternion - (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (applySing - (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Quaternion")) - sA_0123456789876543210 - instance SDecide MyPropKind where - (%~) SLocation SLocation = Proved Refl - (%~) SLocation SQuaternion = Disproved (\ x -> case x of {}) - (%~) SQuaternion SLocation = Disproved (\ x -> case x of {}) - (%~) SQuaternion SQuaternion = Proved Refl - instance Data.Type.Equality.TestEquality (SMyPropKind :: MyPropKind - -> Type) where - Data.Type.Equality.testEquality - = Data.Singletons.Decide.decideEquality - instance Data.Type.Coercion.TestCoercion (SMyPropKind :: MyPropKind - -> Type) where - Data.Type.Coercion.testCoercion - = Data.Singletons.Decide.decideCoercion - deriving instance Show (SMyPropKind (z :: MyPropKind)) - instance SingI Location where - sing = SLocation - instance SingI Quaternion where - sing = SQuaternion +Singletons/T555.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| data MyPropKind+ = Location | Quaternion+ deriving (Eq, Ord, Show) |]+ ======>+ data MyPropKind+ = Location | Quaternion+ deriving (Eq, Ord, Show)+ type LocationSym0 :: MyPropKind+ type family LocationSym0 :: MyPropKind where+ LocationSym0 = Location+ type QuaternionSym0 :: MyPropKind+ type family QuaternionSym0 :: MyPropKind where+ QuaternionSym0 = Quaternion+ type TFHelper_0123456789876543210 :: MyPropKind+ -> MyPropKind -> Bool+ type family TFHelper_0123456789876543210 (a :: MyPropKind) (a :: MyPropKind) :: Bool where+ TFHelper_0123456789876543210 Location Location = TrueSym0+ TFHelper_0123456789876543210 Location Quaternion = FalseSym0+ TFHelper_0123456789876543210 Quaternion Location = FalseSym0+ TFHelper_0123456789876543210 Quaternion Quaternion = TrueSym0+ instance PEq MyPropKind where+ type (==) a a = TFHelper_0123456789876543210 a a+ type Compare_0123456789876543210 :: MyPropKind+ -> MyPropKind -> Ordering+ type family Compare_0123456789876543210 (a :: MyPropKind) (a :: MyPropKind) :: Ordering where+ Compare_0123456789876543210 Location Location = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 Quaternion Quaternion = Apply (Apply (Apply FoldlSym0 (<>@#@$)) EQSym0) NilSym0+ Compare_0123456789876543210 Location Quaternion = LTSym0+ Compare_0123456789876543210 Quaternion Location = GTSym0+ instance POrd MyPropKind where+ type Compare a a = Compare_0123456789876543210 a a+ type ShowsPrec_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> MyPropKind -> Symbol -> Symbol+ type family ShowsPrec_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) (a :: MyPropKind) (a :: Symbol) :: Symbol where+ ShowsPrec_0123456789876543210 _ Location a_0123456789876543210 = Apply (Apply ShowStringSym0 "Location") a_0123456789876543210+ ShowsPrec_0123456789876543210 _ Quaternion a_0123456789876543210 = Apply (Apply ShowStringSym0 "Quaternion") a_0123456789876543210+ instance PShow MyPropKind where+ type ShowsPrec a a a = ShowsPrec_0123456789876543210 a a a+ data SMyPropKind :: MyPropKind -> Type+ where+ SLocation :: SMyPropKind (Location :: MyPropKind)+ SQuaternion :: SMyPropKind (Quaternion :: MyPropKind)+ type instance Sing @MyPropKind = SMyPropKind+ instance SingKind MyPropKind where+ type Demote MyPropKind = MyPropKind+ fromSing SLocation = Location+ fromSing SQuaternion = Quaternion+ toSing Location = SomeSing SLocation+ toSing Quaternion = SomeSing SQuaternion+ instance SEq MyPropKind where+ (%==) SLocation SLocation = STrue+ (%==) SLocation SQuaternion = SFalse+ (%==) SQuaternion SLocation = SFalse+ (%==) SQuaternion SQuaternion = STrue+ instance SOrd MyPropKind where+ sCompare SLocation SLocation+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SQuaternion SQuaternion+ = applySing+ (applySing+ (applySing (singFun3 @FoldlSym0 sFoldl) (singFun2 @(<>@#@$) (%<>)))+ SEQ)+ SNil+ sCompare SLocation SQuaternion = SLT+ sCompare SQuaternion SLocation = SGT+ instance SShow MyPropKind where+ sShowsPrec+ _+ SLocation+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Location"))+ sA_0123456789876543210+ sShowsPrec+ _+ SQuaternion+ (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun2 @ShowStringSym0 sShowString) (sing :: Sing "Quaternion"))+ sA_0123456789876543210+ instance SDecide MyPropKind where+ (%~) SLocation SLocation = Proved Refl+ (%~) SLocation SQuaternion = Disproved (\case)+ (%~) SQuaternion SLocation = Disproved (\case)+ (%~) SQuaternion SQuaternion = Proved Refl+ instance Eq (SMyPropKind (z :: MyPropKind)) where+ (==) _ _ = True+ instance GHC.Internal.Data.Type.Equality.TestEquality (SMyPropKind :: MyPropKind+ -> Type) where+ GHC.Internal.Data.Type.Equality.testEquality+ = Data.Singletons.Decide.decideEquality+ instance GHC.Internal.Data.Type.Coercion.TestCoercion (SMyPropKind :: MyPropKind+ -> Type) where+ GHC.Internal.Data.Type.Coercion.testCoercion+ = Data.Singletons.Decide.decideCoercion+ instance Ord (SMyPropKind (z :: MyPropKind)) where+ compare _ _ = EQ+ deriving instance Show (SMyPropKind (z :: MyPropKind))+ instance SingI Location where+ sing = SLocation+ instance SingI Quaternion where+ sing = SQuaternion
tests/compile-and-dump/Singletons/T555.hs view
@@ -1,15 +1,15 @@-module T555 where - --- NB: /not/ importing Data.Singletons.Base.TH below, but rather the more --- restricted Data.Singletons.TH that does not re-export anything from --- singletons-base. We want to ensure that this code works with only a simple --- Prelude.Singletons import if possible. -import Data.Singletons.TH -import Prelude.Singletons - -$(singletons [d| - data MyPropKind = Location - | Quaternion - - deriving(Eq,Ord,Show) - |]) +module T555 where++-- NB: /not/ importing Data.Singletons.Base.TH below, but rather the more+-- restricted Data.Singletons.TH that does not re-export anything from+-- singletons-base. We want to ensure that this code works with only a simple+-- Prelude.Singletons import if possible.+import Data.Singletons.TH+import Prelude.Singletons++$(singletons [d|+ data MyPropKind = Location+ | Quaternion++ deriving(Eq,Ord,Show)+ |])
tests/compile-and-dump/Singletons/T559.golden view
@@ -1,11 +1,11 @@-Singletons/T559.hs:0:0:: Splicing declarations - singletons [d| type data T = MkT |] - ======> - type data T = MkT - type MkTSym0 :: T - type family MkTSym0 :: T where - MkTSym0 = MkT - data ST :: T -> Type where SMkT :: ST (MkT :: T) - type instance Sing @T = ST - instance SingI MkT where - sing = SMkT +Singletons/T559.hs:0:0:: Splicing declarations+ singletons [d| type data T = MkT |]+ ======>+ type data T = MkT+ type MkTSym0 :: T+ type family MkTSym0 :: T where+ MkTSym0 = MkT+ data ST :: T -> Type where SMkT :: ST (MkT :: T)+ type instance Sing @T = ST+ instance SingI MkT where+ sing = SMkT
tests/compile-and-dump/Singletons/T559.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE TypeData #-} -module T559 where - -import Data.Singletons.TH - -$(singletons [d| type data T = MkT |]) +{-# LANGUAGE TypeData #-}+module T559 where++import Data.Singletons.TH++$(singletons [d| type data T = MkT |])
+ tests/compile-and-dump/Singletons/T563.golden view
@@ -0,0 +1,70 @@+Singletons/T563.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| infixr 6 `unFoo`+ + data Foo = MkFoo {unFoo :: Bool} |]+ ======>+ infixr 6 `unFoo`+ data Foo = MkFoo {unFoo :: Bool}+ type MkFooSym0 :: (~>) Bool Foo+ data MkFooSym0 :: (~>) Bool Foo+ where+ MkFooSym0KindInference :: SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) =>+ MkFooSym0 a0123456789876543210+ type instance Apply @Bool @Foo MkFooSym0 a0123456789876543210 = MkFoo a0123456789876543210+ instance SuppressUnusedWarnings MkFooSym0 where+ suppressUnusedWarnings = snd ((,) MkFooSym0KindInference ())+ type MkFooSym1 :: Bool -> Foo+ type family MkFooSym1 (a0123456789876543210 :: Bool) :: Foo where+ MkFooSym1 a0123456789876543210 = MkFoo a0123456789876543210+ data SFoo :: Foo -> Type+ where+ SMkFoo :: forall (n :: Bool). (Sing n) -> SFoo (MkFoo n :: Foo)+ type instance Sing @Foo = SFoo+ instance SingKind Foo where+ type Demote Foo = Foo+ fromSing (SMkFoo b) = MkFoo (fromSing b)+ toSing (MkFoo (b :: Demote Bool))+ = (\cases (SomeSing c) -> SomeSing (SMkFoo c))+ (toSing b :: SomeSing Bool)+ instance SingI n => SingI (MkFoo (n :: Bool)) where+ sing = SMkFoo sing+ instance SingI1 MkFoo where+ liftSing = SMkFoo+ instance SingI (MkFooSym0 :: (~>) Bool Foo) where+ sing = singFun1 @MkFooSym0 SMkFoo+Singletons/T563.hs:(0,0)-(0,0): Splicing declarations+ singletonsOnly+ [d| unFoo' :: Foo -> Bool+ unFoo' = unFoo |]+ ======>+ type UnFoo'Sym0 :: (~>) Foo Bool+ data UnFoo'Sym0 :: (~>) Foo Bool+ where+ UnFoo'Sym0KindInference :: SameKind (Apply UnFoo'Sym0 arg) (UnFoo'Sym1 arg) =>+ UnFoo'Sym0 a0123456789876543210+ type instance Apply @Foo @Bool UnFoo'Sym0 a0123456789876543210 = UnFoo' a0123456789876543210+ instance SuppressUnusedWarnings UnFoo'Sym0 where+ suppressUnusedWarnings = snd ((,) UnFoo'Sym0KindInference ())+ type UnFoo'Sym1 :: Foo -> Bool+ type family UnFoo'Sym1 (a0123456789876543210 :: Foo) :: Bool where+ UnFoo'Sym1 a0123456789876543210 = UnFoo' a0123456789876543210+ type UnFoo' :: Foo -> Bool+ type family UnFoo' (a :: Foo) :: Bool where+ UnFoo' a_0123456789876543210 = Apply UnFooSym0 a_0123456789876543210+ sUnFoo' ::+ (forall (t :: Foo). Sing t -> Sing (UnFoo' t :: Bool) :: Type)+ sUnFoo' (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing sUnFoo sA_0123456789876543210+ instance SingI (UnFoo'Sym0 :: (~>) Foo Bool) where+ sing = singFun1 @UnFoo'Sym0 sUnFoo'+Singletons/T563.hs:0:0: error: [GHC-76037]+ Not in scope: type constructor or class ‘UnFooSym0’+ Suggested fix:+ Perhaps use one of these:+ ‘UnFoo'Sym0’ (line 13), ‘MkFooSym0’ (line 7),+ ‘UnFoo'Sym1’ (line 13)+ |+13 | $(singletonsOnly [d|+ | ^^^^^^^^^^^^^^^^^^^...+
+ tests/compile-and-dump/Singletons/T563.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE NoFieldSelectors #-}+module T563 where++import Data.Singletons.Base.TH+import Prelude.Singletons++$(singletons [d|+ infixr 6 `unFoo`+ data Foo = MkFoo { unFoo :: Bool }+ |])++-- This should not compile:+$(singletonsOnly [d|+ unFoo' :: Foo -> Bool+ unFoo' = unFoo+ |])
+ tests/compile-and-dump/Singletons/T565.golden view
@@ -0,0 +1,16 @@+Singletons/T565.hs:(0,0)-(0,0): Splicing declarations+ singletons [d| data C a where D :: forall {a}. C a |]+ ======>+ data C a where D :: forall {a}. C a+ type DSym0 :: forall {a}. C a+ type family DSym0 :: C a where+ DSym0 = D+ data SC :: forall a. C a -> Type+ where SD :: forall {a}. SC (D :: C a)+ type instance Sing @(C a) = SC+ instance SingKind a => SingKind (C a) where+ type Demote (C a) = C (Demote a)+ fromSing SD = D+ toSing D = SomeSing SD+ instance SingI D where+ sing = SD
+ tests/compile-and-dump/Singletons/T565.hs view
@@ -0,0 +1,8 @@+module T565 where++import Data.Singletons.TH++$(singletons [d|+ data C a where+ D :: forall {a}. C a+ |])
+ tests/compile-and-dump/Singletons/T567.golden view
@@ -0,0 +1,61 @@+Singletons/T567.hs:(0,0)-(0,0): Splicing declarations+ withOptions defaultOptions {genSingKindInsts = False}+ $ singletons+ [d| type D1 :: forall k. forall (a :: k) -> Proxy a -> Type+ type D2 :: forall k. forall (a :: k) -> Proxy a -> Type+ type D3 :: forall k. forall (a :: k) -> Proxy a -> Type+ type D4 :: forall k. forall (a :: k) -> Proxy a -> Type+ + data D1 x p = MkD1+ data D2 (x :: j) p = MkD2+ data D3 x (p :: Proxy x) = MkD3+ data D4 (x :: j) (p :: Proxy x) = MkD4 |]+ ======>+ type D1 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D1 x p = MkD1+ type D2 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D2 (x :: j) p = MkD2+ type D3 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D3 x (p :: Proxy x) = MkD3+ type D4 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D4 (x :: j) (p :: Proxy x) = MkD4+ type MkD1Sym0 :: forall k (x :: k) (p :: Proxy x). D1 x p+ type family MkD1Sym0 @k @(x :: k) @(p :: Proxy x) :: D1 x p where+ MkD1Sym0 = MkD1+ type MkD2Sym0 :: forall j (x :: j) (p :: Proxy x). D2 x p+ type family MkD2Sym0 @j @(x :: j) @(p :: Proxy x) :: D2 x p where+ MkD2Sym0 = MkD2+ type MkD3Sym0 :: forall k (x :: k) (p :: Proxy x). D3 x p+ type family MkD3Sym0 @k @(x :: k) @(p :: Proxy x) :: D3 x p where+ MkD3Sym0 = MkD3+ type MkD4Sym0 :: forall j (x :: j) (p :: Proxy x). D4 x p+ type family MkD4Sym0 @j @(x :: j) @(p :: Proxy x) :: D4 x p where+ MkD4Sym0 = MkD4+ type SD1 :: forall k (x :: k) (p :: Proxy x). D1 x p -> Type+ data SD1 :: forall k (x :: k) (p :: Proxy x). D1 x p -> Type+ where+ SMkD1 :: forall k (x :: k) (p :: Proxy x). SD1 (MkD1 :: D1 x p)+ type instance Sing @(D1 x p) = SD1+ type SD2 :: forall j (x :: j) (p :: Proxy x). D2 x p -> Type+ data SD2 :: forall j (x :: j) (p :: Proxy x). D2 x p -> Type+ where+ SMkD2 :: forall j (x :: j) (p :: Proxy x). SD2 (MkD2 :: D2 x p)+ type instance Sing @(D2 x p) = SD2+ type SD3 :: forall k (x :: k) (p :: Proxy x). D3 x p -> Type+ data SD3 :: forall k (x :: k) (p :: Proxy x). D3 x p -> Type+ where+ SMkD3 :: forall k (x :: k) (p :: Proxy x). SD3 (MkD3 :: D3 x p)+ type instance Sing @(D3 x p) = SD3+ type SD4 :: forall j (x :: j) (p :: Proxy x). D4 x p -> Type+ data SD4 :: forall j (x :: j) (p :: Proxy x). D4 x p -> Type+ where+ SMkD4 :: forall j (x :: j) (p :: Proxy x). SD4 (MkD4 :: D4 x p)+ type instance Sing @(D4 x p) = SD4+ instance SingI MkD1 where+ sing = SMkD1+ instance SingI MkD2 where+ sing = SMkD2+ instance SingI MkD3 where+ sing = SMkD3+ instance SingI MkD4 where+ sing = SMkD4
+ tests/compile-and-dump/Singletons/T567.hs view
@@ -0,0 +1,21 @@+module T567 where++import Data.Kind (Type)+import Data.Proxy (Proxy)+import Data.Singletons.TH.Options+import Data.Singletons.Base.TH++$(withOptions defaultOptions{genSingKindInsts = False} $+ singletons [d|+ type D1 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D1 x p = MkD1++ type D2 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D2 (x :: j) p = MkD2++ type D3 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D3 x (p :: Proxy x) = MkD3++ type D4 :: forall k. forall (a :: k) -> Proxy a -> Type+ data D4 (x :: j) (p :: Proxy x) = MkD4+ |])
+ tests/compile-and-dump/Singletons/T571.golden view
@@ -0,0 +1,65 @@+Singletons/T571.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| f :: a -> a+ f x = x |]+ ======>+ f :: a -> a+ f x = x+ type FSym0 :: (~>) a a+ data FSym0 :: (~>) a a+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @a @a FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings = snd ((,) FSym0KindInference ())+ type FSym1 :: a -> a+ type family FSym1 @a (a0123456789876543210 :: a) :: a where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type F :: a -> a+ type family F @a (a :: a) :: a where+ F x = x+ sF :: (forall (t :: a). Sing t -> Sing (F t :: a) :: Type)+ sF (sX :: Sing x) = sX+ instance SingI (FSym0 :: (~>) a a) where+ sing = singFun1 @FSym0 sF+Singletons/T571.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| g :: (a -> a) -> a -> a+ g f x = f x |]+ ======>+ g :: (a -> a) -> a -> a+ g f x = f x+ type GSym0 :: (~>) ((~>) a a) ((~>) a a)+ data GSym0 :: (~>) ((~>) a a) ((~>) a a)+ where+ GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) =>+ GSym0 a0123456789876543210+ type instance Apply @((~>) a a) @((~>) a a) GSym0 a0123456789876543210 = GSym1 a0123456789876543210+ instance SuppressUnusedWarnings GSym0 where+ suppressUnusedWarnings = snd ((,) GSym0KindInference ())+ type GSym1 :: (~>) a a -> (~>) a a+ data GSym1 (a0123456789876543210 :: (~>) a a) :: (~>) a a+ where+ GSym1KindInference :: SameKind (Apply (GSym1 a0123456789876543210) arg) (GSym2 a0123456789876543210 arg) =>+ GSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @a (GSym1 a0123456789876543210) a0123456789876543210 = G a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (GSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) GSym1KindInference ())+ type GSym2 :: (~>) a a -> a -> a+ type family GSym2 @a (a0123456789876543210 :: (~>) a a) (a0123456789876543210 :: a) :: a where+ GSym2 a0123456789876543210 a0123456789876543210 = G a0123456789876543210 a0123456789876543210+ type G :: (~>) a a -> a -> a+ type family G @a (a :: (~>) a a) (a :: a) :: a where+ G f x = Apply f x+ sG ::+ (forall (t :: (~>) a a) (t :: a).+ Sing t -> Sing t -> Sing (G t t :: a) :: Type)+ sG (sF :: Sing f) (sX :: Sing x) = applySing sF sX+ instance SingI (GSym0 :: (~>) ((~>) a a) ((~>) a a)) where+ sing = singFun2 @GSym0 sG+ instance SingI d => SingI (GSym1 (d :: (~>) a a) :: (~>) a a) where+ sing = singFun1 @(GSym1 (d :: (~>) a a)) (sG (sing @d))+ instance SingI1 (GSym1 :: (~>) a a -> (~>) a a) where+ liftSing (s :: Sing (d :: (~>) a a))+ = singFun1 @(GSym1 (d :: (~>) a a)) (sG s)
+ tests/compile-and-dump/Singletons/T571.hs view
@@ -0,0 +1,13 @@+module T571 where++import Data.Singletons.TH++$(singletons [d|+ f :: a -> a+ f x = x+ |])++$(singletons [d|+ g :: (a -> a) -> a -> a+ g f x = f x+ |])
+ tests/compile-and-dump/Singletons/T581.golden view
@@ -0,0 +1,243 @@+Singletons/T581.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| class C1 a where+ m1 :: forall b. a -> Maybe (a, b)+ m1 _ = Nothing :: Maybe (a, b)+ class C2 a where+ m2 :: b -> Maybe a+ m2 _ = Nothing :: Maybe a+ class C3 a where+ m3 :: forall b. a -> b -> (a, b)+ m3 x y = (x, y) :: (a, b)+ + instance C3 [a] where+ m3 x y = (fmap (\ xx -> (xx :: a)) x, y)+ instance C3 (Maybe a) where+ m3 :: Maybe a -> b -> (Maybe a, b)+ m3 x y = (fmap (\ xx -> (xx :: a)) x, y)+ instance C2 (Maybe a) where+ m2 _ = Nothing :: Maybe (Maybe a)+ instance C2 [a] where+ m2 :: b -> Maybe [a]+ m2 _ = Nothing :: Maybe [a]+ instance C1 [a] where+ m1 :: forall b. [a] -> Maybe ([a], b)+ m1 _ = Nothing :: Maybe ([a], b) |]+ ======>+ class C1 a where+ m1 :: forall b. a -> Maybe (a, b)+ m1 _ = Nothing :: Maybe (a, b)+ instance C1 [a] where+ m1 :: forall b. [a] -> Maybe ([a], b)+ m1 _ = Nothing :: Maybe ([a], b)+ class C2 a where+ m2 :: b -> Maybe a+ m2 _ = Nothing :: Maybe a+ instance C2 [a] where+ m2 :: b -> Maybe [a]+ m2 _ = Nothing :: Maybe [a]+ instance C2 (Maybe a) where+ m2 _ = Nothing :: Maybe (Maybe a)+ class C3 a where+ m3 :: forall b. a -> b -> (a, b)+ m3 x y = (x, y) :: (a, b)+ instance C3 (Maybe a) where+ m3 :: Maybe a -> b -> (Maybe a, b)+ m3 x y = (fmap (\ xx -> xx :: a) x, y)+ instance C3 [a] where+ m3 x y = (fmap (\ xx -> xx :: a) x, y)+ type M1Sym0 :: forall a b. (~>) a (Maybe (a, b))+ data M1Sym0 :: (~>) a (Maybe (a, b))+ where+ M1Sym0KindInference :: SameKind (Apply M1Sym0 arg) (M1Sym1 arg) =>+ M1Sym0 a0123456789876543210+ type instance Apply @a @(Maybe (a,+ b)) M1Sym0 a0123456789876543210 = M1 a0123456789876543210+ instance SuppressUnusedWarnings M1Sym0 where+ suppressUnusedWarnings = snd ((,) M1Sym0KindInference ())+ type M1Sym1 :: forall a b. a -> Maybe (a, b)+ type family M1Sym1 @a @b (a0123456789876543210 :: a) :: Maybe (a,+ b) where+ M1Sym1 a0123456789876543210 = M1 a0123456789876543210+ type M1_0123456789876543210 :: forall a b. a -> Maybe (a, b)+ type family M1_0123456789876543210 @a @b (a :: a) :: Maybe (a,+ b) where+ M1_0123456789876543210 @a @b (_ :: a) = NothingSym0 :: Maybe (a, b)+ class PC1 a where+ type family M1 (arg :: a) :: Maybe (a, b)+ type M1 a = M1_0123456789876543210 a+ type M2Sym0 :: forall b a. (~>) b (Maybe a)+ data M2Sym0 :: (~>) b (Maybe a)+ where+ M2Sym0KindInference :: SameKind (Apply M2Sym0 arg) (M2Sym1 arg) =>+ M2Sym0 a0123456789876543210+ type instance Apply @b @(Maybe a) M2Sym0 a0123456789876543210 = M2 a0123456789876543210+ instance SuppressUnusedWarnings M2Sym0 where+ suppressUnusedWarnings = snd ((,) M2Sym0KindInference ())+ type M2Sym1 :: forall b a. b -> Maybe a+ type family M2Sym1 @b @a (a0123456789876543210 :: b) :: Maybe a where+ M2Sym1 a0123456789876543210 = M2 a0123456789876543210+ type M2_0123456789876543210 :: forall a b. b -> Maybe a+ type family M2_0123456789876543210 @a @b (a :: b) :: Maybe a where+ M2_0123456789876543210 @a @b (_ :: b) = NothingSym0 :: Maybe a+ class PC2 a where+ type family M2 (arg :: b) :: Maybe a+ type M2 a = M2_0123456789876543210 a+ type M3Sym0 :: forall a b. (~>) a ((~>) b (a, b))+ data M3Sym0 :: (~>) a ((~>) b (a, b))+ where+ M3Sym0KindInference :: SameKind (Apply M3Sym0 arg) (M3Sym1 arg) =>+ M3Sym0 a0123456789876543210+ type instance Apply @a @((~>) b (a,+ b)) M3Sym0 a0123456789876543210 = M3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings M3Sym0 where+ suppressUnusedWarnings = snd ((,) M3Sym0KindInference ())+ type M3Sym1 :: forall a b. a -> (~>) b (a, b)+ data M3Sym1 (a0123456789876543210 :: a) :: (~>) b (a, b)+ where+ M3Sym1KindInference :: SameKind (Apply (M3Sym1 a0123456789876543210) arg) (M3Sym2 a0123456789876543210 arg) =>+ M3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @(a,+ b) (M3Sym1 a0123456789876543210) a0123456789876543210 = M3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (M3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) M3Sym1KindInference ())+ type M3Sym2 :: forall a b. a -> b -> (a, b)+ type family M3Sym2 @a @b (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: (a,+ b) where+ M3Sym2 a0123456789876543210 a0123456789876543210 = M3 a0123456789876543210 a0123456789876543210+ type M3_0123456789876543210 :: forall a b. a -> b -> (a, b)+ type family M3_0123456789876543210 @a @b (a :: a) (a :: b) :: (a,+ b) where+ M3_0123456789876543210 @a @b (x :: a) (y :: b) = Apply (Apply Tuple2Sym0 x) y :: (a,+ b)+ class PC3 a where+ type family M3 (arg :: a) (arg :: b) :: (a, b)+ type M3 a a = M3_0123456789876543210 a a+ type M1_0123456789876543210 :: forall a b. [a] -> Maybe ([a], b)+ type family M1_0123456789876543210 @a @b (a :: [a]) :: Maybe ([a],+ b) where+ M1_0123456789876543210 @a @b (_ :: [a]) = NothingSym0 :: Maybe ([a],+ b)+ instance PC1 [a] where+ type M1 a = M1_0123456789876543210 a+ type M2_0123456789876543210 :: forall a b. b -> Maybe [a]+ type family M2_0123456789876543210 @a @b (a :: b) :: Maybe [a] where+ M2_0123456789876543210 @a @b (_ :: b) = NothingSym0 :: Maybe [a]+ instance PC2 [a] where+ type M2 a = M2_0123456789876543210 a+ type M2_0123456789876543210 :: forall a b. b -> Maybe (Maybe a)+ type family M2_0123456789876543210 @a @b (a :: b) :: Maybe (Maybe a) where+ M2_0123456789876543210 @a @b (_ :: b) = NothingSym0 :: Maybe (Maybe a)+ instance PC2 (Maybe a) where+ type M2 a = M2_0123456789876543210 a+ type family LamCases_0123456789876543210 a0123456789876543210 (x0123456789876543210 :: Maybe a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a x y xx = xx :: a+ data LamCases_0123456789876543210Sym0 a0123456789876543210 (x0123456789876543210 :: Maybe a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 (x0123456789876543210 :: Maybe a0123456789876543210) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type M3_0123456789876543210 :: forall a b. Maybe a+ -> b -> (Maybe a, b)+ type family M3_0123456789876543210 @a @b (a :: Maybe a) (a :: b) :: (Maybe a,+ b) where+ M3_0123456789876543210 @a @b (x :: Maybe a) (y :: b) = Apply (Apply Tuple2Sym0 (Apply (Apply FmapSym0 (LamCases_0123456789876543210Sym0 a x y)) x)) y+ instance PC3 (Maybe a) where+ type M3 a a = M3_0123456789876543210 a a+ type family LamCases_0123456789876543210 a0123456789876543210 (x0123456789876543210 :: [a0123456789876543210]) (y0123456789876543210 :: b0123456789876543210) a_0123456789876543210 where+ LamCases_0123456789876543210 a x y xx = xx :: a+ data LamCases_0123456789876543210Sym0 a0123456789876543210 (x0123456789876543210 :: [a0123456789876543210]) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 y0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a0123456789876543210 x0123456789876543210 y0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a0123456789876543210 (x0123456789876543210 :: [a0123456789876543210]) (y0123456789876543210 :: b0123456789876543210) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a0123456789876543210 x0123456789876543210 y0123456789876543210 a_01234567898765432100123456789876543210+ type M3_0123456789876543210 :: forall a b. [a] -> b -> ([a], b)+ type family M3_0123456789876543210 @a @b (a :: [a]) (a :: b) :: ([a],+ b) where+ M3_0123456789876543210 @a @b (x :: [a]) (y :: b) = Apply (Apply Tuple2Sym0 (Apply (Apply FmapSym0 (LamCases_0123456789876543210Sym0 a x y)) x)) y+ instance PC3 [a] where+ type M3 a a = M3_0123456789876543210 a a+ class SC1 a where+ sM1 :: forall b (t :: a). Sing t -> Sing (M1 t :: Maybe (a, b))+ default sM1 ::+ forall b (t :: a). ((M1 t :: Maybe (a, b))+ ~ M1_0123456789876543210 t) =>+ Sing t -> Sing (M1 t :: Maybe (a, b))+ sM1 _ = SNothing :: Sing (NothingSym0 :: Maybe (a, b))+ class SC2 a where+ sM2 :: (forall (t :: b). Sing t -> Sing (M2 t :: Maybe a) :: Type)+ default sM2 ::+ (forall (t :: b).+ ((M2 t :: Maybe a) ~ M2_0123456789876543210 t) =>+ Sing t -> Sing (M2 t :: Maybe a) :: Type)+ sM2 _ = SNothing :: Sing (NothingSym0 :: Maybe a)+ class SC3 a where+ sM3 ::+ forall b (t :: a) (t :: b). Sing t+ -> Sing t -> Sing (M3 t t :: (a, b))+ default sM3 ::+ forall b (t :: a) (t :: b). ((M3 t t :: (a, b))+ ~ M3_0123456789876543210 t t) =>+ Sing t -> Sing t -> Sing (M3 t t :: (a, b))+ sM3 (sX :: Sing x) (sY :: Sing y)+ = applySing (applySing (singFun2 @Tuple2Sym0 STuple2) sX) sY ::+ Sing (Apply (Apply Tuple2Sym0 x) y :: (a, b))+ instance SC1 [a] where+ sM1 :: forall b (t :: [a]). Sing t -> Sing (M1 t :: Maybe ([a], b))+ sM1 _ = SNothing :: Sing (NothingSym0 :: Maybe ([a], b))+ instance SC2 [a] where+ sM2 ::+ (forall (t :: b). Sing t -> Sing (M2 t :: Maybe [a]) :: Type)+ sM2 _ = SNothing :: Sing (NothingSym0 :: Maybe [a])+ instance SC2 (Maybe a) where+ sM2 _ = SNothing :: Sing (NothingSym0 :: Maybe (Maybe a))+ instance SC3 (Maybe a) where+ sM3 ::+ (forall (t :: Maybe a) (t :: b).+ Sing t -> Sing t -> Sing (M3 t t :: (Maybe a, b)) :: Type)+ sM3 (sX :: Sing x) (sY :: Sing y)+ = applySing+ (applySing+ (singFun2 @Tuple2Sym0 STuple2)+ (applySing+ (applySing+ (singFun2 @FmapSym0 sFmap)+ (singFun1+ @(LamCases_0123456789876543210Sym0 a x y)+ (\cases (sXx :: Sing xx) -> sXx :: Sing (xx :: a))))+ sX))+ sY+ instance SC3 [a] where+ sM3 (sX :: Sing x) (sY :: Sing y)+ = applySing+ (applySing+ (singFun2 @Tuple2Sym0 STuple2)+ (applySing+ (applySing+ (singFun2 @FmapSym0 sFmap)+ (singFun1+ @(LamCases_0123456789876543210Sym0 a x y)+ (\cases (sXx :: Sing xx) -> sXx :: Sing (xx :: a))))+ sX))+ sY+ instance SC1 a => SingI (M1Sym0 :: (~>) a (Maybe (a, b))) where+ sing = singFun1 @M1Sym0 sM1+ instance SC2 a => SingI (M2Sym0 :: (~>) b (Maybe a)) where+ sing = singFun1 @M2Sym0 sM2+ instance SC3 a => SingI (M3Sym0 :: (~>) a ((~>) b (a, b))) where+ sing = singFun2 @M3Sym0 sM3+ instance (SC3 a, SingI d) =>+ SingI (M3Sym1 (d :: a) :: (~>) b (a, b)) where+ sing = singFun1 @(M3Sym1 (d :: a)) (sM3 (sing @d))+ instance SC3 a => SingI1 (M3Sym1 :: a -> (~>) b (a, b)) where+ liftSing (s :: Sing (d :: a)) = singFun1 @(M3Sym1 (d :: a)) (sM3 s)
+ tests/compile-and-dump/Singletons/T581.hs view
@@ -0,0 +1,36 @@+module T581 where++import Data.Singletons.Base.TH+import Prelude.Singletons++$(singletons+ [d| class C1 a where+ m1 :: forall b. a -> Maybe (a, b)+ m1 _ = Nothing :: Maybe (a, b)++ instance C1 [a] where+ m1 :: forall b. [a] -> Maybe ([a], b)+ m1 _ = Nothing :: Maybe ([a], b)++ class C2 a where+ m2 :: b -> Maybe a+ m2 _ = Nothing :: Maybe a++ instance C2 [a] where+ m2 :: b -> Maybe [a]+ m2 _ = Nothing :: Maybe [a]++ instance C2 (Maybe a) where+ m2 _ = Nothing :: Maybe (Maybe a)++ class C3 a where+ m3 :: forall b. a -> b -> (a, b)+ m3 x y = (x, y) :: (a, b)++ instance C3 (Maybe a) where+ m3 :: Maybe a -> b -> (Maybe a, b)+ m3 x y = (fmap (\xx -> (xx :: a)) x, y)++ instance C3 [a] where+ m3 x y = (fmap (\xx -> (xx :: a)) x, y)+ |])
+ tests/compile-and-dump/Singletons/T582.golden view
@@ -0,0 +1,150 @@+Singletons/T582.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| infixl 4 type !!!+ infixl 4 data %%%+ infixl 4 type `Bar`+ infixl 4 data `foo`+ + foo :: a -> a -> a+ x `foo` _ = x+ (%%%) :: a -> a -> a+ x %%% _ = x+ + type Bar :: a -> a -> a+ type (!!!) :: a -> a -> a+ + type x `Bar` y = x+ type x !!! y = x |]+ ======>+ infixl 4 data `foo`+ foo :: a -> a -> a+ foo x _ = x+ infixl 4 type `Bar`+ type Bar :: a -> a -> a+ type Bar x y = x+ infixl 4 data %%%+ (%%%) :: a -> a -> a+ (%%%) x _ = x+ infixl 4 type !!!+ type (!!!) :: a -> a -> a+ type (!!!) x y = x+ type BarSym0 :: (~>) a ((~>) a a)+ data BarSym0 :: (~>) a ((~>) a a)+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @a @((~>) a a) BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ infixl 4 type `BarSym0`+ type BarSym1 :: a -> (~>) a a+ data BarSym1 (a0123456789876543210 :: a) :: (~>) a a+ where+ BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) =>+ BarSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @a (BarSym1 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) BarSym1KindInference ())+ infixl 4 type `BarSym1`+ type BarSym2 :: a -> a -> a+ type family BarSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ BarSym2 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ infixl 4 type `BarSym2`+ type (!!!@#@$) :: (~>) a ((~>) a a)+ data (!!!@#@$) :: (~>) a ((~>) a a)+ where+ (:!!!@#@$###) :: SameKind (Apply (!!!@#@$) arg) ((!!!@#@$$) arg) =>+ (!!!@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (!!!@#@$) a0123456789876543210 = (!!!@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (!!!@#@$) where+ suppressUnusedWarnings = snd ((,) (:!!!@#@$###) ())+ infixl 4 type !!!@#@$+ type (!!!@#@$$) :: a -> (~>) a a+ data (!!!@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:!!!@#@$$###) :: SameKind (Apply ((!!!@#@$$) a0123456789876543210) arg) ((!!!@#@$$$) a0123456789876543210 arg) =>+ (!!!@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((!!!@#@$$) a0123456789876543210) a0123456789876543210 = (!!!) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((!!!@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:!!!@#@$$###) ())+ infixl 4 type !!!@#@$$+ type (!!!@#@$$$) :: a -> a -> a+ type family (!!!@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (!!!@#@$$$) a0123456789876543210 a0123456789876543210 = (!!!) a0123456789876543210 a0123456789876543210+ infixl 4 type !!!@#@$$$+ type (%%%@#@$) :: (~>) a ((~>) a a)+ data (%%%@#@$) :: (~>) a ((~>) a a)+ where+ (:%%%@#@$###) :: SameKind (Apply (%%%@#@$) arg) ((%%%@#@$$) arg) =>+ (%%%@#@$) a0123456789876543210+ type instance Apply @a @((~>) a a) (%%%@#@$) a0123456789876543210 = (%%%@#@$$) a0123456789876543210+ instance SuppressUnusedWarnings (%%%@#@$) where+ suppressUnusedWarnings = snd ((,) (:%%%@#@$###) ())+ infixl 4 type %%%@#@$+ type (%%%@#@$$) :: a -> (~>) a a+ data (%%%@#@$$) (a0123456789876543210 :: a) :: (~>) a a+ where+ (:%%%@#@$$###) :: SameKind (Apply ((%%%@#@$$) a0123456789876543210) arg) ((%%%@#@$$$) a0123456789876543210 arg) =>+ (%%%@#@$$) a0123456789876543210 a0123456789876543210+ type instance Apply @a @a ((%%%@#@$$) a0123456789876543210) a0123456789876543210 = (%%%) a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings ((%%%@#@$$) a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) (:%%%@#@$$###) ())+ infixl 4 type %%%@#@$$+ type (%%%@#@$$$) :: a -> a -> a+ type family (%%%@#@$$$) @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ (%%%@#@$$$) a0123456789876543210 a0123456789876543210 = (%%%) a0123456789876543210 a0123456789876543210+ infixl 4 type %%%@#@$$$+ type FooSym0 :: (~>) a ((~>) a a)+ data FooSym0 :: (~>) a ((~>) a a)+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @a @((~>) a a) FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ infixl 4 type `FooSym0`+ type FooSym1 :: a -> (~>) a a+ data FooSym1 (a0123456789876543210 :: a) :: (~>) a a+ where+ FooSym1KindInference :: SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) =>+ FooSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @a @a (FooSym1 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) FooSym1KindInference ())+ infixl 4 type `FooSym1`+ type FooSym2 :: a -> a -> a+ type family FooSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: a) :: a where+ FooSym2 a0123456789876543210 a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210+ infixl 4 type `FooSym2`+ type (%%%) :: a -> a -> a+ type family (%%%) @a (a :: a) (a :: a) :: a where+ (%%%) x _ = x+ type Foo :: a -> a -> a+ type family Foo @a (a :: a) (a :: a) :: a where+ Foo x _ = x+ infixl 4 type %%%+ infixl 4 type `Foo`+ infixl 4 data %%%%+ infixl 4 data `sFoo`+ (%%%%) ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing ((%%%) t t :: a) :: Type)+ sFoo ::+ (forall (t :: a) (t :: a).+ Sing t -> Sing t -> Sing (Foo t t :: a) :: Type)+ (%%%%) (sX :: Sing x) _ = sX+ sFoo (sX :: Sing x) _ = sX+ instance SingI ((%%%@#@$) :: (~>) a ((~>) a a)) where+ sing = singFun2 @(%%%@#@$) (%%%%)+ instance SingI d => SingI ((%%%@#@$$) (d :: a) :: (~>) a a) where+ sing = singFun1 @((%%%@#@$$) (d :: a)) ((%%%%) (sing @d))+ instance SingI1 ((%%%@#@$$) :: a -> (~>) a a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @((%%%@#@$$) (d :: a)) ((%%%%) s)+ instance SingI (FooSym0 :: (~>) a ((~>) a a)) where+ sing = singFun2 @FooSym0 sFoo+ instance SingI d => SingI (FooSym1 (d :: a) :: (~>) a a) where+ sing = singFun1 @(FooSym1 (d :: a)) (sFoo (sing @d))+ instance SingI1 (FooSym1 :: a -> (~>) a a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(FooSym1 (d :: a)) (sFoo s)
+ tests/compile-and-dump/Singletons/T582.hs view
@@ -0,0 +1,21 @@+module T582 where++import Data.Singletons.TH++$(singletons [d|+ infixl 4 data `foo`+ foo :: a -> a -> a+ x `foo` _ = x++ infixl 4 type `Bar`+ type Bar :: a -> a -> a+ type x `Bar` y = x++ infixl 4 data %%%+ (%%%) :: a -> a -> a+ x %%% _ = x++ infixl 4 type !!!+ type (!!!) :: a -> a -> a+ type x !!! y = x+ |])
+ tests/compile-and-dump/Singletons/T585.golden view
@@ -0,0 +1,40 @@+Singletons/T585.hs:(0,0)-(0,0): Splicing declarations+ singletons+ [d| konst :: forall a {b}. a -> b -> a+ konst x _ = x |]+ ======>+ konst :: forall a {b}. a -> b -> a+ konst x _ = x+ type KonstSym0 :: forall a {b}. (~>) a ((~>) b a)+ data KonstSym0 :: (~>) a ((~>) b a)+ where+ KonstSym0KindInference :: SameKind (Apply KonstSym0 arg) (KonstSym1 arg) =>+ KonstSym0 a0123456789876543210+ type instance Apply @a @((~>) b a) KonstSym0 a0123456789876543210 = KonstSym1 a0123456789876543210+ instance SuppressUnusedWarnings KonstSym0 where+ suppressUnusedWarnings = snd ((,) KonstSym0KindInference ())+ type KonstSym1 :: forall a {b}. a -> (~>) b a+ data KonstSym1 (a0123456789876543210 :: a) :: (~>) b a+ where+ KonstSym1KindInference :: SameKind (Apply (KonstSym1 a0123456789876543210) arg) (KonstSym2 a0123456789876543210 arg) =>+ KonstSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @b @a (KonstSym1 a0123456789876543210) a0123456789876543210 = Konst a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (KonstSym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) KonstSym1KindInference ())+ type KonstSym2 :: forall a {b}. a -> b -> a+ type family KonstSym2 @a (a0123456789876543210 :: a) (a0123456789876543210 :: b) :: a where+ KonstSym2 a0123456789876543210 a0123456789876543210 = Konst a0123456789876543210 a0123456789876543210+ type Konst :: forall a {b}. a -> b -> a+ type family Konst @a (a :: a) (a :: b) :: a where+ Konst @a (x :: a) (_ :: b) = x+ sKonst ::+ forall a {b} (t :: a) (t :: b). Sing t+ -> Sing t -> Sing (Konst t t :: a)+ sKonst (sX :: Sing x) _ = sX+ instance SingI (KonstSym0 :: (~>) a ((~>) b a)) where+ sing = singFun2 @KonstSym0 sKonst+ instance SingI d => SingI (KonstSym1 (d :: a) :: (~>) b a) where+ sing = singFun1 @(KonstSym1 (d :: a)) (sKonst (sing @d))+ instance SingI1 (KonstSym1 :: a -> (~>) b a) where+ liftSing (s :: Sing (d :: a))+ = singFun1 @(KonstSym1 (d :: a)) (sKonst s)
+ tests/compile-and-dump/Singletons/T585.hs view
@@ -0,0 +1,8 @@+module T585 where++import Data.Singletons.TH++$(singletons [d|+ konst :: forall a {b}. a -> b -> a+ konst x _ = x+ |])
tests/compile-and-dump/Singletons/T78.golden view
@@ -1,35 +1,34 @@-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 FooSym0 :: (~>) (Maybe Bool) Bool - data FooSym0 :: (~>) (Maybe Bool) Bool - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: Maybe Bool -> Bool - type family FooSym1 (a0123456789876543210 :: Maybe Bool) :: Bool where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Foo :: Maybe Bool -> Bool - 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) :: Type) - sFoo (SJust SFalse) = SFalse - sFoo (SJust STrue) = STrue - sFoo SNothing = SFalse - instance SingI (FooSym0 :: (~>) (Maybe Bool) Bool) where - sing = singFun1 @FooSym0 sFoo +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 FooSym0 :: (~>) (Maybe Bool) Bool+ data FooSym0 :: (~>) (Maybe Bool) Bool+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @(Maybe Bool) @Bool FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: Maybe Bool -> Bool+ type family FooSym1 (a0123456789876543210 :: Maybe Bool) :: Bool where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Foo :: Maybe Bool -> Bool+ 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 (Foo t :: Bool) :: Type)+ 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 view
@@ -1,13 +1,13 @@-module Singletons.T78 where - -import Data.Singletons.TH -import Prelude.Singletons - -type MaybeBool = Maybe Bool - -$(singletons [d| - foo :: MaybeBool -> Bool - foo (Just False) = False - foo (Just True) = True - foo Nothing = False - |]) +module Singletons.T78 where++import Data.Singletons.TH+import Prelude.Singletons++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/T89.golden view
@@ -1,79 +1,59 @@-Singletons/T89.hs:0:0:: Splicing declarations - singletons - [d| data Foo - = Foo - deriving (Enum) |] - ======> - data Foo - = Foo - deriving Enum - type FooSym0 :: Foo - type family FooSym0 :: Foo where - FooSym0 = Foo - type family Case_0123456789876543210 n t where - Case_0123456789876543210 n 'True = FooSym0 - Case_0123456789876543210 n 'False = Apply ErrorSym0 (FromString "toEnum: bad argument") - type ToEnum_0123456789876543210 :: GHC.Num.Natural.Natural -> Foo - type family ToEnum_0123456789876543210 (a :: GHC.Num.Natural.Natural) :: Foo where - ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Foo - data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Num.Natural.Natural Foo - where - ToEnum_0123456789876543210Sym0KindInference :: SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => - ToEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) ToEnum_0123456789876543210Sym0KindInference ()) - type ToEnum_0123456789876543210Sym1 :: GHC.Num.Natural.Natural - -> Foo - type family ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Num.Natural.Natural) :: Foo where - ToEnum_0123456789876543210Sym1 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 - type FromEnum_0123456789876543210 :: Foo -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210 Foo = FromInteger 0 - type FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Num.Natural.Natural - data FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Num.Natural.Natural - where - FromEnum_0123456789876543210Sym0KindInference :: SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => - FromEnum_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd ((,) FromEnum_0123456789876543210Sym0KindInference ()) - type FromEnum_0123456789876543210Sym1 :: Foo - -> GHC.Num.Natural.Natural - type family FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: GHC.Num.Natural.Natural where - FromEnum_0123456789876543210Sym1 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 - instance PEnum Foo where - type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a - type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a - data SFoo :: Foo -> Type where SFoo :: SFoo (Foo :: Foo) - type instance Sing @Foo = SFoo - instance SingKind Foo where - type Demote Foo = Foo - fromSing SFoo = Foo - toSing Foo = SomeSing SFoo - instance SEnum Foo where - sToEnum :: - forall (t :: GHC.Num.Natural.Natural). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.ToEnumSym0 :: TyFun GHC.Num.Natural.Natural Foo - -> Type) t) - sFromEnum :: - forall (t :: Foo). Sing t - -> Sing (Apply (Data.Singletons.Base.Enum.FromEnumSym0 :: TyFun Foo GHC.Num.Natural.Natural - -> Type) t) - sToEnum (sN :: Sing n) - = id - @(Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)))) - (case - applySing - (applySing (singFun2 @(==@#@$) (%==)) sN) - (sFromInteger (sing :: Sing 0)) - of - STrue -> SFoo - SFalse - -> sError (sFromString (sing :: Sing "toEnum: bad argument"))) - sFromEnum SFoo = sFromInteger (sing :: Sing 0) - instance SingI Foo where - sing = SFoo +Singletons/T89.hs:0:0:: Splicing declarations+ singletons+ [d| data Foo+ = Foo+ deriving (Enum) |]+ ======>+ data Foo+ = Foo+ deriving Enum+ type FooSym0 :: Foo+ type family FooSym0 :: Foo where+ FooSym0 = Foo+ type family LamCases_0123456789876543210 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_0123456789876543210 where+ LamCases_0123456789876543210 n 'True = FooSym0+ LamCases_0123456789876543210 n 'False = Apply ErrorSym0 (FromString "toEnum: bad argument")+ data LamCases_0123456789876543210Sym0 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 n0123456789876543210) arg) (LamCases_0123456789876543210Sym1 n0123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 n0123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 n0123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 n0123456789876543210) where+ suppressUnusedWarnings+ = snd ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (n0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 n0123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 n0123456789876543210 a_01234567898765432100123456789876543210+ type ToEnum_0123456789876543210 :: GHC.Internal.Bignum.Natural.Natural+ -> Foo+ type family ToEnum_0123456789876543210 (a :: GHC.Internal.Bignum.Natural.Natural) :: Foo where+ ToEnum_0123456789876543210 n = Apply (LamCases_0123456789876543210Sym0 n) (Apply (Apply (==@#@$) n) (FromInteger 0))+ type FromEnum_0123456789876543210 :: Foo+ -> GHC.Internal.Bignum.Natural.Natural+ type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Internal.Bignum.Natural.Natural where+ FromEnum_0123456789876543210 Foo = FromInteger 0+ instance PEnum Foo where+ type ToEnum a = ToEnum_0123456789876543210 a+ type FromEnum a = FromEnum_0123456789876543210 a+ data SFoo :: Foo -> Type where SFoo :: SFoo (Foo :: Foo)+ type instance Sing @Foo = SFoo+ instance SingKind Foo where+ type Demote Foo = Foo+ fromSing SFoo = Foo+ toSing Foo = SomeSing SFoo+ instance SEnum Foo where+ sToEnum (sN :: Sing n)+ = applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 n)+ (\cases+ STrue -> SFoo+ SFalse+ -> applySing+ (singFun1 @ErrorSym0 sError)+ (sFromString (sing :: Sing "toEnum: bad argument"))))+ (applySing+ (applySing (singFun2 @(==@#@$) (%==)) sN)+ (sFromInteger (sing :: Sing 0)))+ sFromEnum SFoo = sFromInteger (sing :: Sing 0)+ instance SingI Foo where+ sing = SFoo
tests/compile-and-dump/Singletons/T89.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE OverloadedStrings #-} -module T89 where - -import Data.Singletons.Base.TH - -$(singletons [d|data Foo = Foo deriving (Enum)|]) +{-# LANGUAGE OverloadedStrings #-}+module T89 where++import Data.Singletons.Base.TH++$(singletons [d|data Foo = Foo deriving (Enum)|])
tests/compile-and-dump/Singletons/TopLevelPatterns.golden view
@@ -1,402 +1,500 @@-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 :: Bool - type family FalseSym0 :: Bool where - FalseSym0 = False - type TrueSym0 :: Bool - type family TrueSym0 :: Bool where - TrueSym0 = True - type BarSym0 :: (~>) Bool ((~>) Bool Foo) - data BarSym0 :: (~>) Bool ((~>) Bool Foo) - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((,) BarSym0KindInference ()) - type BarSym1 :: Bool -> (~>) Bool Foo - data BarSym1 (a0123456789876543210 :: Bool) :: (~>) Bool Foo - where - BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) => - BarSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (BarSym1 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where - suppressUnusedWarnings - = Data.Tuple.snd ((,) BarSym1KindInference ()) - type BarSym2 :: Bool -> Bool -> Foo - type family BarSym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Foo where - BarSym2 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210 - data SBool :: Bool -> Type - where - SFalse :: SBool (False :: Bool) - STrue :: SBool (True :: Bool) - type instance Sing @Bool = SBool - instance SingKind Bool where - type Demote Bool = Bool - fromSing SFalse = False - fromSing STrue = True - toSing False = SomeSing SFalse - toSing True = SomeSing STrue - data SFoo :: Foo -> Type - where - SBar :: forall (n :: Bool) (n :: Bool). - (Sing n) -> (Sing n) -> SFoo (Bar n n :: Foo) - type instance Sing @Foo = SFoo - 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 n => SingI1 (Bar (n :: Bool)) where - liftSing = SBar sing - instance SingI2 Bar where - liftSing2 = SBar - instance SingI (BarSym0 :: (~>) Bool ((~>) Bool Foo)) where - sing = singFun2 @BarSym0 SBar - instance SingI d => - SingI (BarSym1 (d :: Bool) :: (~>) Bool Foo) where - sing = singFun1 @(BarSym1 (d :: Bool)) (SBar (sing @d)) - instance SingI1 (BarSym1 :: Bool -> (~>) Bool Foo) where - liftSing (s :: Sing (d :: Bool)) - = singFun1 @(BarSym1 (d :: Bool)) (SBar s) -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 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 ('Bar _ y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 ('Bar 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 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, - _] = y_0123456789876543210 - type MSym0 :: Bool - type family MSym0 :: Bool where - MSym0 = M - type LSym0 :: Bool - type family LSym0 :: Bool where - LSym0 = L - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type KSym0 :: Bool - type family KSym0 :: Bool where - KSym0 = K - type JSym0 :: Bool - type family JSym0 :: Bool where - JSym0 = J - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type ISym0 :: (~>) Bool Bool - data ISym0 :: (~>) Bool Bool - where - ISym0KindInference :: SameKind (Apply ISym0 arg) (ISym1 arg) => - ISym0 a0123456789876543210 - type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210 - instance SuppressUnusedWarnings ISym0 where - suppressUnusedWarnings = Data.Tuple.snd ((,) ISym0KindInference ()) - type ISym1 :: Bool -> Bool - type family ISym1 (a0123456789876543210 :: Bool) :: Bool where - ISym1 a0123456789876543210 = I a0123456789876543210 - type HSym0 :: (~>) Bool Bool - data HSym0 :: (~>) Bool Bool - where - HSym0KindInference :: SameKind (Apply HSym0 arg) (HSym1 arg) => - HSym0 a0123456789876543210 - type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210 - instance SuppressUnusedWarnings HSym0 where - suppressUnusedWarnings = Data.Tuple.snd ((,) HSym0KindInference ()) - type HSym1 :: Bool -> Bool - type family HSym1 (a0123456789876543210 :: Bool) :: Bool where - HSym1 a0123456789876543210 = H a0123456789876543210 - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type GSym0 :: (~>) Bool Bool - data GSym0 :: (~>) Bool Bool - where - GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0 a0123456789876543210 - type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings = Data.Tuple.snd ((,) GSym0KindInference ()) - type GSym1 :: Bool -> Bool - type family GSym1 (a0123456789876543210 :: Bool) :: Bool where - GSym1 a0123456789876543210 = G a0123456789876543210 - type FSym0 :: (~>) Bool Bool - data FSym0 :: (~>) Bool Bool - where - FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = Data.Tuple.snd ((,) FSym0KindInference ()) - type FSym1 :: Bool -> Bool - type family FSym1 (a0123456789876543210 :: Bool) :: Bool where - FSym1 a0123456789876543210 = F a0123456789876543210 - type family X_0123456789876543210Sym0 where - X_0123456789876543210Sym0 = X_0123456789876543210 - type family False_Sym0 where - False_Sym0 = False_ - type NotSym0 :: (~>) Bool Bool - data NotSym0 :: (~>) Bool Bool - where - NotSym0KindInference :: SameKind (Apply NotSym0 arg) (NotSym1 arg) => - NotSym0 a0123456789876543210 - type instance Apply NotSym0 a0123456789876543210 = Not a0123456789876543210 - instance SuppressUnusedWarnings NotSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((,) NotSym0KindInference ()) - type NotSym1 :: Bool -> Bool - type family NotSym1 (a0123456789876543210 :: Bool) :: Bool where - NotSym1 a0123456789876543210 = Not a0123456789876543210 - type IdSym0 :: (~>) a a - data IdSym0 :: (~>) a a - where - IdSym0KindInference :: SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0 a0123456789876543210 - type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings - = Data.Tuple.snd ((,) IdSym0KindInference ()) - type IdSym1 :: a -> a - type family IdSym1 (a0123456789876543210 :: a) :: a where - IdSym1 a0123456789876543210 = Id a0123456789876543210 - type OtherwiseSym0 :: Bool - type family OtherwiseSym0 :: Bool where - OtherwiseSym0 = Otherwise - type M :: Bool - type family M :: Bool where - M = Case_0123456789876543210 X_0123456789876543210Sym0 - type L :: Bool - type family L :: Bool where - L = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) NilSym0) - type K :: Bool - type family K :: Bool where - K = Case_0123456789876543210 X_0123456789876543210Sym0 - type J :: Bool - type family J :: Bool where - J = Case_0123456789876543210 X_0123456789876543210Sym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) - type I :: Bool -> Bool - type family I (a :: Bool) :: Bool where - I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type H :: Bool -> Bool - type family H (a :: Bool) :: Bool where - H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 - type G :: Bool -> Bool - type family G (a :: Bool) :: Bool where - G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type F :: Bool -> Bool - type family F (a :: Bool) :: Bool where - F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) NilSym0) - type family False_ where - False_ = FalseSym0 - type Not :: Bool -> Bool - type family Not (a :: Bool) :: Bool where - Not 'True = FalseSym0 - Not 'False = TrueSym0 - type Id :: a -> a - type family Id (a :: a) :: a where - Id x = x - type Otherwise :: Bool - type family Otherwise :: Bool where - Otherwise = TrueSym0 - sM :: (Sing (MSym0 :: Bool) :: Type) - sL :: (Sing (LSym0 :: Bool) :: Type) - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sK :: (Sing (KSym0 :: Bool) :: Type) - sJ :: (Sing (JSym0 :: Bool) :: Type) - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sI :: - (forall (t :: Bool). - Sing t -> Sing (Apply ISym0 t :: Bool) :: Type) - sH :: - (forall (t :: Bool). - Sing t -> Sing (Apply HSym0 t :: Bool) :: Type) - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sG :: - (forall (t :: Bool). - Sing t -> Sing (Apply GSym0 t :: Bool) :: Type) - sF :: - (forall (t :: Bool). - Sing t -> Sing (Apply FSym0 t :: Bool) :: Type) - sX_0123456789876543210 :: Sing @_ X_0123456789876543210Sym0 - sFalse_ :: Sing @_ False_Sym0 - sNot :: - (forall (t :: Bool). - Sing t -> Sing (Apply NotSym0 t :: Bool) :: Type) - sId :: - (forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) :: Type) - sOtherwise :: (Sing (OtherwiseSym0 :: Bool) :: Type) - sM - = GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210) - sL - = GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210) - sX_0123456789876543210 - = applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing (singFun1 @NotSym0 sNot) STrue)) - (applySing - (applySing - (singFun2 @(:@#@$) SCons) - (applySing (singFun1 @IdSym0 sId) SFalse)) - SNil) - sK - = GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210) - sJ - = GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210) - sX_0123456789876543210 - = applySing - (applySing (singFun2 @BarSym0 SBar) STrue) - (applySing (singFun1 @HSym0 sH) SFalse) - sI (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (GHC.Base.id - @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210)) - sA_0123456789876543210 - sH (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (GHC.Base.id - @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210)) - sA_0123456789876543210 - sX_0123456789876543210 - = applySing - (applySing (singFun2 @Tuple2Sym0 STuple2) (singFun1 @FSym0 sF)) - (singFun1 @GSym0 sG) - sG (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (GHC.Base.id - @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210)) - sA_0123456789876543210 - sF (sA_0123456789876543210 :: Sing a_0123456789876543210) - = applySing - (GHC.Base.id - @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0)) - (case sX_0123456789876543210 of - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210)) - sA_0123456789876543210 - sX_0123456789876543210 - = applySing - (applySing (singFun2 @(:@#@$) SCons) (singFun1 @NotSym0 sNot)) - (applySing - (applySing (singFun2 @(:@#@$) SCons) (singFun1 @IdSym0 sId)) SNil) - sFalse_ = SFalse - sNot STrue = SFalse - sNot SFalse = STrue - sId (sX :: Sing x) = sX - sOtherwise = STrue - instance SingI (ISym0 :: (~>) Bool Bool) where - sing = singFun1 @ISym0 sI - instance SingI (HSym0 :: (~>) Bool Bool) where - sing = singFun1 @HSym0 sH - instance SingI (GSym0 :: (~>) Bool Bool) where - sing = singFun1 @GSym0 sG - instance SingI (FSym0 :: (~>) Bool Bool) where - sing = singFun1 @FSym0 sF - instance SingI (NotSym0 :: (~>) Bool Bool) where - sing = singFun1 @NotSym0 sNot - instance SingI (IdSym0 :: (~>) a a) where - sing = singFun1 @IdSym0 sId +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 :: Bool+ type family FalseSym0 :: Bool where+ FalseSym0 = False+ type TrueSym0 :: Bool+ type family TrueSym0 :: Bool where+ TrueSym0 = True+ type BarSym0 :: (~>) Bool ((~>) Bool Foo)+ data BarSym0 :: (~>) Bool ((~>) Bool Foo)+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @Bool @((~>) Bool Foo) BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) BarSym0KindInference ())+ type BarSym1 :: Bool -> (~>) Bool Foo+ data BarSym1 (a0123456789876543210 :: Bool) :: (~>) Bool Foo+ where+ BarSym1KindInference :: SameKind (Apply (BarSym1 a0123456789876543210) arg) (BarSym2 a0123456789876543210 arg) =>+ BarSym1 a0123456789876543210 a0123456789876543210+ type instance Apply @Bool @Foo (BarSym1 a0123456789876543210) a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (BarSym1 a0123456789876543210) where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) BarSym1KindInference ())+ type BarSym2 :: Bool -> Bool -> Foo+ type family BarSym2 (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) :: Foo where+ BarSym2 a0123456789876543210 a0123456789876543210 = Bar a0123456789876543210 a0123456789876543210+ data SBool :: Bool -> Type+ where+ SFalse :: SBool (False :: Bool)+ STrue :: SBool (True :: Bool)+ type instance Sing @Bool = SBool+ instance SingKind Bool where+ type Demote Bool = Bool+ fromSing SFalse = False+ fromSing STrue = True+ toSing False = SomeSing SFalse+ toSing True = SomeSing STrue+ data SFoo :: Foo -> Type+ where+ SBar :: forall (n :: Bool) (n :: Bool).+ (Sing n) -> (Sing n) -> SFoo (Bar n n :: Foo)+ type instance Sing @Foo = SFoo+ 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))+ = (\cases (SomeSing c) (SomeSing c) -> SomeSing (SBar c c))+ (toSing b :: SomeSing Bool) (toSing b :: SomeSing Bool)+ 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 n => SingI1 (Bar (n :: Bool)) where+ liftSing = SBar sing+ instance SingI2 Bar where+ liftSing2 = SBar+ instance SingI (BarSym0 :: (~>) Bool ((~>) Bool Foo)) where+ sing = singFun2 @BarSym0 SBar+ instance SingI d =>+ SingI (BarSym1 (d :: Bool) :: (~>) Bool Foo) where+ sing = singFun1 @(BarSym1 (d :: Bool)) (SBar (sing @d))+ instance SingI1 (BarSym1 :: Bool -> (~>) Bool Foo) where+ liftSing (s :: Sing (d :: Bool))+ = singFun1 @(BarSym1 (d :: Bool)) (SBar s)+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 LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '[_,+ y_0123456789876543210] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 '[y_0123456789876543210,+ _] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Bar _ y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 a_0123456789876543210 where+ LamCases_0123456789876543210 ('Bar y_0123456789876543210 _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply LamCases_0123456789876543210Sym0 arg) (LamCases_0123456789876543210Sym1 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings LamCases_0123456789876543210Sym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 '(_,+ y_0123456789876543210) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210,+ _) = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 '[_,+ y_0123456789876543210] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type family LamCases_0123456789876543210 (a_01234567898765432100123456789876543210 :: Bool) a_0123456789876543210 where+ LamCases_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210,+ _] = y_0123456789876543210+ data LamCases_0123456789876543210Sym0 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210+ where+ LamCases_0123456789876543210Sym0KindInference :: SameKind (Apply (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) arg) (LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 arg) =>+ LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type instance Apply @_ @_ (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ instance SuppressUnusedWarnings (LamCases_0123456789876543210Sym0 a_01234567898765432100123456789876543210) where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd+ ((,) LamCases_0123456789876543210Sym0KindInference ())+ type family LamCases_0123456789876543210Sym1 (a_01234567898765432100123456789876543210 :: Bool) a_01234567898765432100123456789876543210 where+ LamCases_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 = LamCases_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210+ type MSym0 :: Bool+ type family MSym0 :: Bool where+ MSym0 = M+ type LSym0 :: Bool+ type family LSym0 :: Bool where+ LSym0 = L+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type KSym0 :: Bool+ type family KSym0 :: Bool where+ KSym0 = K+ type JSym0 :: Bool+ type family JSym0 :: Bool where+ JSym0 = J+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type ISym0 :: (~>) Bool Bool+ data ISym0 :: (~>) Bool Bool+ where+ ISym0KindInference :: SameKind (Apply ISym0 arg) (ISym1 arg) =>+ ISym0 a0123456789876543210+ type instance Apply @Bool @Bool ISym0 a0123456789876543210 = I a0123456789876543210+ instance SuppressUnusedWarnings ISym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) ISym0KindInference ())+ type ISym1 :: Bool -> Bool+ type family ISym1 (a0123456789876543210 :: Bool) :: Bool where+ ISym1 a0123456789876543210 = I a0123456789876543210+ type HSym0 :: (~>) Bool Bool+ data HSym0 :: (~>) Bool Bool+ where+ HSym0KindInference :: SameKind (Apply HSym0 arg) (HSym1 arg) =>+ HSym0 a0123456789876543210+ type instance Apply @Bool @Bool HSym0 a0123456789876543210 = H a0123456789876543210+ instance SuppressUnusedWarnings HSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) HSym0KindInference ())+ type HSym1 :: Bool -> Bool+ type family HSym1 (a0123456789876543210 :: Bool) :: Bool where+ HSym1 a0123456789876543210 = H a0123456789876543210+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type GSym0 :: (~>) Bool Bool+ data GSym0 :: (~>) Bool Bool+ where+ GSym0KindInference :: SameKind (Apply GSym0 arg) (GSym1 arg) =>+ GSym0 a0123456789876543210+ type instance Apply @Bool @Bool GSym0 a0123456789876543210 = G a0123456789876543210+ instance SuppressUnusedWarnings GSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) GSym0KindInference ())+ type GSym1 :: Bool -> Bool+ type family GSym1 (a0123456789876543210 :: Bool) :: Bool where+ GSym1 a0123456789876543210 = G a0123456789876543210+ type FSym0 :: (~>) Bool Bool+ data FSym0 :: (~>) Bool Bool+ where+ FSym0KindInference :: SameKind (Apply FSym0 arg) (FSym1 arg) =>+ FSym0 a0123456789876543210+ type instance Apply @Bool @Bool FSym0 a0123456789876543210 = F a0123456789876543210+ instance SuppressUnusedWarnings FSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) FSym0KindInference ())+ type FSym1 :: Bool -> Bool+ type family FSym1 (a0123456789876543210 :: Bool) :: Bool where+ FSym1 a0123456789876543210 = F a0123456789876543210+ type family X_0123456789876543210Sym0 where+ X_0123456789876543210Sym0 = X_0123456789876543210+ type family False_Sym0 where+ False_Sym0 = False_+ type NotSym0 :: (~>) Bool Bool+ data NotSym0 :: (~>) Bool Bool+ where+ NotSym0KindInference :: SameKind (Apply NotSym0 arg) (NotSym1 arg) =>+ NotSym0 a0123456789876543210+ type instance Apply @Bool @Bool NotSym0 a0123456789876543210 = Not a0123456789876543210+ instance SuppressUnusedWarnings NotSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) NotSym0KindInference ())+ type NotSym1 :: Bool -> Bool+ type family NotSym1 (a0123456789876543210 :: Bool) :: Bool where+ NotSym1 a0123456789876543210 = Not a0123456789876543210+ type IdSym0 :: (~>) a a+ data IdSym0 :: (~>) a a+ where+ IdSym0KindInference :: SameKind (Apply IdSym0 arg) (IdSym1 arg) =>+ IdSym0 a0123456789876543210+ type instance Apply @a @a IdSym0 a0123456789876543210 = Id a0123456789876543210+ instance SuppressUnusedWarnings IdSym0 where+ suppressUnusedWarnings+ = GHC.Internal.Data.Tuple.snd ((,) IdSym0KindInference ())+ type IdSym1 :: a -> a+ type family IdSym1 @a (a0123456789876543210 :: a) :: a where+ IdSym1 a0123456789876543210 = Id a0123456789876543210+ type OtherwiseSym0 :: Bool+ type family OtherwiseSym0 :: Bool where+ OtherwiseSym0 = Otherwise+ type M :: Bool+ type family M :: Bool where+ M = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type L :: Bool+ type family L :: Bool where+ L = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) NilSym0)+ type K :: Bool+ type family K :: Bool where+ K = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type J :: Bool+ type family J :: Bool where+ J = Apply LamCases_0123456789876543210Sym0 X_0123456789876543210Sym0+ type family X_0123456789876543210 where+ X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0)+ type I :: Bool -> Bool+ type family I (a :: Bool) :: Bool where+ I a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210) X_0123456789876543210Sym0) a_0123456789876543210+ type H :: Bool -> Bool+ type family H (a :: Bool) :: Bool where+ H a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210) X_0123456789876543210Sym0) a_0123456789876543210+ type family X_0123456789876543210 where+ X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0+ type G :: Bool -> Bool+ type family G (a :: Bool) :: Bool where+ G a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210) X_0123456789876543210Sym0) a_0123456789876543210+ type F :: Bool -> Bool+ type family F (a :: Bool) :: Bool where+ F a_0123456789876543210 = Apply (Apply (LamCases_0123456789876543210Sym0 a_0123456789876543210) X_0123456789876543210Sym0) a_0123456789876543210+ type family X_0123456789876543210 where+ X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) NilSym0)+ type family False_ where+ False_ = FalseSym0+ type Not :: Bool -> Bool+ type family Not (a :: Bool) :: Bool where+ Not 'True = FalseSym0+ Not 'False = TrueSym0+ type Id :: a -> a+ type family Id @a (a :: a) :: a where+ Id x = x+ type Otherwise :: Bool+ type family Otherwise :: Bool where+ Otherwise = TrueSym0+ sM :: (Sing (M :: Bool) :: Type)+ sL :: (Sing (L :: Bool) :: Type)+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sK :: (Sing (K :: Bool) :: Type)+ sJ :: (Sing (J :: Bool) :: Type)+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sI :: (forall (t :: Bool). Sing t -> Sing (I t :: Bool) :: Type)+ sH :: (forall (t :: Bool). Sing t -> Sing (H t :: Bool) :: Type)+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sG :: (forall (t :: Bool). Sing t -> Sing (G t :: Bool) :: Type)+ sF :: (forall (t :: Bool). Sing t -> Sing (F t :: Bool) :: Type)+ sX_0123456789876543210 :: Sing @_ X_0123456789876543210+ sFalse_ :: Sing @_ False_+ sNot ::+ (forall (t :: Bool). Sing t -> Sing (Not t :: Bool) :: Type)+ sId :: (forall (t :: a). Sing t -> Sing (Id t :: a) :: Type)+ sOtherwise :: (Sing (Otherwise :: Bool) :: Type)+ sM+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SCons _+ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)+ SNil))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sL+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)+ (SCons _ SNil))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210+ = applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing (singFun1 @NotSym0 sNot) STrue))+ (applySing+ (applySing+ (singFun2 @(:@#@$) SCons)+ (applySing (singFun1 @IdSym0 sId) SFalse))+ SNil)+ sK+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sJ+ = applySing+ (singFun1+ @LamCases_0123456789876543210Sym0+ (\cases+ (SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _)+ -> sY_0123456789876543210))+ sX_0123456789876543210+ sX_0123456789876543210+ = applySing+ (applySing (singFun2 @BarSym0 SBar) STrue)+ (applySing (singFun1 @HSym0 sH) SFalse)+ sI (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210)+ (\cases+ (STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210))+ -> sY_0123456789876543210))+ sX_0123456789876543210)+ sA_0123456789876543210+ sH (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210)+ (\cases+ (STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _)+ -> sY_0123456789876543210))+ sX_0123456789876543210)+ sA_0123456789876543210+ sX_0123456789876543210+ = applySing+ (applySing (singFun2 @Tuple2Sym0 STuple2) (singFun1 @FSym0 sF))+ (singFun1 @GSym0 sG)+ sG (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210)+ (\cases+ (SCons _+ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)+ SNil))+ -> sY_0123456789876543210))+ sX_0123456789876543210)+ sA_0123456789876543210+ sF (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing+ (singFun1+ @(LamCases_0123456789876543210Sym0 a_0123456789876543210)+ (\cases+ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210)+ (SCons _ SNil))+ -> sY_0123456789876543210))+ sX_0123456789876543210)+ sA_0123456789876543210+ sX_0123456789876543210+ = applySing+ (applySing (singFun2 @(:@#@$) SCons) (singFun1 @NotSym0 sNot))+ (applySing+ (applySing (singFun2 @(:@#@$) SCons) (singFun1 @IdSym0 sId)) SNil)+ sFalse_ = SFalse+ sNot STrue = SFalse+ sNot SFalse = STrue+ sId (sX :: Sing x) = sX+ sOtherwise = STrue+ instance SingI (ISym0 :: (~>) Bool Bool) where+ sing = singFun1 @ISym0 sI+ instance SingI (HSym0 :: (~>) Bool Bool) where+ sing = singFun1 @HSym0 sH+ instance SingI (GSym0 :: (~>) Bool Bool) where+ sing = singFun1 @GSym0 sG+ instance SingI (FSym0 :: (~>) Bool Bool) where+ sing = singFun1 @FSym0 sF+ instance SingI (NotSym0 :: (~>) Bool Bool) where+ sing = singFun1 @NotSym0 sNot+ instance SingI (IdSym0 :: (~>) a a) where+ sing = singFun1 @IdSym0 sId
tests/compile-and-dump/Singletons/TopLevelPatterns.hs view
@@ -1,37 +1,37 @@-{-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Singletons.TopLevelPatterns where - -import Data.Singletons.Base.TH hiding (SBool(..), 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] - |]) +{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++module Singletons.TopLevelPatterns where++import Data.Singletons.Base.TH hiding (SBool(..), 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/TypeAbstractions.golden view
@@ -0,0 +1,347 @@+Singletons/TypeAbstractions.hs:(0,0)-(0,0): Splicing declarations+ withOptions defaultOptions {genSingKindInsts = False}+ $ singletons+ [d| type D1 :: forall j k. j -> k -> Type+ type D2 :: forall j k. j -> k -> Type+ type D3 :: forall j. j -> forall k. k -> Type+ type D4 :: forall (a :: Type). Type+ type C1 :: forall j k. j -> k -> Constraint+ type C2 :: forall j k. j -> k -> Constraint+ type C3 :: forall j. j -> forall k. k -> Constraint+ type C4 :: forall (a :: Type). Constraint+ type TF :: forall j. j -> forall k. k -> Type+ type TS :: forall j. j -> forall k. k -> Type+ + data D1 @j @k (a :: j) (b :: k) = MkD1 (Proxy a) (Proxy b)+ data D2 @x @y (a :: x) (b :: y) = MkD2 (Proxy a) (Proxy b)+ data D3 @j (a :: j) @k (b :: k) = MkD3 (Proxy a) (Proxy b)+ data D4 @a = MkD4 a+ class C1 @j @k (a :: j) (b :: k) where+ meth1 :: Proxy a -> Proxy b+ class C2 @x @y (a :: x) (b :: y) where+ meth2 :: Proxy a -> Proxy b+ class C3 @j (a :: j) @k (b :: k) where+ meth3 :: Proxy a -> Proxy b+ class C4 @a where+ meth4 :: a+ type family TF @j (a :: j) @k (b :: k) where+ TF @j _ @k _ = (j, k)+ type TS @j (a :: j) @k (b :: k) = (j, k) |]+ ======>+ type D1 :: forall j k. j -> k -> Type+ data D1 @j @k (a :: j) (b :: k) = MkD1 (Proxy a) (Proxy b)+ type D2 :: forall j k. j -> k -> Type+ data D2 @x @y (a :: x) (b :: y) = MkD2 (Proxy a) (Proxy b)+ type D3 :: forall j. j -> forall k. k -> Type+ data D3 @j (a :: j) @k (b :: k) = MkD3 (Proxy a) (Proxy b)+ type D4 :: forall (a :: Type). Type+ data D4 @a = MkD4 a+ type C1 :: forall j k. j -> k -> Constraint+ class C1 @j @k (a :: j) (b :: k) where+ meth1 :: Proxy a -> Proxy b+ type C2 :: forall j k. j -> k -> Constraint+ class C2 @x @y (a :: x) (b :: y) where+ meth2 :: Proxy a -> Proxy b+ type C3 :: forall j. j -> forall k. k -> Constraint+ class C3 @j (a :: j) @k (b :: k) where+ meth3 :: Proxy a -> Proxy b+ type C4 :: forall (a :: Type). Constraint+ class C4 @a where+ meth4 :: a+ type TF :: forall j. j -> forall k. k -> Type+ type family TF @j (a :: j) @k (b :: k) where+ TF @j _ @k _ = (j, k)+ type TS :: forall j. j -> forall k. k -> Type+ type TS @j (a :: j) @k (b :: k) = (j, k)+ data TSSym0 :: (~>) j0123456789876543210 ((~>) k0123456789876543210 Type)+ where+ TSSym0KindInference :: SameKind (Apply TSSym0 arg) (TSSym1 arg) =>+ TSSym0 e0123456789876543210+ type instance Apply @j0123456789876543210 @((~>) k0123456789876543210 Type) TSSym0 e0123456789876543210 = TSSym1 e0123456789876543210+ instance SuppressUnusedWarnings TSSym0 where+ suppressUnusedWarnings = snd ((,) TSSym0KindInference ())+ data TSSym1 (e0123456789876543210 :: j0123456789876543210) :: (~>) k0123456789876543210 Type+ where+ TSSym1KindInference :: SameKind (Apply (TSSym1 e0123456789876543210) arg) (TSSym2 e0123456789876543210 arg) =>+ TSSym1 e0123456789876543210 e0123456789876543210+ type instance Apply @k0123456789876543210 @Type (TSSym1 e0123456789876543210) e0123456789876543210 = TS e0123456789876543210 e0123456789876543210+ instance SuppressUnusedWarnings (TSSym1 e0123456789876543210) where+ suppressUnusedWarnings = snd ((,) TSSym1KindInference ())+ type family TSSym2 (e0123456789876543210 :: j0123456789876543210) (e0123456789876543210 :: k0123456789876543210) :: Type where+ TSSym2 e0123456789876543210 e0123456789876543210 = TS e0123456789876543210 e0123456789876543210+ data TFSym0 :: (~>) j0123456789876543210 ((~>) k0123456789876543210 Type)+ where+ TFSym0KindInference :: SameKind (Apply TFSym0 arg) (TFSym1 arg) =>+ TFSym0 e0123456789876543210+ type instance Apply @j0123456789876543210 @((~>) k0123456789876543210 Type) TFSym0 e0123456789876543210 = TFSym1 e0123456789876543210+ instance SuppressUnusedWarnings TFSym0 where+ suppressUnusedWarnings = snd ((,) TFSym0KindInference ())+ data TFSym1 (e0123456789876543210 :: j0123456789876543210) :: (~>) k0123456789876543210 Type+ where+ TFSym1KindInference :: SameKind (Apply (TFSym1 e0123456789876543210) arg) (TFSym2 e0123456789876543210 arg) =>+ TFSym1 e0123456789876543210 e0123456789876543210+ type instance Apply @k0123456789876543210 @Type (TFSym1 e0123456789876543210) e0123456789876543210 = TF e0123456789876543210 e0123456789876543210+ instance SuppressUnusedWarnings (TFSym1 e0123456789876543210) where+ suppressUnusedWarnings = snd ((,) TFSym1KindInference ())+ type family TFSym2 (e0123456789876543210 :: j0123456789876543210) (e0123456789876543210 :: k0123456789876543210) :: Type where+ TFSym2 e0123456789876543210 e0123456789876543210 = TF e0123456789876543210 e0123456789876543210+ type MkD1Sym0 :: forall j+ k+ (a :: j)+ (b :: k). (~>) (Proxy a) ((~>) (Proxy b) (D1 @j @k a b))+ data MkD1Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D1 @j @k a b))+ where+ MkD1Sym0KindInference :: SameKind (Apply MkD1Sym0 arg) (MkD1Sym1 arg) =>+ MkD1Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @((~>) (Proxy b) (D1 @j @k a b)) MkD1Sym0 a0123456789876543210 = MkD1Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkD1Sym0 where+ suppressUnusedWarnings = snd ((,) MkD1Sym0KindInference ())+ type MkD1Sym1 :: forall j k (a :: j) (b :: k). Proxy a+ -> (~>) (Proxy b) (D1 @j @k a b)+ data MkD1Sym1 (a0123456789876543210 :: Proxy a) :: (~>) (Proxy b) (D1 @j @k a b)+ where+ MkD1Sym1KindInference :: SameKind (Apply (MkD1Sym1 a0123456789876543210) arg) (MkD1Sym2 a0123456789876543210 arg) =>+ MkD1Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Proxy b) @(D1 @j @k a b) (MkD1Sym1 a0123456789876543210) a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkD1Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkD1Sym1KindInference ())+ type MkD1Sym2 :: forall j k (a :: j) (b :: k). Proxy a+ -> Proxy b -> D1 @j @k a b+ type family MkD1Sym2 @j @k @(a :: j) @(b :: k) (a0123456789876543210 :: Proxy a) (a0123456789876543210 :: Proxy b) :: D1 @j @k a b where+ MkD1Sym2 a0123456789876543210 a0123456789876543210 = MkD1 a0123456789876543210 a0123456789876543210+ type MkD2Sym0 :: forall x+ y+ (a :: x)+ (b :: y). (~>) (Proxy a) ((~>) (Proxy b) (D2 @x @y a b))+ data MkD2Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D2 @x @y a b))+ where+ MkD2Sym0KindInference :: SameKind (Apply MkD2Sym0 arg) (MkD2Sym1 arg) =>+ MkD2Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @((~>) (Proxy b) (D2 @x @y a b)) MkD2Sym0 a0123456789876543210 = MkD2Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkD2Sym0 where+ suppressUnusedWarnings = snd ((,) MkD2Sym0KindInference ())+ type MkD2Sym1 :: forall x y (a :: x) (b :: y). Proxy a+ -> (~>) (Proxy b) (D2 @x @y a b)+ data MkD2Sym1 (a0123456789876543210 :: Proxy a) :: (~>) (Proxy b) (D2 @x @y a b)+ where+ MkD2Sym1KindInference :: SameKind (Apply (MkD2Sym1 a0123456789876543210) arg) (MkD2Sym2 a0123456789876543210 arg) =>+ MkD2Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Proxy b) @(D2 @x @y a b) (MkD2Sym1 a0123456789876543210) a0123456789876543210 = MkD2 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkD2Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkD2Sym1KindInference ())+ type MkD2Sym2 :: forall x y (a :: x) (b :: y). Proxy a+ -> Proxy b -> D2 @x @y a b+ type family MkD2Sym2 @x @y @(a :: x) @(b :: y) (a0123456789876543210 :: Proxy a) (a0123456789876543210 :: Proxy b) :: D2 @x @y a b where+ MkD2Sym2 a0123456789876543210 a0123456789876543210 = MkD2 a0123456789876543210 a0123456789876543210+ type MkD3Sym0 :: forall j+ (a :: j)+ k+ (b :: k). (~>) (Proxy a) ((~>) (Proxy b) (D3 @j a @k b))+ data MkD3Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D3 @j a @k b))+ where+ MkD3Sym0KindInference :: SameKind (Apply MkD3Sym0 arg) (MkD3Sym1 arg) =>+ MkD3Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @((~>) (Proxy b) (D3 @j a @k b)) MkD3Sym0 a0123456789876543210 = MkD3Sym1 a0123456789876543210+ instance SuppressUnusedWarnings MkD3Sym0 where+ suppressUnusedWarnings = snd ((,) MkD3Sym0KindInference ())+ type MkD3Sym1 :: forall j (a :: j) k (b :: k). Proxy a+ -> (~>) (Proxy b) (D3 @j a @k b)+ data MkD3Sym1 (a0123456789876543210 :: Proxy a) :: (~>) (Proxy b) (D3 @j a @k b)+ where+ MkD3Sym1KindInference :: SameKind (Apply (MkD3Sym1 a0123456789876543210) arg) (MkD3Sym2 a0123456789876543210 arg) =>+ MkD3Sym1 a0123456789876543210 a0123456789876543210+ type instance Apply @(Proxy b) @(D3 @j a @k b) (MkD3Sym1 a0123456789876543210) a0123456789876543210 = MkD3 a0123456789876543210 a0123456789876543210+ instance SuppressUnusedWarnings (MkD3Sym1 a0123456789876543210) where+ suppressUnusedWarnings = snd ((,) MkD3Sym1KindInference ())+ type MkD3Sym2 :: forall j (a :: j) k (b :: k). Proxy a+ -> Proxy b -> D3 @j a @k b+ type family MkD3Sym2 @j @(a :: j) @k @(b :: k) (a0123456789876543210 :: Proxy a) (a0123456789876543210 :: Proxy b) :: D3 @j a @k b where+ MkD3Sym2 a0123456789876543210 a0123456789876543210 = MkD3 a0123456789876543210 a0123456789876543210+ type MkD4Sym0 :: forall (a :: Type). (~>) a (D4 @a)+ data MkD4Sym0 :: (~>) a (D4 @a)+ where+ MkD4Sym0KindInference :: SameKind (Apply MkD4Sym0 arg) (MkD4Sym1 arg) =>+ MkD4Sym0 a0123456789876543210+ type instance Apply @a @(D4 @a) MkD4Sym0 a0123456789876543210 = MkD4 a0123456789876543210+ instance SuppressUnusedWarnings MkD4Sym0 where+ suppressUnusedWarnings = snd ((,) MkD4Sym0KindInference ())+ type MkD4Sym1 :: forall (a :: Type). a -> D4 @a+ type family MkD4Sym1 @(a :: Type) (a0123456789876543210 :: a) :: D4 @a where+ MkD4Sym1 a0123456789876543210 = MkD4 a0123456789876543210+ type Meth1Sym0 :: forall j+ k+ (a :: j)+ (b :: k). (~>) (Proxy a) (Proxy b)+ data Meth1Sym0 :: (~>) (Proxy a) (Proxy b)+ where+ Meth1Sym0KindInference :: SameKind (Apply Meth1Sym0 arg) (Meth1Sym1 arg) =>+ Meth1Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @(Proxy b) Meth1Sym0 a0123456789876543210 = Meth1 a0123456789876543210+ instance SuppressUnusedWarnings Meth1Sym0 where+ suppressUnusedWarnings = snd ((,) Meth1Sym0KindInference ())+ type Meth1Sym1 :: forall j k (a :: j) (b :: k). Proxy a -> Proxy b+ type family Meth1Sym1 @j @k @(a :: j) @(b :: k) (a0123456789876543210 :: Proxy a) :: Proxy b where+ Meth1Sym1 a0123456789876543210 = Meth1 a0123456789876543210+ type PC1 :: forall j k. j -> k -> Constraint+ class PC1 @j @k (a :: j) (b :: k) where+ type family Meth1 (arg :: Proxy a) :: Proxy b+ type Meth2Sym0 :: forall x+ y+ (a :: x)+ (b :: y). (~>) (Proxy a) (Proxy b)+ data Meth2Sym0 :: (~>) (Proxy a) (Proxy b)+ where+ Meth2Sym0KindInference :: SameKind (Apply Meth2Sym0 arg) (Meth2Sym1 arg) =>+ Meth2Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @(Proxy b) Meth2Sym0 a0123456789876543210 = Meth2 a0123456789876543210+ instance SuppressUnusedWarnings Meth2Sym0 where+ suppressUnusedWarnings = snd ((,) Meth2Sym0KindInference ())+ type Meth2Sym1 :: forall x y (a :: x) (b :: y). Proxy a -> Proxy b+ type family Meth2Sym1 @x @y @(a :: x) @(b :: y) (a0123456789876543210 :: Proxy a) :: Proxy b where+ Meth2Sym1 a0123456789876543210 = Meth2 a0123456789876543210+ type PC2 :: forall j k. j -> k -> Constraint+ class PC2 @x @y (a :: x) (b :: y) where+ type family Meth2 (arg :: Proxy a) :: Proxy b+ type Meth3Sym0 :: forall j+ (a :: j)+ k+ (b :: k). (~>) (Proxy a) (Proxy b)+ data Meth3Sym0 :: (~>) (Proxy a) (Proxy b)+ where+ Meth3Sym0KindInference :: SameKind (Apply Meth3Sym0 arg) (Meth3Sym1 arg) =>+ Meth3Sym0 a0123456789876543210+ type instance Apply @(Proxy a) @(Proxy b) Meth3Sym0 a0123456789876543210 = Meth3 a0123456789876543210+ instance SuppressUnusedWarnings Meth3Sym0 where+ suppressUnusedWarnings = snd ((,) Meth3Sym0KindInference ())+ type Meth3Sym1 :: forall j (a :: j) k (b :: k). Proxy a -> Proxy b+ type family Meth3Sym1 @j @(a :: j) @k @(b :: k) (a0123456789876543210 :: Proxy a) :: Proxy b where+ Meth3Sym1 a0123456789876543210 = Meth3 a0123456789876543210+ type PC3 :: forall j. j -> forall k. k -> Constraint+ class PC3 @j (a :: j) @k (b :: k) where+ type family Meth3 (arg :: Proxy a) :: Proxy b+ type Meth4Sym0 :: forall (a :: Type). a+ type family Meth4Sym0 @(a :: Type) :: a where+ Meth4Sym0 = Meth4+ type PC4 :: forall (a :: Type). Constraint+ class PC4 @a where+ type family Meth4 :: a+ type SD1 :: forall j k (a :: j) (b :: k). D1 @j @k a b -> Type+ data SD1 :: forall j k (a :: j) (b :: k). D1 @j @k a b -> Type+ where+ SMkD1 :: forall j+ k+ (a :: j)+ (b :: k)+ (n :: Proxy a)+ (n :: Proxy b).+ (Sing n) -> (Sing n) -> SD1 (MkD1 n n :: D1 @j @k a b)+ type instance Sing @(D1 @j @k a b) = SD1+ type SD2 :: forall x y (a :: x) (b :: y). D2 @x @y a b -> Type+ data SD2 :: forall x y (a :: x) (b :: y). D2 @x @y a b -> Type+ where+ SMkD2 :: forall x+ y+ (a :: x)+ (b :: y)+ (n :: Proxy a)+ (n :: Proxy b).+ (Sing n) -> (Sing n) -> SD2 (MkD2 n n :: D2 @x @y a b)+ type instance Sing @(D2 @x @y a b) = SD2+ type SD3 :: forall j (a :: j) k (b :: k). D3 @j a @k b -> Type+ data SD3 :: forall j (a :: j) k (b :: k). D3 @j a @k b -> Type+ where+ SMkD3 :: forall j+ (a :: j)+ k+ (b :: k)+ (n :: Proxy a)+ (n :: Proxy b).+ (Sing n) -> (Sing n) -> SD3 (MkD3 n n :: D3 @j a @k b)+ type instance Sing @(D3 @j a @k b) = SD3+ type SD4 :: forall (a :: Type). D4 @a -> Type+ data SD4 :: forall (a :: Type). D4 @a -> Type+ where+ SMkD4 :: forall (a :: Type) (n :: a).+ (Sing n) -> SD4 (MkD4 n :: D4 @a)+ type instance Sing @(D4 @a) = SD4+ class SC1 @j @k (a :: j) (b :: k) where+ sMeth1 ::+ (forall (t :: Proxy a).+ Sing t -> Sing (Meth1 t :: Proxy b) :: Type)+ class SC2 @x @y (a :: x) (b :: y) where+ sMeth2 ::+ (forall (t :: Proxy a).+ Sing t -> Sing (Meth2 t :: Proxy b) :: Type)+ class SC3 @j (a :: j) @k (b :: k) where+ sMeth3 ::+ (forall (t :: Proxy a).+ Sing t -> Sing (Meth3 t :: Proxy b) :: Type)+ class SC4 @a where+ sMeth4 :: (Sing (Meth4 :: a) :: Type)+ instance (SingI n, SingI n) =>+ SingI (MkD1 (n :: Proxy a) (n :: Proxy b)) where+ sing = SMkD1 sing sing+ instance SingI n => SingI1 (MkD1 (n :: Proxy a)) where+ liftSing = SMkD1 sing+ instance SingI2 MkD1 where+ liftSing2 = SMkD1+ instance SingI (MkD1Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D1 @j @k a b))) where+ sing = singFun2 @MkD1Sym0 SMkD1+ instance SingI d =>+ SingI (MkD1Sym1 (d :: Proxy a) :: (~>) (Proxy b) (D1 @j @k a b)) where+ sing = singFun1 @(MkD1Sym1 (d :: Proxy a)) (SMkD1 (sing @d))+ instance SingI1 (MkD1Sym1 :: Proxy a+ -> (~>) (Proxy b) (D1 @j @k a b)) where+ liftSing (s :: Sing (d :: Proxy a))+ = singFun1 @(MkD1Sym1 (d :: Proxy a)) (SMkD1 s)+ instance (SingI n, SingI n) =>+ SingI (MkD2 (n :: Proxy a) (n :: Proxy b)) where+ sing = SMkD2 sing sing+ instance SingI n => SingI1 (MkD2 (n :: Proxy a)) where+ liftSing = SMkD2 sing+ instance SingI2 MkD2 where+ liftSing2 = SMkD2+ instance SingI (MkD2Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D2 @x @y a b))) where+ sing = singFun2 @MkD2Sym0 SMkD2+ instance SingI d =>+ SingI (MkD2Sym1 (d :: Proxy a) :: (~>) (Proxy b) (D2 @x @y a b)) where+ sing = singFun1 @(MkD2Sym1 (d :: Proxy a)) (SMkD2 (sing @d))+ instance SingI1 (MkD2Sym1 :: Proxy a+ -> (~>) (Proxy b) (D2 @x @y a b)) where+ liftSing (s :: Sing (d :: Proxy a))+ = singFun1 @(MkD2Sym1 (d :: Proxy a)) (SMkD2 s)+ instance (SingI n, SingI n) =>+ SingI (MkD3 (n :: Proxy a) (n :: Proxy b)) where+ sing = SMkD3 sing sing+ instance SingI n => SingI1 (MkD3 (n :: Proxy a)) where+ liftSing = SMkD3 sing+ instance SingI2 MkD3 where+ liftSing2 = SMkD3+ instance SingI (MkD3Sym0 :: (~>) (Proxy a) ((~>) (Proxy b) (D3 @j a @k b))) where+ sing = singFun2 @MkD3Sym0 SMkD3+ instance SingI d =>+ SingI (MkD3Sym1 (d :: Proxy a) :: (~>) (Proxy b) (D3 @j a @k b)) where+ sing = singFun1 @(MkD3Sym1 (d :: Proxy a)) (SMkD3 (sing @d))+ instance SingI1 (MkD3Sym1 :: Proxy a+ -> (~>) (Proxy b) (D3 @j a @k b)) where+ liftSing (s :: Sing (d :: Proxy a))+ = singFun1 @(MkD3Sym1 (d :: Proxy a)) (SMkD3 s)+ instance SingI n => SingI (MkD4 (n :: a)) where+ sing = SMkD4 sing+ instance SingI1 MkD4 where+ liftSing = SMkD4+ instance SingI (MkD4Sym0 :: (~>) a (D4 @a)) where+ sing = singFun1 @MkD4Sym0 SMkD4+ type SC1 :: forall j k. j -> k -> Constraint+ instance SC1 @j @k a b =>+ SingI (Meth1Sym0 :: (~>) (Proxy a) (Proxy b)) where+ sing = singFun1 @Meth1Sym0 sMeth1+ type SC2 :: forall j k. j -> k -> Constraint+ instance SC2 @x @y a b =>+ SingI (Meth2Sym0 :: (~>) (Proxy a) (Proxy b)) where+ sing = singFun1 @Meth2Sym0 sMeth2+ type SC3 :: forall j. j -> forall k. k -> Constraint+ instance SC3 @j a @k b =>+ SingI (Meth3Sym0 :: (~>) (Proxy a) (Proxy b)) where+ sing = singFun1 @Meth3Sym0 sMeth3+ type SC4 :: forall (a :: Type). Constraint
+ tests/compile-and-dump/Singletons/TypeAbstractions.hs view
@@ -0,0 +1,46 @@+module TypeAbstractions where++import Data.Kind+import Data.Proxy+import Data.Proxy.Singletons+import Data.Singletons.Base.TH+import Data.Singletons.TH.Options+import Prelude.Singletons++$(withOptions defaultOptions{genSingKindInsts = False} $+ singletons [d|+ type D1 :: forall j k. j -> k -> Type+ data D1 @j @k (a :: j) (b :: k) = MkD1 (Proxy a) (Proxy b)++ type D2 :: forall j k. j -> k -> Type+ data D2 @x @y (a :: x) (b :: y) = MkD2 (Proxy a) (Proxy b)++ type D3 :: forall j. j -> forall k. k -> Type+ data D3 @j (a :: j) @k (b :: k) = MkD3 (Proxy a) (Proxy b)++ type D4 :: forall (a :: Type). Type+ data D4 @a = MkD4 a++ type C1 :: forall j k. j -> k -> Constraint+ class C1 @j @k (a :: j) (b :: k) where+ meth1 :: Proxy a -> Proxy b++ type C2 :: forall j k. j -> k -> Constraint+ class C2 @x @y (a :: x) (b :: y) where+ meth2 :: Proxy a -> Proxy b++ type C3 :: forall j. j -> forall k. k -> Constraint+ class C3 @j (a :: j) @k (b :: k) where+ meth3 :: Proxy a -> Proxy b++ type C4 :: forall (a :: Type). Constraint+ class C4 @a where+ meth4 :: a++ type TF :: forall j. j -> forall k. k -> Type+ type family TF @j (a :: j) @k (b :: k) where+ TF @j _ @k _ = (j, k)++ type TS :: forall j. j -> forall k. k -> Type+ type TS @j (a :: j) @k (b :: k) = (j, k)+ |])
tests/compile-and-dump/Singletons/TypeRepTYPE.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE MagicHash #-} - -module TypeRepTYPE where - -import Data.Kind (Type) -import Data.Singletons.Base.TypeRepTYPE -import Data.Singletons.Decide -import GHC.Exts (Char#, RuntimeRep(..), TYPE, Word#) -import Prelude.Singletons -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 = typeRep @a +{-# LANGUAGE MagicHash #-}++module TypeRepTYPE where++import Data.Kind (Type)+import Data.Singletons.Base.TypeRepTYPE+import Data.Singletons.Decide+import GHC.Exts (Char#, RuntimeRep(..), TYPE, Word#)+import Prelude.Singletons+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 = typeRep @a
tests/compile-and-dump/Singletons/Undef.golden view
@@ -1,53 +1,53 @@-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 BarSym0 :: (~>) Bool Bool - data BarSym0 :: (~>) Bool Bool - where - BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 a0123456789876543210 - type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd ((,) BarSym0KindInference ()) - type BarSym1 :: Bool -> Bool - type family BarSym1 (a0123456789876543210 :: Bool) :: Bool where - BarSym1 a0123456789876543210 = Bar a0123456789876543210 - type FooSym0 :: (~>) Bool Bool - data FooSym0 :: (~>) Bool Bool - where - FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) => - FooSym0 a0123456789876543210 - type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 - instance SuppressUnusedWarnings FooSym0 where - suppressUnusedWarnings = snd ((,) FooSym0KindInference ()) - type FooSym1 :: Bool -> Bool - type family FooSym1 (a0123456789876543210 :: Bool) :: Bool where - FooSym1 a0123456789876543210 = Foo a0123456789876543210 - type Bar :: Bool -> Bool - type family Bar (a :: Bool) :: Bool where - Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 - type Foo :: Bool -> Bool - 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) :: Type) - sFoo :: - (forall (t :: Bool). - Sing t -> Sing (Apply FooSym0 t :: Bool) :: Type) - 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 +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 BarSym0 :: (~>) Bool Bool+ data BarSym0 :: (~>) Bool Bool+ where+ BarSym0KindInference :: SameKind (Apply BarSym0 arg) (BarSym1 arg) =>+ BarSym0 a0123456789876543210+ type instance Apply @Bool @Bool BarSym0 a0123456789876543210 = Bar a0123456789876543210+ instance SuppressUnusedWarnings BarSym0 where+ suppressUnusedWarnings = snd ((,) BarSym0KindInference ())+ type BarSym1 :: Bool -> Bool+ type family BarSym1 (a0123456789876543210 :: Bool) :: Bool where+ BarSym1 a0123456789876543210 = Bar a0123456789876543210+ type FooSym0 :: (~>) Bool Bool+ data FooSym0 :: (~>) Bool Bool+ where+ FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) =>+ FooSym0 a0123456789876543210+ type instance Apply @Bool @Bool FooSym0 a0123456789876543210 = Foo a0123456789876543210+ instance SuppressUnusedWarnings FooSym0 where+ suppressUnusedWarnings = snd ((,) FooSym0KindInference ())+ type FooSym1 :: Bool -> Bool+ type family FooSym1 (a0123456789876543210 :: Bool) :: Bool where+ FooSym1 a0123456789876543210 = Foo a0123456789876543210+ type Bar :: Bool -> Bool+ type family Bar (a :: Bool) :: Bool where+ Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210+ type Foo :: Bool -> Bool+ type family Foo (a :: Bool) :: Bool where+ Foo a_0123456789876543210 = Apply UndefinedSym0 a_0123456789876543210+ sBar ::+ (forall (t :: Bool). Sing t -> Sing (Bar t :: Bool) :: Type)+ sFoo ::+ (forall (t :: Bool). Sing t -> Sing (Foo t :: Bool) :: Type)+ sBar (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing+ (applySing (singFun1 @ErrorSym0 sError) (sing :: Sing "urk"))+ sA_0123456789876543210+ sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210)+ = applySing 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 view
@@ -1,12 +1,12 @@-{-# OPTIONS_GHC -Wall #-} -module Singletons.Undef where - -import Data.Singletons.Base.TH - -$(singletons [d| - foo :: Bool -> Bool - foo = undefined - - bar :: Bool -> Bool - bar = error "urk" - |]) +{-# OPTIONS_GHC -Wall #-}+module Singletons.Undef where++import Data.Singletons.Base.TH++$(singletons [d|+ foo :: Bool -> Bool+ foo = undefined++ bar :: Bool -> Bool+ bar = error "urk"+ |])