Hello community,

here is the log from the commit of package ghc-th-abstraction for 
openSUSE:Factory checked in at 2019-03-06 15:47:27
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-th-abstraction (Old)
 and      /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.28833 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "ghc-th-abstraction"

Wed Mar  6 15:47:27 2019 rev:6 rq:681688 version:0.2.11.0

Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-th-abstraction/ghc-th-abstraction.changes    
2018-12-28 12:35:29.643956260 +0100
+++ 
/work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.28833/ghc-th-abstraction.changes
 2019-03-06 15:47:29.196449234 +0100
@@ -1,0 +2,8 @@
+Wed Feb 27 03:02:53 UTC 2019 - [email protected]
+
+- Update th-abstraction to version 0.2.11.0.
+  ## 0.2.11.0 -- 2019-02-26
+  * Fix a bug in which `freeVariablesWellScoped` would sometimes not preserve
+    the left-to-right ordering of `Name`s generated with `newName`.
+
+-------------------------------------------------------------------

Old:
----
  th-abstraction-0.2.10.0.tar.gz

New:
----
  th-abstraction-0.2.11.0.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ ghc-th-abstraction.spec ++++++
--- /var/tmp/diff_new_pack.YZ4473/_old  2019-03-06 15:47:30.080449000 +0100
+++ /var/tmp/diff_new_pack.YZ4473/_new  2019-03-06 15:47:30.080449000 +0100
@@ -1,7 +1,7 @@
 #
 # spec file for package ghc-th-abstraction
 #
-# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2019 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-abstraction
 %bcond_with tests
 Name:           ghc-%{pkg_name}
-Version:        0.2.10.0
+Version:        0.2.11.0
 Release:        0
 Summary:        Nicer interface for reified information about data types
 License:        ISC

++++++ th-abstraction-0.2.10.0.tar.gz -> th-abstraction-0.2.11.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/th-abstraction-0.2.10.0/ChangeLog.md 
new/th-abstraction-0.2.11.0/ChangeLog.md
--- old/th-abstraction-0.2.10.0/ChangeLog.md    2001-09-09 03:46:40.000000000 
+0200
+++ new/th-abstraction-0.2.11.0/ChangeLog.md    2001-09-09 03:46:40.000000000 
+0200
@@ -1,5 +1,9 @@
 # Revision history for th-abstraction
 
+## 0.2.11.0 -- 2019-02-26
+* Fix a bug in which `freeVariablesWellScoped` would sometimes not preserve
+  the left-to-right ordering of `Name`s generated with `newName`.
+
 ## 0.2.10.0 -- 2018-12-20
 * Optimization: `quantifyType` now collapses consecutive `forall`s. For
   instance, calling `quantifyType` on `forall b. a -> b -> T a` now produces
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype.hs 
new/th-abstraction-0.2.11.0/src/Language/Haskell/TH/Datatype.hs
--- old/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype.hs     
2001-09-09 03:46:40.000000000 +0200
+++ new/th-abstraction-0.2.11.0/src/Language/Haskell/TH/Datatype.hs     
2001-09-09 03:46:40.000000000 +0200
@@ -119,11 +119,12 @@
 
 import           Data.Data (Typeable, Data)
 import           Data.Foldable (foldMap, foldl')
-import           Data.Graph
 import           Data.List (nub, find, union, (\\))
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe
+import qualified Data.Set as Set
+import           Data.Set (Set)
 import qualified Data.Traversable as T
 import           Control.Monad
 import           Language.Haskell.TH
@@ -1373,6 +1374,16 @@
 -- 'TyVarBndr's instead of 'Name's, since it must make it explicit that @k@
 -- is the kind of @a@.)
 --
+-- 'freeVariablesWellScoped' guarantees the free variables returned will be
+-- ordered such that:
+--
+-- 1. Whenever an explicit kind signature of the form @(A :: K)@ is
+--    encountered, the free variables of @K@ will always appear to the left of
+--    the free variables of @A@ in the returned result.
+--
+-- 2. The constraint in (1) notwithstanding, free variables will appear in
+--    left-to-right order of their original appearance.
+--
 -- On older GHCs, this takes measures to avoid returning explicitly bound
 -- kind variables, which was not possible before @TypeInType@.
 freeVariablesWellScoped :: [Type] -> [TyVarBndr]
@@ -1408,25 +1419,58 @@
           go_pred (EqualP t1 t2) = go_ty t1 `mappend` go_ty t2
 #endif
 
