Haskell template error while trying out simple examples of singlotons
With both Singletons 1.0 and github master (by e8a7d6031c) against ghc 7.8.3 I am getting the following error showing some simple examples of singletons both from Richard Eisenberg's presentation and from the internet from reasonably recent blog posts and projects github (one of them is shown below):
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import Data.Singletons
import Data.Singletons.TH
main :: IO ()
main = return ()
$(singletons [d|
data Nat = Zero | Succ Nat
plus :: Nat -> Nat -> Nat
plus Zero n = n
plus (Succ m) n = Succ (plus m n)
|])
all attempts lead to the same errors:
The exact Name ‘t_a6fM’ is not in scope
Probable cause: you used a unique Template Haskell name (NameU),
perhaps via newName, but did not bind it
If that it, then -ddump-splices might be useful
The exact Name ‘t_a6fN’ is not in scope
Probable cause: you used a unique Template Haskell name (NameU),
perhaps via newName, but did not bind it
If that it, then -ddump-splices might be useful
I'm new to Template Haskell, so this could be a painfully obvious mistake, but can someone tell me what I'm doing wrong or point me in the right direction?
ddump splices output from ghc: http://lpaste.net/2641476385360576512
source to share
From the output, -ddump-splices
you can see that those names that are not in scope are limited forall
and then used in the body of the function. This is exactly what the extension has ScopedTypeVariables
.
eg. this is how it is used t_a4rL
:
sPlus ::
forall (t_a4rL :: Nat_a4rq) (t_a4rM :: Nat_a4rq).
Sing t_a4rL
-> Sing t_a4rM -> Sing (Apply (Apply PlusSym0 t_a4rL) t_a4rM)
sPlus SZero sN
= let
lambda_a4rN ::
forall n_a4rI. ((ghc-prim:GHC.Types.~) t_a4rL ZeroSym0,
(ghc-prim:GHC.Types.~) t_a4rM n_a4rI) =>
After skipping unnecessary parts:
sPlus :: forall (t_a4rL :: Nat_a4rq) ... . ->
sPlus SZero sN
= let lambda_a4rN :: t_a4rL ~ ZeroSym0 ...
Adding an extension ScopedTypeVariables
expands the scope t_a4rL
to the body of the function sPlus
.
source to share