Hello community, here is the log from the commit of package pointfree for openSUSE:Factory checked in at 2017-04-13 10:45:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/pointfree (Old) and /work/SRC/openSUSE:Factory/.pointfree.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "pointfree" Thu Apr 13 10:45:16 2017 rev:6 rq:485183 version:1.1.1.3 Changes: -------- --- /work/SRC/openSUSE:Factory/pointfree/pointfree.changes 2016-10-19 13:05:06.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.pointfree.new/pointfree.changes 2017-04-13 10:45:18.323430649 +0200 @@ -1,0 +2,12 @@ +Tue Mar 14 09:25:08 UTC 2017 - psimons@suse.com + +- Update to version 1.1.1.3 with cabal2obs. + +------------------------------------------------------------------- +Wed Feb 22 14:56:11 UTC 2017 - psimons@suse.com + +- Apply "update-dependencies-for-lts-8.patch" downloaded from + https://github.com/bmillwood/pointfree/pull/22.patch to fix + broken dependencies in LTS 8.x. + +------------------------------------------------------------------- Old: ---- pointfree-1.1.1.2.tar.gz New: ---- pointfree-1.1.1.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ pointfree.spec ++++++ --- /var/tmp/diff_new_pack.MTqeAE/_old 2017-04-13 10:45:19.031330540 +0200 +++ /var/tmp/diff_new_pack.MTqeAE/_new 2017-04-13 10:45:19.035329975 +0200 @@ -1,7 +1,7 @@ # # spec file for package pointfree # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name pointfree %bcond_with tests Name: %{pkg_name} -Version: 1.1.1.2 +Version: 1.1.1.3 Release: 0 Summary: Tool for refactoring expressions into pointfree form License: MIT ++++++ pointfree-1.1.1.2.tar.gz -> pointfree-1.1.1.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/ChangeLog new/pointfree-1.1.1.3/ChangeLog --- old/pointfree-1.1.1.2/ChangeLog 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/ChangeLog 2017-03-11 18:07:19.000000000 +0100 @@ -1,3 +1,7 @@ +v1.1.1.3: +* Dependency update for HSE 1.19, HUnit 1.5 (thanks Nikolay Amiantov) +* Fix bug due to incautious naming of temporary variables (thanks Jack Fransham) + v1.1.1.2: * Dependency update for base 4.9, QuickCheck 2.9 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/Plugin/Pl/Common.hs new/pointfree-1.1.1.3/Plugin/Pl/Common.hs --- old/pointfree-1.1.1.2/Plugin/Pl/Common.hs 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/Plugin/Pl/Common.hs 2017-03-11 18:07:19.000000000 +0100 @@ -105,35 +105,35 @@ minPrec = 0 -- operator precedences are needed both for parsing and prettyprinting -operators :: [[(String, (Assoc, Int))]] +operators :: [[(String, (Assoc (), Int))]] operators = (map . map . second . second $ (+shift)) - [[inf "." AssocRight 9, inf "!!" AssocLeft 9], - [inf name AssocRight 8 | name <- ["^", "^^", "**"]], - [inf name AssocLeft 7 + [[inf "." (AssocRight ()) 9, inf "!!" (AssocLeft ()) 9], + [inf name (AssocRight ()) 8 | name <- ["^", "^^", "**"]], + [inf name (AssocLeft ()) 7 | name <- ["*", "/", "`quot`", "`rem`", "`div`", "`mod`", ":%", "%"]], - [inf name AssocLeft 6 | name <- ["+", "-"]], - [inf name AssocRight 5 | name <- [":", "++"]], - [inf name AssocNone 4 + [inf name (AssocLeft ()) 6 | name <- ["+", "-"]], + [inf name (AssocRight ()) 5 | name <- [":", "++"]], + [inf name (AssocNone ()) 4 | name <- ["==", "/=", "<", "<=", ">=", ">", "`elem`", "`notElem`"]], - [inf "&&" AssocRight 3], - [inf "||" AssocRight 2], - [inf ">>" AssocLeft 1, inf ">>=" AssocLeft 1, inf "=<<" AssocRight 1], - [inf name AssocRight 0 | name <- ["$", "$!", "`seq`"]] + [inf "&&" (AssocRight ()) 3], + [inf "||" (AssocRight ()) 2], + [inf ">>" (AssocLeft ()) 1, inf ">>=" (AssocLeft ()) 1, inf "=<<" (AssocRight ()) 1], + [inf name (AssocRight ()) 0 | name <- ["$", "$!", "`seq`"]] ] where inf name assoc fx = (name, (assoc, fx)) reservedOps :: [String] reservedOps = ["->", "..", "="] -opFM :: M.Map String (Assoc, Int) +opFM :: M.Map String (Assoc (), Int) opFM = (M.fromList $ concat operators) -lookupOp :: String -> Maybe (Assoc, Int) +lookupOp :: String -> Maybe (Assoc (), Int) lookupOp k = M.lookup k opFM -lookupFix :: String -> (Assoc, Int) +lookupFix :: String -> (Assoc (), Int) lookupFix str = case lookupOp $ str of - Nothing -> (AssocLeft, 9 + shift) + Nothing -> ((AssocLeft ()), 9 + shift) Just x -> x readM :: (Monad m, Read a) => String -> m a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/Plugin/Pl/Parser.hs new/pointfree-1.1.1.3/Plugin/Pl/Parser.hs --- old/pointfree-1.1.1.2/Plugin/Pl/Parser.hs 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/Plugin/Pl/Parser.hs 2017-03-11 18:07:19.000000000 +0100 @@ -4,83 +4,83 @@ import qualified Language.Haskell.Exts as HSE -todo :: (Show e) => e -> a -todo thing = error ("pointfree: not supported: " ++ show thing) +todo :: (Functor e, Show (e ())) => e a -> r +todo thing = error ("pointfree: not supported: " ++ show (fmap (const ()) thing)) -nameString :: HSE.Name -> (Fixity, String) -nameString (HSE.Ident s) = (Pref, s) -nameString (HSE.Symbol s) = (Inf, s) - -qnameString :: HSE.QName -> (Fixity, String) -qnameString (HSE.Qual m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n) -qnameString (HSE.UnQual n) = nameString n -qnameString (HSE.Special sc) = case sc of - HSE.UnitCon -> (Pref, "()") - HSE.ListCon -> (Pref, "[]") - HSE.FunCon -> (Inf, "->") - HSE.TupleCon HSE.Boxed n -> (Inf, replicate (n-1) ',') +nameString :: HSE.Name a -> (Fixity, String) +nameString (HSE.Ident _ s) = (Pref, s) +nameString (HSE.Symbol _ s) = (Inf, s) + +qnameString :: HSE.QName a -> (Fixity, String) +qnameString (HSE.Qual _ m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n) +qnameString (HSE.UnQual _ n) = nameString n +qnameString (HSE.Special _ sc) = case sc of + HSE.UnitCon _ -> (Pref, "()") + HSE.ListCon _ -> (Pref, "[]") + HSE.FunCon _ -> (Inf, "->") + HSE.TupleCon _ HSE.Boxed n -> (Inf, replicate (n-1) ',') HSE.TupleCon{} -> todo sc - HSE.Cons -> (Inf, ":") - HSE.UnboxedSingleCon -> todo sc + HSE.Cons _ -> (Inf, ":") + HSE.UnboxedSingleCon{} -> todo sc -opString :: HSE.QOp -> (Fixity, String) -opString (HSE.QVarOp qn) = qnameString qn -opString (HSE.QConOp qn) = qnameString qn +opString :: HSE.QOp a -> (Fixity, String) +opString (HSE.QVarOp _ qn) = qnameString qn +opString (HSE.QConOp _ qn) = qnameString qn list :: [Expr] -> Expr list = foldr (\y ys -> cons `App` y `App` ys) nil -hseToExpr :: HSE.Exp -> Expr +hseToExpr :: HSE.Exp a -> Expr hseToExpr expr = case expr of - HSE.Var qn -> uncurry Var (qnameString qn) + HSE.Var _ qn -> uncurry Var (qnameString qn) HSE.IPVar{} -> todo expr - HSE.Con qn -> uncurry Var (qnameString qn) - HSE.Lit l -> case l of - HSE.String s -> list (map (Var Pref . show) s) + HSE.Con _ qn -> uncurry Var (qnameString qn) + HSE.Lit _ l -> case l of + HSE.String _ _ s -> list (map (Var Pref . show) s) _ -> Var Pref (HSE.prettyPrint l) - HSE.InfixApp p op q -> apps (Var Inf (snd (opString op))) [p,q] - HSE.App f x -> hseToExpr f `App` hseToExpr x - HSE.NegApp e -> Var Pref "negate" `App` hseToExpr e + HSE.InfixApp _ p op q -> apps (Var Inf (snd (opString op))) [p,q] + HSE.App _ f x -> hseToExpr f `App` hseToExpr x + HSE.NegApp _ e -> Var Pref "negate" `App` hseToExpr e HSE.Lambda _ ps e -> foldr (Lambda . hseToPattern) (hseToExpr e) ps - HSE.Let bs e -> case bs of - HSE.BDecls ds -> Let (map hseToDecl ds) (hseToExpr e) - HSE.IPBinds ips -> todo ips - HSE.If b t f -> apps if' [b,t,f] + HSE.Let _ bs e -> case bs of + HSE.BDecls _ ds -> Let (map hseToDecl ds) (hseToExpr e) + HSE.IPBinds _ ips -> todo ips + HSE.If _ b t f -> apps if' [b,t,f] HSE.Case{} -> todo expr HSE.Do{} -> todo expr HSE.MDo{} -> todo expr - HSE.Tuple HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ',')) es + HSE.Tuple _ HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ',')) es HSE.TupleSection{} -> todo expr - HSE.List xs -> list (map hseToExpr xs) - HSE.Paren e -> hseToExpr e - HSE.LeftSection l op -> Var Inf (snd (opString op)) `App` hseToExpr l - HSE.RightSection op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r + HSE.List _ xs -> list (map hseToExpr xs) + HSE.Paren _ e -> hseToExpr e + HSE.LeftSection _ l op -> Var Inf (snd (opString op)) `App` hseToExpr l + HSE.RightSection _ op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r HSE.RecConstr{} -> todo expr HSE.RecUpdate{} -> todo expr - HSE.EnumFrom x -> apps (Var Pref "enumFrom") [x] - HSE.EnumFromTo x y -> apps (Var Pref "enumFromTo") [x,y] - HSE.EnumFromThen x y -> apps (Var Pref "enumFromThen") [x,y] - HSE.EnumFromThenTo x y z -> apps (Var Pref "enumFromThenTo") [x,y,z] + HSE.EnumFrom _ x -> apps (Var Pref "enumFrom") [x] + HSE.EnumFromTo _ x y -> apps (Var Pref "enumFromTo") [x,y] + HSE.EnumFromThen _ x y -> apps (Var Pref "enumFromThen") [x,y] + HSE.EnumFromThenTo _ x y z -> apps (Var Pref "enumFromThenTo") [x,y,z] _ -> todo expr -apps :: Expr -> [HSE.Exp] -> Expr +apps :: Expr -> [HSE.Exp a] -> Expr apps f xs = foldl (\a x -> a `App` hseToExpr x) f xs -hseToDecl :: HSE.Decl -> Decl +hseToDecl :: HSE.Decl a -> Decl hseToDecl dec = case dec of - HSE.PatBind _ (HSE.PVar n) (HSE.UnGuardedRhs e) Nothing -> + HSE.PatBind _ (HSE.PVar _ n) (HSE.UnGuardedRhs _ e) Nothing -> Define (snd (nameString n)) (hseToExpr e) - HSE.FunBind [HSE.Match _ n ps Nothing (HSE.UnGuardedRhs e) Nothing] -> + HSE.FunBind _ [HSE.Match _ n ps (HSE.UnGuardedRhs _ e) Nothing] -> Define (snd (nameString n)) (foldr (\p x -> Lambda (hseToPattern p) x) (hseToExpr e) ps) _ -> todo dec -hseToPattern :: HSE.Pat -> Pattern +hseToPattern :: HSE.Pat a -> Pattern hseToPattern pat = case pat of - HSE.PVar n -> PVar (snd (nameString n)) - HSE.PInfixApp l (HSE.Special HSE.Cons) r -> PCons (hseToPattern l) (hseToPattern r) - HSE.PTuple HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q) - HSE.PParen p -> hseToPattern p - HSE.PWildCard -> PVar "_" + HSE.PVar _ n -> PVar (snd (nameString n)) + HSE.PInfixApp _ l (HSE.Special _ (HSE.Cons _)) r -> PCons (hseToPattern l) (hseToPattern r) + HSE.PTuple _ HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q) + HSE.PParen _ p -> hseToPattern p + HSE.PWildCard _ -> PVar "_" _ -> todo pat parsePF :: String -> Either String TopLevel diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/Plugin/Pl/PrettyPrinter.hs new/pointfree-1.1.1.3/Plugin/Pl/PrettyPrinter.hs --- old/pointfree-1.1.1.2/Plugin/Pl/PrettyPrinter.hs 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/Plugin/Pl/PrettyPrinter.hs 2017-03-11 18:07:19.000000000 +0100 @@ -107,13 +107,13 @@ showsPrec f2 e2 where fixity = snd $ lookupFix fx (f1, f2) = case fst $ lookupFix fx of - AssocRight -> (fixity+1, fixity + infixSafe e2 AssocLeft fixity) - AssocLeft -> (fixity + infixSafe e1 AssocRight fixity, fixity+1) - AssocNone -> (fixity+1, fixity+1) + AssocRight _ -> (fixity+1, fixity + infixSafe e2 (AssocLeft ()) fixity) + AssocLeft _ -> (fixity + infixSafe e1 (AssocRight ()) fixity, fixity+1) + AssocNone _ -> (fixity+1, fixity+1) -- This is a little bit awkward, but at least seems to produce no false -- results anymore - infixSafe :: SExpr -> Assoc -> Int -> Int + infixSafe :: SExpr -> Assoc () -> Int -> Int infixSafe (SInfix fx'' _ _) assoc fx' | lookupFix fx'' == (assoc, fx') = 1 | otherwise = 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/Plugin/Pl/Transform.hs new/pointfree-1.1.1.3/Plugin/Pl/Transform.hs --- old/pointfree-1.1.1.2/Plugin/Pl/Transform.hs 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/Plugin/Pl/Transform.hs 2017-03-11 18:07:19.000000000 +0100 @@ -89,32 +89,68 @@ transform :: Expr -> Expr transform = transform' . alphaRename . unLet +-- Infinite generator of variable names. +varNames :: [String] +varNames = concatMap (flip replicateM usableChars) [1..] + where + usableChars = ['a'..'z'] + +-- First variable name not already in use +fresh :: [String] -> String +fresh variables = head . filter (not . flip elem variables) $ varNames + +names :: Expr -> [String] +names (Var _ str) = [str] +-- Lambda pattern names are rewritten to be meaningless/unwritable, so we don't +-- need to include them here. Variables from lambdas used in expressions are +-- also rewritten, but there's no reason to special-case it unless it's provably +-- poor-performing to scan over the result in `fresh`, which I doubt it is. +names (Lambda _ exp) = names exp +names (App exp1 exp2) = names exp1 ++ names exp2 +names (Let dlcs exp) = concatMap dnames dlcs ++ names exp + where + dnames (Define nm exp) = nm : names exp + transform' :: Expr -> Expr -transform' (Let {}) = assert False bt -transform' (Var f v) = Var f v -transform' (App e1 e2) = App (transform' e1) (transform' e2) -transform' (Lambda (PTuple p1 p2) e) - = transform' $ Lambda (PVar "z") $ - (Lambda p1 $ Lambda p2 $ e) `App` f `App` s where - f = Var Pref "fst" `App` Var Pref "z" - s = Var Pref "snd" `App` Var Pref "z" -transform' (Lambda (PCons p1 p2) e) - = transform' $ Lambda (PVar "z") $ - (Lambda p1 $ Lambda p2 $ e) `App` f `App` s where - f = Var Pref "head" `App` Var Pref "z" - s = Var Pref "tail" `App` Var Pref "z" -transform' (Lambda (PVar v) e) = transform' $ getRidOfV e where - getRidOfV (Var f v') | v == v' = id' - | otherwise = const' `App` Var f v' - getRidOfV l@(Lambda pat _) = assert (not $ v `occursP` pat) $ - getRidOfV $ transform' l - getRidOfV (Let {}) = assert False bt - getRidOfV e'@(App e1 e2) - | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2 - | fr1 = flip' `App` getRidOfV e1 `App` e2 - | Var _ v' <- e2, v' == v = e1 - | fr2 = comp `App` e1 `App` getRidOfV e2 - | True = const' `App` e' - where - fr1 = v `isFreeIn` e1 - fr2 = v `isFreeIn` e2 +transform' exp = go exp + where + -- Explicit sharing for readability + vars = names exp + + go (Let {}) = + assert False bt + go (Var f v) = + Var f v + go (App e1 e2) = + App (go e1) (go e2) + go (Lambda (PTuple p1 p2) e) = + go $ + Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s + where + var = fresh vars + f = Var Pref "fst" `App` Var Pref var + s = Var Pref "snd" `App` Var Pref var + go (Lambda (PCons p1 p2) e) = + go $ + Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s + where + var = fresh vars + f = Var Pref "head" `App` Var Pref var + s = Var Pref "tail" `App` Var Pref var + go (Lambda (PVar v) e) = + go $ getRidOfV e + where + getRidOfV (Var f v') | v == v' = id' + | otherwise = const' `App` Var f v' + getRidOfV l@(Lambda pat _) = + assert (not $ v `occursP` pat) $ getRidOfV $ go l + getRidOfV (Let {}) = assert False bt + getRidOfV e'@(App e1 e2) + | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2 + | fr1 = flip' `App` getRidOfV e1 `App` e2 + | Var _ v' <- e2, v' == v = e1 + | fr2 = comp `App` e1 `App` getRidOfV e2 + | True = const' `App` e' + where + fr1 = v `isFreeIn` e1 + fr2 = v `isFreeIn` e2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/pointfree.cabal new/pointfree-1.1.1.3/pointfree.cabal --- old/pointfree-1.1.1.2/pointfree.cabal 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/pointfree.cabal 2017-03-11 18:07:19.000000000 +0100 @@ -1,7 +1,7 @@ Cabal-Version: >= 1.8 Name: pointfree -Version: 1.1.1.2 +Version: 1.1.1.3 Category: Tool Synopsis: Tool for refactoring expressions into pointfree form @@ -29,7 +29,7 @@ Build-depends: base >= 4.5 && < 4.10, array >= 0.3 && < 0.6, containers >= 0.4 && < 0.6, - haskell-src-exts == 1.17.*, + haskell-src-exts >= 1.18 && < 1.20, transformers < 0.6 Other-modules: Plugin.Pl.Common Plugin.Pl.Parser @@ -45,7 +45,7 @@ Build-depends: base >= 4.3 && < 4.10, array >= 0.3 && < 0.6, containers >= 0.4 && < 0.6, - haskell-src-exts == 1.17.*, + haskell-src-exts >= 1.18 && < 1.20, transformers < 0.6 Other-modules: Plugin.Pl.Common Plugin.Pl.Parser @@ -64,8 +64,8 @@ array >= 0.3 && < 0.6, base < 5, containers >= 0.3 && < 0.6, - haskell-src-exts == 1.17.*, - HUnit >= 1.1 && < 1.4, + haskell-src-exts >= 1.18 && < 1.20, + HUnit >= 1.1 && < 1.6, QuickCheck >= 2.1 && < 2.10, transformers < 0.6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pointfree-1.1.1.2/test/Test.hs new/pointfree-1.1.1.3/test/Test.hs --- old/pointfree-1.1.1.2/test/Test.hs 2016-08-31 18:54:54.000000000 +0200 +++ new/pointfree-1.1.1.3/test/Test.hs 2017-03-11 18:07:19.000000000 +0100 @@ -186,7 +186,9 @@ unitTest "let x = const 3 y; y = const 4 x in x + y" ["7"], -- yay! unitTest "(\\n -> (return 0) ± (return $ sqrt n))" ["(return 0 ±) . return . sqrt"], unitTest "\\b -> (\\c -> ((Control.Monad.>>=) c) (\\g -> Control.Applicative.pure (b g)))" - ["flip (Control.Monad.>>=) . (Control.Applicative.pure .)"] + ["flip (Control.Monad.>>=) . (Control.Applicative.pure .)"], + unitTest "\\(x, y) -> z" ["const z"], + unitTest "\\(x, y) -> a" ["const a"] ] main :: IO ()