Hello community,
here is the log from the commit of package ghc-th-expand-syns for
openSUSE:Leap:15.2 checked in at 2020-05-21 12:58:12
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Leap:15.2/ghc-th-expand-syns (Old)
and /work/SRC/openSUSE:Leap:15.2/.ghc-th-expand-syns.new.2738 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-th-expand-syns"
Thu May 21 12:58:12 2020 rev:14 rq:802885 version:0.4.6.0
Changes:
--------
--- /work/SRC/openSUSE:Leap:15.2/ghc-th-expand-syns/ghc-th-expand-syns.changes
2020-02-19 18:41:40.586224602 +0100
+++
/work/SRC/openSUSE:Leap:15.2/.ghc-th-expand-syns.new.2738/ghc-th-expand-syns.changes
2020-05-21 12:58:13.474649388 +0200
@@ -1,0 +2,7 @@
+Wed Apr 1 12:37:14 UTC 2020 - psim...@suse.com
+
+- Update th-expand-syns to version 0.4.6.0.
+ Upstream has not updated the file "changelog.markdown" since the
+ last release.
+
+-------------------------------------------------------------------
Old:
----
th-expand-syns-0.4.5.0.tar.gz
New:
----
th-expand-syns-0.4.6.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-th-expand-syns.spec ++++++
--- /var/tmp/diff_new_pack.3dT33H/_old 2020-05-21 12:58:13.990650512 +0200
+++ /var/tmp/diff_new_pack.3dT33H/_new 2020-05-21 12:58:13.994650520 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-th-expand-syns
#
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 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 th-expand-syns
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.4.5.0
+Version: 0.4.6.0
Release: 0
Summary: Expands type synonyms in Template Haskell ASTs
License: BSD-3-Clause
++++++ th-expand-syns-0.4.5.0.tar.gz -> th-expand-syns-0.4.6.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/th-expand-syns-0.4.5.0/Language/Haskell/TH/ExpandSyns.hs
new/th-expand-syns-0.4.6.0/Language/Haskell/TH/ExpandSyns.hs
--- old/th-expand-syns-0.4.5.0/Language/Haskell/TH/ExpandSyns.hs
2019-08-29 21:54:34.000000000 +0200
+++ new/th-expand-syns-0.4.6.0/Language/Haskell/TH/ExpandSyns.hs
2001-09-09 03:46:40.000000000 +0200
@@ -206,6 +206,10 @@
go (ImplicitParamBindD {}) = no
#endif
+#if MIN_VERSION_template_haskell(2,16,0)
+ go (KiSigD {}) = no
+#endif
+
no = return Nothing
#if MIN_VERSION_template_haskell(2,4,0)
@@ -270,6 +274,12 @@
-- Must only be called on an `x' requiring no expansion
passThrough acc x = return (acc, x)
+ forallAppError :: [TypeArg] -> Type -> Q a
+ forallAppError acc x =
+ fail (packagename++": Unexpected application of the local
quantification: "
+ ++show x
+ ++"\n (to the arguments "++show acc++")")
+
-- If @go args t = (args', t')@,
--
-- Precondition:
@@ -290,10 +300,7 @@
t' <- expandSyns' t
return ([], ForallT ns cxt' t')
- go acc x@(ForallT _ _ _) =
- fail (packagename++": Unexpected application of the local
quantification: "
- ++show x
- ++"\n (to the arguments "++show acc++")")
+ go acc x@ForallT{} = forallAppError acc x
go acc (AppT t1 t2) =
do
@@ -311,7 +318,7 @@
else
let
substs = zip vars (filterTANormals acc)
- expanded = foldr subst body substs
+ expanded = doSubsts substs body
in
go (drop (length vars) acc) expanded
@@ -375,6 +382,14 @@
return (acc',ImplicitParamT n t')
#endif
+#if MIN_VERSION_template_haskell(2,16,0)
+ go [] (ForallVisT ns t) = do
+ t' <- expandSyns' t
+ return ([], ForallVisT ns t')
+
+ go acc x@ForallVisT{} = forallAppError acc x
+#endif
+
-- | An argument to a type, either a normal type ('TANormal') or a visible
-- kind application ('TyArg').
data TypeArg
@@ -389,7 +404,7 @@
instance SubstTypeVariable Type where
- subst (v, t) = go
+ subst vt@(v, t) = go
where
go (AppT x y) = AppT (go x) (go y)
go s@(ConT _) = s
@@ -398,12 +413,13 @@
go ArrowT = ArrowT
go ListT = ListT
go (ForallT vars cxt body) =
- commonForallCase (v,t) (vars,cxt,body)
+ commonForallCase vt vars $ \vts' vars' ->
+ ForallT vars' (map (doSubsts vts') cxt) (doSubsts vts' body)
go s@(TupleT _) = s
#if MIN_VERSION_template_haskell(2,4,0)
- go (SigT t1 kind) = SigT (go t1) (subst (v, t) kind)
+ go (SigT t1 kind) = SigT (go t1) (subst vt kind)
#endif
#if MIN_VERSION_template_haskell(2,6,0)
@@ -440,6 +456,12 @@
go (ImplicitParamT n ty) = ImplicitParamT n (go ty)
#endif
+#if MIN_VERSION_template_haskell(2,16,0)
+ go (ForallVisT vars body) =
+ commonForallCase vt vars $ \vts' vars' ->
+ ForallVisT vars' (doSubsts vts' body)
+#endif
+
-- testCapture :: Type
-- testCapture =
-- let
@@ -501,15 +523,16 @@
-- evade v (AppT (VarT v) (VarT (mkName "fx")))
instance SubstTypeVariable Con where
- subst (v,t) = go
+ subst vt = go
where
- st = subst (v,t)
+ st = subst vt
go (NormalC n ts) = NormalC n [(x, st y) | (x,y) <- ts]
go (RecC n ts) = RecC n [(x, y, st z) | (x,y,z) <- ts]
go (InfixC (y1,t1) op (y2,t2)) = InfixC (y1,st t1) op (y2,st t2)
go (ForallC vars cxt body) =
- commonForallCase (v,t) (vars,cxt,body)
+ commonForallCase vt vars $ \vts' vars' ->
+ ForallC vars' (map (doSubsts vts') cxt) (doSubsts vts' body)
#if MIN_VERSION_template_haskell(2,11,0)
go c@GadtC{} = errGadt c
go c@RecGadtC{} = errGadt c
@@ -529,16 +552,16 @@
-commonForallCase :: (SubstTypeVariable a, HasForallConstruct a) =>
-
- (Name,Type)
- -> ([TyVarBndr],Cxt,a)
+-- Apply a substitution to something underneath a @forall@. The continuation
+-- argument provides new substitutions and fresh type variable binders to avoid
+-- the outer substitution from capturing the thing underneath the @forall@.
+commonForallCase :: (Name, Type) -> [TyVarBndr]
+ -> ([(Name, Type)] -> [TyVarBndr] -> a)
-> a
-commonForallCase vt@(v,t) (bndrs,cxt,body)
-
+commonForallCase vt@(v,t) bndrs k
-- If a variable with the same name as the one to be replaced is
bound by the forall,
-- the variable to be replaced is shadowed in the body, so we
leave the whole thing alone (no recursion)
- | v `elem` (tyVarBndrGetName <$> bndrs) = mkForall bndrs cxt body
+ | v `elem` (tyVarBndrGetName <$> bndrs) = k [vt] bndrs
| otherwise =
let
@@ -547,16 +570,12 @@
freshes = evades vars t
freshTyVarBndrs = zipWith tyVarBndrSetName freshes bndrs
substs = zip vars (VarT <$> freshes)
- doSubsts :: SubstTypeVariable b => b -> b
- doSubsts x = foldr subst x substs
-
in
- mkForall
- freshTyVarBndrs
- (fmap (subst vt . doSubsts) cxt )
- ( (subst vt . doSubsts) body)
-
+ k (vt:substs) freshTyVarBndrs
+-- Apply multiple substitutions.
+doSubsts :: SubstTypeVariable a => [(Name, Type)] -> a -> a
+doSubsts substs x = foldr subst x substs
-- | Capture-free substitution
substInType :: (Name,Type) -> Type -> Type
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-expand-syns-0.4.5.0/th-expand-syns.cabal
new/th-expand-syns-0.4.6.0/th-expand-syns.cabal
--- old/th-expand-syns-0.4.5.0/th-expand-syns.cabal 2019-08-29
23:48:59.000000000 +0200
+++ new/th-expand-syns-0.4.6.0/th-expand-syns.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,5 +1,5 @@
name: th-expand-syns
-version: 0.4.5.0
+version: 0.4.6.0
synopsis: Expands type synonyms in Template Haskell ASTs
description: Expands type synonyms in Template Haskell ASTs.
category: Template Haskell
@@ -23,7 +23,7 @@
location: git://github.com/DanielSchuessler/th-expand-syns.git
Library
- build-depends: base >= 4 && < 5, template-haskell < 2.16, syb,
containers
+ build-depends: base >= 4 && < 5, template-haskell < 2.17, syb,
containers
ghc-options:
exposed-modules: Language.Haskell.TH.ExpandSyns
other-modules: Language.Haskell.TH.ExpandSyns.SemigroupCompat
