singletons 0.8 → 0.8.1
raw patch · 5 files changed
+28/−18 lines, 5 filesdep ~template-haskell
Dependency ranges changed: template-haskell
Files
- Singletons/Lib.hs +1/−0
- Singletons/Promote.hs +14/−10
- Singletons/Singletons.hs +9/−6
- Singletons/Util.hs +2/−0
- singletons.cabal +2/−2
Singletons/Lib.hs view
@@ -15,6 +15,7 @@ FlexibleContexts, RankNTypes, UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} module Singletons.Lib ( Any,
Singletons/Promote.hs view
@@ -172,8 +172,8 @@ newDecls' = foldl (\decls name -> filter (not . (containsName name)) decls) (concat newDecls) (noTypeSigs ++ noTypeSigsPro)- mapM_ (\n -> report False $ "No type binding for " ++ (show (nameBase n)) ++- "; removing all declarations including it")+ mapM_ (\n -> reportWarning $ "No type binding for " ++ (show (nameBase n)) +++ "; removing all declarations including it") noTypeSigs return (newDecls' ++ moreNewDecls, noTypeSigs) @@ -412,10 +412,10 @@ promoteTopLevelPat (ParensP _) = fail "Unresolved infix constructors not supported" promoteTopLevelPat (TildeP pat) = do- lift $ report False "Lazy pattern converted into regular pattern in promotion"+ lift $ reportWarning "Lazy pattern converted into regular pattern in promotion" promoteTopLevelPat pat promoteTopLevelPat (BangP pat) = do- lift $ report False "Strict pattern converted into regular pattern in promotion"+ lift $ reportWarning "Strict pattern converted into regular pattern in promotion" promoteTopLevelPat pat promoteTopLevelPat (AsP name pat) = fail "Promotion of aliased patterns at top level not yet supported"@@ -434,8 +434,8 @@ LHS raw nm (hole . (AppT headTyFam) . extractFn)) lhss)) id promotedPats promoteTopLevelPat (SigP pat _) = do- lift $ report False $ "Promotion of explicit type annotation in pattern " ++- "not yet supported."+ lift $ reportWarning $ "Promotion of explicit type annotation in pattern " +++ "not yet supported." promoteTopLevelPat pat promoteTopLevelPat (ViewP _ _) = fail "Promotion of view patterns not yet supported"@@ -464,10 +464,10 @@ promotePat (UInfixP _ _ _) = fail "Unresolved infix constructions not supported" promotePat (ParensP _) = fail "Unresolved infix constructions not supported" promotePat (TildeP pat) = do- lift $ report False "Lazy pattern converted into regular pattern in promotion"+ lift $ reportWarning "Lazy pattern converted into regular pattern in promotion" promotePat pat promotePat (BangP pat) = do- lift $ report False "Strict pattern converted into regular pattern in promotion"+ lift $ reportWarning "Strict pattern converted into regular pattern in promotion" promotePat pat promotePat (AsP name pat) = do ty <- promotePat pat@@ -481,8 +481,8 @@ types <- mapM promotePat pats return $ foldr (\h t -> AppT (AppT PromotedConsT h) t) PromotedNilT types promotePat (SigP pat _) = do- lift $ report False $ "Promotion of explicit type annotation in pattern " ++- "not yet supported"+ lift $ reportWarning $ "Promotion of explicit type annotation in pattern " +++ "not yet supported" promotePat pat promotePat (ViewP _ _) = fail "View patterns not yet supported" @@ -516,6 +516,8 @@ promoteExp vars (ParensE _) = fail "Promotion of unresolved parens not supported" promoteExp vars (LamE pats exp) = fail "Promotion of lambda expressions not yet supported"+promoteExp vars (LamCaseE alts) =+ fail "Promotion of lambda-case expressions not yet supported" promoteExp vars (TupE exps) = do tys <- mapM (promoteExp vars) exps let tuple = PromotedTupleT (length tys)@@ -525,6 +527,8 @@ promoteExp vars (CondE bexp texp fexp) = do tys <- mapM (promoteExp vars) [bexp, texp, fexp] return $ foldType ifTyFam tys+promoteExp vars (MultiIfE alts) =+ fail "Promotion of multi-way if not yet supported" promoteExp vars (LetE decs exp) = fail "Promotion of let statements not yet supported" promoteExp vars (CaseE exp matches) =
Singletons/Singletons.hs view
@@ -11,8 +11,7 @@ module Singletons.Singletons where -import Language.Haskell.TH.Lib-import Language.Haskell.TH.Syntax hiding (lift)+import Language.Haskell.TH import Singletons.Util import Singletons.Promote import qualified Data.Map as Map@@ -250,8 +249,8 @@ return [SigD (singValName name) (tyTrans (promoteVal name))] singDec (ForeignD fgn) = let name = extractName fgn in do- report False $ "Singling of foreign functions not supported -- " ++- (show name) ++ " ignored"+ reportWarning $ "Singling of foreign functions not supported -- " +++ (show name) ++ " ignored" return [] where extractName :: Foreign -> Name extractName (ImportF _ _ _ n _) = n@@ -261,8 +260,8 @@ | otherwise = return [InfixD fixity (singValName name)] singDec (PragmaD prag) = let name = extractName prag in do- report False $ "Singling of pragmas not supported -- " ++- (show name) ++ " ignored"+ reportWarning $ "Singling of pragmas not supported -- " +++ (show name) ++ " ignored" return [] where extractName :: Pragma -> Name extractName (InlineP n _) = n@@ -568,6 +567,8 @@ (pats', vartbl) <- evalForPair $ mapM (singPat Parameter) pats let vars' = Map.union vartbl vars -- order matters; union is left-biased singExp vars' exp+singExp vars (LamCaseE matches) = + fail "Singling of case expressions not yet supported" singExp vars (TupE exps) = do sExps <- mapM (singExp vars) exps sTuple <- singExp vars (ConE (tupleDataName (length exps)))@@ -577,6 +578,8 @@ singExp vars (CondE bexp texp fexp) = do exps <- mapM (singExp vars) [bexp, texp, fexp] return $ foldExp (VarE sIfName) exps+singExp vars (MultiIfE alts) =+ fail "Singling of multi-way if statements not yet supported" singExp vars (LetE decs exp) = fail "Singling of let expressions not yet supported" singExp vars (CaseE exp matches) =
Singletons/Util.hs view
@@ -7,6 +7,8 @@ Users of the package should not need to consult this file. -} +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+ module Singletons.Util where import Language.Haskell.TH
singletons.cabal view
@@ -1,5 +1,5 @@ name: singletons-version: 0.8+version: 0.8.1 cabal-version: >= 1.8 synopsis: A framework for generating singleton types homepage: http://www.cis.upenn.edu/~eir/packages/singletons@@ -28,7 +28,7 @@ build-depends: base >= 4 && < 5, mtl >= 2.1.1,- template-haskell,+ template-haskell >= 2.8, containers >= 0.5, syb >= 0.3 exposed-modules: Singletons.Lib, Singletons.CustomStar,