-      (g, gLookup, _)
-        = graphFromEdges [ (fv, fv, kindVars)
-                         | fv <- fvs
-                         , let kindVars =
-                                 case Map.lookup fv varKindSigs of
-                                   Nothing -> []
-                                   Just ks -> freeVariables ks
-                         ]
-      tg = reverse $ topSort g
-
-      lookupVertex x =
-        case gLookup x of
-          (n, _, _) -> n
-
-      ascribeWithKind n
-        | Just k <- Map.lookup n varKindSigs
-        = KindedTV n k
+      -- | Do a topological sort on a list of tyvars,
+      --   so that binders occur before occurrences
+      -- E.g. given  [ a::k, k::*, b::k ]
+      -- it'll return a well-scoped list [ k::*, a::k, b::k ]
+      --
+      -- This is a deterministic sorting operation
+      -- (that is, doesn't depend on Uniques).
+      --
+      -- It is also meant to be stable: that is, variables should not
+      -- be reordered unnecessarily.
+      scopedSort :: [Name] -> [Name]
+      scopedSort = go [] []
+
+      go :: [Name]     -- already sorted, in reverse order
+         -> [Set Name] -- each set contains all the variables which must be 
placed
+                       -- before the tv corresponding to the set; they are 
accumulations
+                       -- of the fvs in the sorted tvs' kinds
+
+                       -- This list is in 1-to-1 correspondence with the 
sorted tyvars
+                       -- INVARIANT:
+                       --   all (\tl -> all (`isSubsetOf` head tl) (tail tl)) 
(tails fv_list)
+                       -- That is, each set in the list is a superset of all 
later sets.
+         -> [Name]     -- yet to be sorted
+         -> [Name]
+      go acc _fv_list [] = reverse acc
+      go acc  fv_list (tv:tvs)
+        = go acc' fv_list' tvs
+        where
+          (acc', fv_list') = insert tv acc fv_list
+
+      insert :: Name       -- var to insert
+             -> [Name]     -- sorted list, in reverse order
+             -> [Set Name] -- list of fvs, as above
+             -> ([Name], [Set Name])   -- augmented lists
+      insert tv []     []         = ([tv], [kindFVSet tv])
+      insert tv (a:as) (fvs:fvss)
+        | tv `Set.member` fvs
+        , (as', fvss') <- insert tv as fvss
+        = (a:as', fvs `Set.union` fv_tv : fvss')
+
         | otherwise
-        = PlainTV n
+        = (tv:a:as, fvs `Set.union` fv_tv : fvs : fvss)
+        where
+          fv_tv = kindFVSet tv
+
+         -- lists not in correspondence
+      insert _ _ _ = error "scopedSort"
+
+      kindFVSet n =
+        maybe Set.empty (Set.fromList . freeVariables) (Map.lookup n 
varKindSigs)
+      ascribeWithKind n =
+        maybe (PlainTV n) (KindedTV n) (Map.lookup n varKindSigs)
 
       -- An annoying wrinkle: GHCs before 8.0 don't support explicitly
       -- quantifying kinds, so something like @forall k (a :: k)@ would be
@@ -1443,7 +1487,7 @@
 
   in map ascribeWithKind $
      filter (not . isKindBinderOnOldGHCs) $
-     map lookupVertex tg
+     scopedSort fvs
 
 -- | Substitute all of the free variables in a type with fresh ones
 freshenFreeVariables :: Type -> Q Type
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/th-abstraction-0.2.10.0/test/Main.hs 
new/th-abstraction-0.2.11.0/test/Main.hs
--- old/th-abstraction-0.2.10.0/test/Main.hs    2001-09-09 03:46:40.000000000 
+0200
+++ new/th-abstraction-0.2.11.0/test/Main.hs    2001-09-09 03:46:40.000000000 
+0200
@@ -87,6 +87,7 @@
 #endif
      regressionTest44
      t63Test
+     t70Test
 
 adt1Test :: IO ()
 adt1Test =
@@ -832,3 +833,27 @@
                         , "Actual:   " ++ pprint actual
                         ]
        [| return () |])
+
+t70Test :: IO ()
+t70Test =
+  $(do a <- newName "a"
+       b <- newName "b"
+       let [aVar, bVar] = map VarT    [a, b]
+           [aTvb, bTvb] = map PlainTV [a, b]
+       let fvsABExpected = [aTvb, bTvb]
+           fvsABActual   = freeVariablesWellScoped [aVar, bVar]
+
+           fvsBAExpected = [bTvb, aTvb]
+           fvsBAActual   = freeVariablesWellScoped [bVar, aVar]
+
+           check expected actual =
+             unless (expected == actual) $
+               fail $ "freeVariablesWellScoped does not preserve left-to-right 
order: "
+                   ++ unlines [ "Expected: " ++ pprint expected
+                              , "Actual:   " ++ pprint actual
+                              ]
+
+       check fvsABExpected fvsABActual
+       check fvsBAExpected fvsBAActual
+
+       [| return () |])
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/th-abstraction-0.2.10.0/th-abstraction.cabal 
new/th-abstraction-0.2.11.0/th-abstraction.cabal
--- old/th-abstraction-0.2.10.0/th-abstraction.cabal    2001-09-09 
03:46:40.000000000 +0200
+++ new/th-abstraction-0.2.11.0/th-abstraction.cabal    2001-09-09 
03:46:40.000000000 +0200
@@ -1,5 +1,5 @@
 name:                th-abstraction
-version:             0.2.10.0
+version:             0.2.11.0
 synopsis:            Nicer interface for reified information about data types
 description:         This package normalizes variations in the interface for
                      inspecting datatype information via Template Haskell


Reply via email to