@@ -8,11 +8,13 @@ import Data.Aeson.TH
88import qualified Data.Aeson as A
99import qualified Data.Map as M
1010import qualified Data.Set as S
11−import Data.Maybe (fromMaybe)
11+import Data.Maybe (fromMaybe, mapMaybe)
1212import Data.Text (Text)
1313import qualified Data.Text as T
1414import Data.List (nub)
15+import Data.Tree (Tree, rootLabel)
1516import qualified Data.Graph as G
17+import Data.Foldable (toList)
1618
1719import Language.PureScript.Crash
1820import Language.PureScript.Kinds
@@ -57,6 +59,8 @@ data TypeClassData = TypeClassData
5759 -- ^ A set of indexes of type argument that are fully determined by other
5860 -- arguments via functional dependencies. This can be computed from both
5961 -- typeClassArguments and typeClassDependencies.
62+ , typeClassCoveringSets :: S.Set (S.Set Int)
63+ -- ^ A sets of arguments that can be used to infer all other arguments.
6064 } deriving Show
6165
6266-- | A functional dependency indicates a relationship between two sets of
@@ -75,8 +79,11 @@ initEnvironment :: Environment
7579initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses primKinds
7680
7781-- |
78−-- A constructor for TypeClassData that computes which type class arguments are fully determined.
82+-- A constructor for TypeClassData that computes which type class arguments are fully determined
83+-- and argument covering sets.
7984-- Fully determined means that this argument cannot be used when selecting a type class instance.
85+-- A covering set is a minimal collection of arguments that can be used to find an instance and
86+-- therefore determine all other type arguments.
8087--
8188-- An example of the difference between determined and fully determined would be with the class:
8289-- ```class C a b c | a -> b, b -> a, b -> c```
@@ -84,7 +91,8 @@ initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClas
8491-- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is
8592-- fully determined by `a` and `b`.
8693--
87−-- Define a graph of type class arguments with edges being fundep determiners to determined.
94+-- Define a graph of type class arguments with edges being fundep determiners to determined. Each
95+-- argument also has a self looping edge.
8896-- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.
8997-- An argument is not fully determined otherwise.
9098--
@@ -97,26 +105,51 @@ makeTypeClassData
97105 -> [Constraint]
98106 -> [FunctionalDependency]
99107 -> TypeClassData
100−makeTypeClassData args m s deps = TypeClassData args m s deps determinedArgs
108+makeTypeClassData args m s deps = TypeClassData args m s deps determinedArgs coveringSets
101109 where
110+ argumentIndicies = [0 .. length args - 1]
111+
112+ -- each argument determines themselves
113+ identities = (\i -> (i, [i])) <$> argumentIndicies
114+
102115 -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined
103− contributingDeps = M.fromListWith (++) $ do
116+ contributingDeps = M.fromListWith (++) $ identities ++ do
104117 fd <- deps
105118 src <- fdDeterminers fd
106119 (src, fdDetermined fd) : map (, []) (fdDetermined fd)
107120
108− -- here we build a graph of which arguments determine other arguments
109− (depGraph, _, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)
121+ -- build a graph of which arguments determine other arguments
122+ (depGraph, fromVertex, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)
110123
111124 -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to
125+ isFunDepDetermined :: Int -> Bool
112126 isFunDepDetermined arg = case fromKey arg of
113− Nothing -> False -- not mentioned in fundeps
127+ Nothing -> internalError "Unknown argument index in makeTypeClassData"
114128 Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v
115129 varContributesTo = G.reachable depGraph v
116130 in any (\r -> not (r `elem` varContributesTo)) contributesToVar
117131
118132 -- find all the arguments that are determined
119− determinedArgs = S.fromList $ filter isFunDepDetermined [0 .. length args - 1]
133+ determinedArgs :: S.Set Int
134+ determinedArgs = S.fromList $ filter isFunDepDetermined argumentIndicies
135+
136+ argFromVertex :: G.Vertex -> Int
137+ argFromVertex index = let (_, arg, _) = fromVertex index in arg
138+
139+ isVertexDetermined :: G.Vertex -> Bool
140+ isVertexDetermined = isFunDepDetermined . argFromVertex
141+
142+ -- from an scc find the non-determined args
143+ sccNonDetermined :: Tree G.Vertex -> Maybe [Int]
144+ sccNonDetermined tree
145+ -- if any arg in an scc is determined then all of them are
146+ | isVertexDetermined (rootLabel tree) = Nothing
147+ | otherwise = Just (argFromVertex <$> toList tree)
148+
149+ -- find the covering sets
150+ coveringSets :: S.Set (S.Set Int)
151+ coveringSets = let funDepSets = sequence (mapMaybe sccNonDetermined (G.scc depGraph))
152+ in S.fromList (S.fromList <$> funDepSets)
120153
121154-- |
122155-- The visibility of a name in scope