diff --git a/patches/fgl-5.8.0.0.patch b/patches/fgl-5.8.0.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..22381a0d4e689c645dbe2341486029d4a151b7af --- /dev/null +++ b/patches/fgl-5.8.0.0.patch @@ -0,0 +1,42 @@ +diff --git a/Data/Graph/Inductive/PatriciaTree.hs b/Data/Graph/Inductive/PatriciaTree.hs +index 20c9dae..cc44ef2 100644 +--- a/Data/Graph/Inductive/PatriciaTree.hs ++++ b/Data/Graph/Inductive/PatriciaTree.hs +@@ -1,6 +1,7 @@ + {-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} + #if __GLASGOW_HASKELL__ >= 702 + {-# LANGUAGE DeriveGeneric #-} ++{-# LANGUAGE DeriveFunctor #-} + #endif + + -- |An efficient implementation of 'Data.Graph.Inductive.Graph.Graph' +@@ -60,7 +61,7 @@ import Control.Arrow (second) + + newtype Gr a b = Gr (GraphRep a b) + #if __GLASGOW_HASKELL__ >= 702 +- deriving (Generic) ++ deriving (Generic, Functor) + #endif + + type GraphRep a b = IntMap (Context' a b) +diff --git a/Data/Graph/Inductive/Tree.hs b/Data/Graph/Inductive/Tree.hs +index f8f9087..88e275e 100644 +--- a/Data/Graph/Inductive/Tree.hs ++++ b/Data/Graph/Inductive/Tree.hs +@@ -1,6 +1,7 @@ + {-# LANGUAGE CPP #-} + #if __GLASGOW_HASKELL__ >= 702 + {-# LANGUAGE DeriveGeneric #-} ++{-# LANGUAGE DeriveFunctor #-} + #endif + + -- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT] +@@ -39,7 +40,7 @@ import Control.Arrow (first, second) + + newtype Gr a b = Gr (GraphRep a b) + #if __GLASGOW_HASKELL__ >= 702 +- deriving (Generic) ++ deriving (Generic, Functor) + #endif + + type GraphRep a b = Map Node (Context' a b) diff --git a/patches/futhark-0.22.3.patch b/patches/futhark-0.22.3.patch index 1956808af9d49dc285f4c8a47b97607640c90b78..94571dfce08597aa1411eca7fb8cadb586464d42 100644 --- a/patches/futhark-0.22.3.patch +++ b/patches/futhark-0.22.3.patch @@ -33,6 +33,25 @@ index b497fb0..706aa5f 100644 { mapOnBody = const $ pure . replaceArrayOps substs, mapOnOp = pure . onOp } +diff --git a/src/Futhark/IR/Syntax/Core.hs b/src/Futhark/IR/Syntax/Core.hs +index b1cab74..0960106 100644 +--- a/src/Futhark/IR/Syntax/Core.hs ++++ b/src/Futhark/IR/Syntax/Core.hs +@@ -1,4 +1,5 @@ + {-# LANGUAGE Strict #-} ++{-# LANGUAGE DeriveFunctor #-} + + -- | The most primitive ("core") aspects of the AST. Split out of + -- "Futhark.IR.Syntax" in order for +@@ -238,7 +239,7 @@ data TypeBase shape u + Acc VName Shape [Type] u + | Array PrimType shape u + | Mem Space +- deriving (Show, Eq, Ord) ++ deriving (Show, Eq, Ord, Functor) + + instance Bitraversable TypeBase where + bitraverse f g (Array t shape u) = Array t <$> f shape <*> g u diff --git a/src/Futhark/Optimise/CSE.hs b/src/Futhark/Optimise/CSE.hs index 397728a..b4a00ad 100644 --- a/src/Futhark/Optimise/CSE.hs @@ -322,3 +341,40 @@ index 02b47c4..c0d1043 100644 { mapOnBody = const (onBody ctx), mapOnOp = onOp ctx } +diff --git a/src/Language/Futhark/Syntax.hs b/src/Language/Futhark/Syntax.hs +index 8f8558a..d5ac7a8 100644 +--- a/src/Language/Futhark/Syntax.hs ++++ b/src/Language/Futhark/Syntax.hs +@@ -1,4 +1,5 @@ + {-# LANGUAGE Strict #-} ++{-# LANGUAGE DeriveFunctor #-} + + -- | The Futhark source language AST definition. Many types, such as + -- 'ExpBase', are parametrised by type and name representation. +@@ -277,7 +278,7 @@ data RetTypeBase dim as = RetType + { retDims :: [VName], + retType :: TypeBase dim as + } +- deriving (Eq, Ord, Show) ++ deriving (Eq, Ord, Show, Functor) + + instance Bitraversable RetTypeBase where + bitraverse f g (RetType dims t) = RetType dims <$> bitraverse f g t +@@ -299,7 +300,7 @@ data ScalarTypeBase dim as + | -- | The aliasing corresponds to the lexical + -- closure of the function. + Arrow as PName (TypeBase dim ()) (RetTypeBase dim as) +- deriving (Eq, Ord, Show) ++ deriving (Eq, Ord, Show, Functor) + + instance Bitraversable ScalarTypeBase where + bitraverse _ _ (Prim t) = pure $ Prim t +@@ -324,7 +325,7 @@ instance Bifoldable ScalarTypeBase where + data TypeBase dim as + = Scalar (ScalarTypeBase dim as) + | Array as Uniqueness (Shape dim) (ScalarTypeBase dim ()) +- deriving (Eq, Ord, Show) ++ deriving (Eq, Ord, Show, Functor) + + instance Bitraversable TypeBase where + bitraverse f g (Scalar t) = Scalar <$> bitraverse f g t diff --git a/patches/hgeometry-0.14.patch b/patches/hgeometry-0.14.patch index ba3e32deef314cef7fda665ce6f84f581b47812e..807309915f9c6976072845e331ff413c4c52b690 100644 --- a/patches/hgeometry-0.14.patch +++ b/patches/hgeometry-0.14.patch @@ -1,3 +1,55 @@ +diff --git a/src/Data/Geometry/Box/Internal.hs b/src/Data/Geometry/Box/Internal.hs +index 3c9cb45..5c4ebe5 100644 +--- a/src/Data/Geometry/Box/Internal.hs ++++ b/src/Data/Geometry/Box/Internal.hs +@@ -117,6 +117,9 @@ instance (Ord r, Arity d) => Box d p r `IsIntersectableWith` Box d q r where + f = maybe (coRec NoIntersection) (coRec . fromExtent) + r `intersect'` s = asA @(R.Range r) $ r `intersect` s + ++instance Arity d => (Functor (Box d p)) where ++ fmap = bimap id ++ + instance Arity d => Bifunctor (Box d) where + bimap = bimapDefault + instance Arity d => Bifoldable (Box d) where +diff --git a/src/Data/Geometry/PrioritySearchTree.hs b/src/Data/Geometry/PrioritySearchTree.hs +index 326696a..c6e6ae0 100644 +--- a/src/Data/Geometry/PrioritySearchTree.hs ++++ b/src/Data/Geometry/PrioritySearchTree.hs +@@ -40,6 +40,9 @@ data NodeData p r = NodeData { _splitPoint :: !r + , _maxVal :: !(Maybe (Point 2 r :+ p)) + } deriving (Show,Eq) + ++instance Functor (NodeData p) where ++ fmap = bimap id ++ + instance Bifunctor NodeData where + bimap f g (NodeData x m) = NodeData (g x) (bimap (fmap g) f <$> m) + +@@ -57,6 +60,9 @@ newtype PrioritySearchTree p r = + PrioritySearchTree { _unPrioritySearchTree :: BinLeafTree (NodeData p r) (LeafData p r) } + deriving (Show,Eq) + ++instance Functor (PrioritySearchTree p) where ++ fmap = bimap id ++ + instance Bifunctor PrioritySearchTree where + -- ^ note that this is not necessarily safe, as mapping over r can + -- invalidate the invariants. Users are responsible for making sure +diff --git a/src/Data/Geometry/QuadTree/Tree.hs b/src/Data/Geometry/QuadTree/Tree.hs +index fb004d5..3ab4ad1 100644 +--- a/src/Data/Geometry/QuadTree/Tree.hs ++++ b/src/Data/Geometry/QuadTree/Tree.hs +@@ -39,6 +39,9 @@ data Tree v p = Leaf !p + deriving (Show,Eq) + makePrisms ''Tree + ++instance Functor (Tree v) where ++ fmap = bimap id ++ + instance Bifunctor Tree where + bimap = bimapDefault + diff --git a/src/Data/Geometry/RangeTree.hs b/src/Data/Geometry/RangeTree.hs index 1aea06f..586bd17 100644 --- a/src/Data/Geometry/RangeTree.hs @@ -8,3 +60,16 @@ index 1aea06f..586bd17 100644 -------------------------------------------------------------------------------- -- | -- Module : Data.Geometry.RangeTree +diff --git a/src/Data/Geometry/Triangle.hs b/src/Data/Geometry/Triangle.hs +index b105de0..ac2be20 100644 +--- a/src/Data/Geometry/Triangle.hs ++++ b/src/Data/Geometry/Triangle.hs +@@ -43,6 +43,8 @@ deriving instance (Arity d, Eq r, Eq p) => Eq (Triangle d p r) + + instance (Arity d, NFData r, NFData p) => NFData (Triangle d p r) + ++instance Arity d => Functor (Triangle d p) where fmap = bimap id ++ + instance Arity d => Bifunctor (Triangle d) where bimap = bimapDefault + instance Arity d => Bifoldable (Triangle d) where bifoldMap = bifoldMapDefault + diff --git a/patches/hgeometry-combinatorial-0.14.patch b/patches/hgeometry-combinatorial-0.14.patch index 4ea1a3c52ede77e620617c3a99135f4c3a85d9bb..7b062dc617771ef0f31756db2924e59fe99132c9 100644 --- a/patches/hgeometry-combinatorial-0.14.patch +++ b/patches/hgeometry-combinatorial-0.14.patch @@ -1,5 +1,25 @@ +diff --git a/src/Data/Ext.hs b/src/Data/Ext.hs +index 70cb47be..babdd449 100644 +--- a/src/Data/Ext.hs ++++ b/src/Data/Ext.hs +@@ -1,5 +1,6 @@ + {-# LANGUAGE DeriveAnyClass #-} + {-# LANGUAGE OverloadedStrings #-} ++{-# LANGUAGE DeriveFunctor #-} + -------------------------------------------------------------------------------- + -- | + -- Module : Data.Ext +@@ -32,7 +33,7 @@ import Test.QuickCheck + + -- | Our Ext type that represents the core datatype core extended with extra + -- information of type 'extra'. +-data core :+ extra = core :+ extra deriving (Show,Read,Eq,Ord,Bounded,Generic,NFData) ++data core :+ extra = core :+ extra deriving (Show,Read,Eq,Ord,Bounded,Generic,NFData, Functor) + infixr 1 :+ + + diff --git a/src/Data/LSeq.hs b/src/Data/LSeq.hs -index 1912cb2..3ca750e 100644 +index 1912cb2d..3ca750e4 100644 --- a/src/Data/LSeq.hs +++ b/src/Data/LSeq.hs @@ -1,5 +1,6 @@ @@ -27,8 +47,54 @@ index 1912cb2..3ca750e 100644 deriving instance Show a => Show (ViewR n a) instance Functor (ViewR n) where +diff --git a/src/Data/List/Alternating.hs b/src/Data/List/Alternating.hs +index 84dbd6ce..ab042051 100644 +--- a/src/Data/List/Alternating.hs ++++ b/src/Data/List/Alternating.hs +@@ -1,3 +1,4 @@ ++{-# LANGUAGE DeriveFunctor #-} + -------------------------------------------------------------------------------- + -- | + -- Module : Data.List.Alternating +@@ -25,6 +26,9 @@ import qualified Data.List as List + -- | A (non-empty) alternating list of @a@\'s and @b@\'s + data Alternating a b = Alternating a [b :+ a] deriving (Show,Eq,Ord) + ++instance Functor (Alternating a) where ++ fmap = bimap id ++ + instance Bifunctor Alternating where + bimap = bimapDefault + instance Bifoldable Alternating where +diff --git a/src/Data/PlanarGraph/AdjRep.hs b/src/Data/PlanarGraph/AdjRep.hs +index 2fbd0402..db3891e9 100644 +--- a/src/Data/PlanarGraph/AdjRep.hs ++++ b/src/Data/PlanarGraph/AdjRep.hs +@@ -1,3 +1,4 @@ ++{-# LANGUAGE DeriveFunctor #-} + -------------------------------------------------------------------------------- + -- | + -- Module : Data.PlanarGraph.AdjRep +@@ -21,7 +22,7 @@ import GHC.Generics (Generic) + -- | Data type representing the graph in its JSON/Yaml format + data Gr v f = Gr { adjacencies :: [v] + , faces :: [f] +- } deriving (Generic, Show, Eq) ++ } deriving (Generic, Show, Eq, Functor) + + instance Bifunctor Gr where + bimap f g (Gr vs fs) = Gr (map f vs) (map g fs) +@@ -44,7 +45,7 @@ data Vtx v e = Vtx { id :: Int + -- vertices. This is not (yet) + -- enforced by the data type. + , vData :: v +- } deriving (Generic, Show, Eq) ++ } deriving (Generic, Show, Eq, Functor) + + instance Bifunctor Vtx where + bimap f g (Vtx i as x) = Vtx i (map (second g) as) (f x) diff --git a/src/Data/PlanarGraph/Mutable.hs b/src/Data/PlanarGraph/Mutable.hs -index 295447c..a661556 100644 +index 295447c8..a6615560 100644 --- a/src/Data/PlanarGraph/Mutable.hs +++ b/src/Data/PlanarGraph/Mutable.hs @@ -633,13 +633,13 @@ pgConnectVertices :: HalfEdge s -> HalfEdge s -> ST s (Edge s) @@ -57,3 +123,21 @@ index 295447c..a661556 100644 halfEdgeSetVertex he =<< halfEdgeVertex e2 halfEdgeSetVertex he' =<< halfEdgeVertex e1 +diff --git a/src/Data/Tree/Util.hs b/src/Data/Tree/Util.hs +index d7a9fdbd..df00bd8f 100644 +--- a/src/Data/Tree/Util.hs ++++ b/src/Data/Tree/Util.hs +@@ -1,3 +1,4 @@ ++{-# LANGUAGE DeriveFunctor #-} + -- | Tree-related utilities. + module Data.Tree.Util where + +@@ -26,7 +27,7 @@ import Data.Tree + -------------------------------------------------------------------------------- + + -- | Nodes in a tree are typically either an internal node or a leaf node +-data TreeNode v a = InternalNode v | LeafNode a deriving (Show,Eq) ++data TreeNode v a = InternalNode v | LeafNode a deriving (Show,Eq, Functor) + + instance Bifunctor TreeNode where + bimap = bimapDefault