Fix #376 by inserting an apostrophe (#377)

CHANGES.md

@@ -12,6 +12,8 @@ Changelog for singletons project
   One benefit of this change is that one no longer needs defunctionalization
   symbols in order to partially apply `Σ`. As a result, `ΣSym0`, `ΣSym1`,
   and `ΣSym2` have been removed.
+* Fix a bug where expressions with explicit signatures involving function types
+  would fail to single.
 
 2.5.1
 -----

src/Data/Singletons/Promote.hs

@@ -806,7 +806,7 @@ promoteExp (DLetE decs exp) = do
 promoteExp (DSigE exp ty) = do
   (exp', ann_exp) <- promoteExp exp
   ty' <- promoteType ty
-  return (DSigT exp' ty', ADSigE exp' ann_exp ty)
+  return (DSigT exp' ty', ADSigE exp' ann_exp ty')
 promoteExp e@(DStaticE _) = fail ("Static expressions cannot be promoted: " ++ show e)
 
 promoteLitExp :: Quasi q => Lit -> q DType

tests/SingletonsTestSuite.hs

@@ -115,6 +115,7 @@ tests =
     , compileAndDumpStdTest "T353"
     , compileAndDumpStdTest "T358"
     , compileAndDumpStdTest "T371"
+    , compileAndDumpStdTest "T376"
     ],
     testCompileAndDumpGroup "Promote"
     [ compileAndDumpStdTest "Constructors"

tests/compile-and-dump/Singletons/T376.ghc86.template

@@ -0,0 +1,40 @@
+Singletons/T376.hs:(0,0)-(0,0): Splicing declarations
+    singletons
+      [d| f :: (() -> ()) -> (() -> ())
+          f g = g :: () -> () |]
+  ======>
+    f :: (() -> ()) -> () -> ()
+    f g = g :: () -> ()
+    type FSym2 (a0123456789876543210 :: (~>) () ()) (a0123456789876543210 :: ()) =
+        F a0123456789876543210 a0123456789876543210
+    instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where
+      suppressUnusedWarnings = snd (((,) FSym1KindInference) ())
+    data FSym1 (a0123456789876543210 :: (~>) () ()) :: (~>) () ()
+      where
+        FSym1KindInference :: forall a0123456789876543210
+                                     a0123456789876543210
+                                     arg. SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) =>
+                              FSym1 a0123456789876543210 a0123456789876543210
+    type instance Apply (FSym1 a0123456789876543210) a0123456789876543210 = F a0123456789876543210 a0123456789876543210
+    instance SuppressUnusedWarnings FSym0 where
+      suppressUnusedWarnings = snd (((,) FSym0KindInference) ())
+    data FSym0 :: (~>) ((~>) () ()) ((~>) () ())
+      where
+        FSym0KindInference :: forall a0123456789876543210
+                                     arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>
+                              FSym0 a0123456789876543210
+    type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210
+    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 :: ())
+    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))

tests/compile-and-dump/Singletons/T376.hs

@@ -0,0 +1,8 @@
+module T376 where
+
+import Data.Singletons.TH
+
+$(singletons [d|
+  f :: (() -> ()) -> (() -> ())
+  f g = g :: () -> ()
+  |])