diff --git a/Data/RepLib/Derive.hs b/Data/RepLib/Derive.hs --- a/Data/RepLib/Derive.hs +++ b/Data/RepLib/Derive.hs @@ -147,19 +147,21 @@ case info' of TyConI d -> do (name, param, ca, terms) <- typeInfo ((return d) :: Q Dec) + let paramNames = map tyVarBndrName param baseT <- conT name -- the type that we are defining, applied to its parameters. - let ty = foldl (\x p -> x `AppT` (VarT p)) baseT param + let ty = foldl (\x p -> x `AppT` (VarT p)) baseT paramNames -- the representations of the paramters, as a list -- representations of the data constructors rcons <- mapM (repcon (length terms == 1) ty) terms - body <- [| Data $(repDT name param) $(return (ListE rcons)) |] - let ctx = map (\p -> (ConT (mkName "Rep")) `AppT` (VarT p)) param + body <- [| Data $(repDT name paramNames) $(return (ListE rcons)) |] + let ctx = map (\p -> ClassP (mkName "Rep") [VarT p]) paramNames let rTypeName :: Name rTypeName = rName n rSig :: Dec - rSig = SigD rTypeName (ForallT param ctx ((ConT (mkName "R")) - `AppT` ty)) + rSig = SigD rTypeName (ForallT (map PlainTV paramNames) + ctx ((ConT (mkName "R")) + `AppT` ty)) rType :: Dec rType = ValD (VarP rTypeName) (NormalB body) [] let inst = InstanceD ctx ((ConT (mkName "Rep")) `AppT` ty) @@ -212,8 +214,9 @@ case info' of TyConI d -> do (name, param, ca, terms) <- typeInfo ((return d) :: Q Dec) + let paramNames = map tyVarBndrName param -- the type that we are defining, applied to its parameters. - let ty = foldl (\x p -> x `AppT` (VarT p)) (ConT name) param + let ty = foldl (\x p -> x `AppT` (VarT p)) (ConT name) paramNames let rTypeName = rName1 n ctx <- newName "ctx" @@ -224,13 +227,13 @@ let cparams = map (\(n,t,_) -> SigP (VarP n) t) ctxParams -- the recursive call of the rep function - let e1 = foldl (\a r -> a `AppE` (VarE r)) (VarE rTypeName) param + let e1 = foldl (\a r -> a `AppE` (VarE r)) (VarE rTypeName) paramNames let e2 = foldl (\a (n,_,_) -> a `AppE` (VarE n)) e1 ctxParams -- the representations of the parameters, as a list -- representations of the data constructors rcons <- mapM (repcon1 ty (length terms == 1) e2 ctxParams) terms - body <- [| Data1 $(repDT name param) + body <- [| Data1 $(repDT name paramNames) $(return (ListE rcons)) |] let rhs = LamE (cparams) body @@ -239,18 +242,18 @@ rTypeDecl = ValD (VarP rTypeName) (NormalB rhs) [] - let ctxRep = map (\p -> (ConT (mkName "Rep")) `AppT` (VarT p)) param - ctxRec = map (\(_,t,_) -> (ConT ''Sat) `AppT` t) ctxParams + let ctxRep = map (\p -> ClassP (mkName "Rep") [VarT p]) paramNames + ctxRec = map (\(_,t,_) -> ClassP ''Sat [t]) ctxParams -- appRep t = foldl (\a p -> a `AppE` (VarE 'rep)) t param appRec t = foldl (\a p -> a `AppE` (VarE 'dict)) t ctxParams let inst = InstanceD (ctxRep ++ ctxRec) ((ConT ''Rep1) `AppT` (VarT ctx) `AppT` ty) - [ValD (VarP (mkName "rep1")) + [ValD (VarP (mkName "rep1")) (NormalB (appRec (VarE rTypeName))) []] - let rSig = SigD rTypeName (ForallT (ctx : param) ctxRep + let rSig = SigD rTypeName (ForallT (map PlainTV (ctx : paramNames)) ctxRep (foldr (\(_,p,_) f -> (ArrowT `AppT` p `AppT` f)) ((ConT (mkName "R1")) `AppT` (VarT ctx) `AppT` ty) ctxParams)) @@ -277,7 +280,7 @@ --- from SYB III code.... -typeInfo :: DecQ -> Q (Name, [Name], [(Name, Int)], [(Name, [(Maybe Name, Type)])]) +typeInfo :: DecQ -> Q (Name, [TyVarBndr], [(Name, Int)], [(Name, [(Maybe Name, Type)])]) typeInfo m = do d <- m case d of @@ -318,3 +321,6 @@ _:t -> mkName t +tyVarBndrName :: TyVarBndr -> Name +tyVarBndrName (PlainTV n) = n +tyVarBndrName (KindedTV n _) = n diff --git a/Data/RepLib/Lib.hs b/Data/RepLib/Lib.hs --- a/Data/RepLib/Lib.hs +++ b/Data/RepLib/Lib.hs @@ -42,7 +42,7 @@ import Data.RepLib.R import Data.RepLib.R1 import Data.RepLib.RepAux -import Data.RepLib.PreludeReps +import Data.RepLib.PreludeReps() ------------------- Subtrees -------------------------- -- there is no point in using R1 for subtrees diff --git a/Data/RepLib/SYB/Schemes.hs b/Data/RepLib/SYB/Schemes.hs --- a/Data/RepLib/SYB/Schemes.hs +++ b/Data/RepLib/SYB/Schemes.hs @@ -44,7 +44,6 @@ import Data.RepLib.R import Data.RepLib.RepAux import Data.RepLib.SYB.Aliases -import Control.Monad -- | Apply a transformation everywhere in bottom-up manner diff --git a/Data/RepLib/Unify.hs b/Data/RepLib/Unify.hs --- a/Data/RepLib/Unify.hs +++ b/Data/RepLib/Unify.hs @@ -24,8 +24,7 @@ import Data.RepLib.R import Data.RepLib.R1 import Data.RepLib.RepAux -import Data.RepLib.PreludeReps -import Control.Monad +import Data.RepLib.PreludeReps() import Control.Monad.State import Control.Monad.Error diff --git a/RepLib.cabal b/RepLib.cabal --- a/RepLib.cabal +++ b/RepLib.cabal @@ -1,12 +1,13 @@ name: RepLib -version: 0.2.1 +version: 0.2.2 license: LGPL license-file: LICENSE build-type: Simple cabal-version: >= 1.2.3 -tested-with: GHC == 6.10.3, GHC == 6.8.3 +tested-with: GHC == 6.12.1 author: Stephanie Weirich -maintainer: Brent Yorgey +maintainer: Chris Casinghino + Brent Yorgey Stephanie Weirich homepage: http://www.cis.upenn.edu/~sweirich/RepLib category: Data @@ -16,8 +17,8 @@ polymorphism and other features. Library - build-depends: base >= 3.0 && < 4.2, haskell98 >= 1.0 && < 1.1, - template-haskell >= 2.2 && < 2.4, mtl >= 1.1 && < 1.2 + build-depends: base >= 4.2 && < 5, haskell98 >= 1.0 && < 1.1, + template-haskell >= 2.4 && < 2.5, mtl >= 1.1 && < 1.2 exposed-modules: Data.RepLib, Data.RepLib.R, @@ -30,5 +31,4 @@ Data.RepLib.SYB.Aliases, Data.RepLib.SYB.Schemes, Data.RepLib.Unify - if impl(ghc < 6.10) - extensions: PatternSignatures + extensions: GADTs