Commit 9a645a16 authored by niteria's avatar niteria

Refactor match to not use Unique order

Unique order can introduce nondeterminism.
As a step towards removing the Ord Unique instance
I've refactored the code to use deterministic sets instead.

Test Plan: ./validate

Reviewers: simonmar, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2369

GHC Trac Issues: #4012
parent 848e3ceb
......@@ -46,6 +46,8 @@ import Util
import Name
import Outputable
import BasicTypes ( isGenerated )
import Unique
import UniqDFM
import Control.Monad( when, unless )
import qualified Data.Map as Map
......@@ -196,9 +198,9 @@ match vars@(v:_) ty eqns -- Eqns *can* be empty
match_group [] = panic "match_group"
match_group eqns@((group,_) : _)
= case group of
PgCon {} -> matchConFamily vars ty (subGroup [(c,e) | (PgCon c, e) <- eqns])
PgCon {} -> matchConFamily vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns])
PgSyn {} -> matchPatSyn vars ty (dropGroup eqns)
PgLit {} -> matchLiterals vars ty (subGroup [(l,e) | (PgLit l, e) <- eqns])
PgLit {} -> matchLiterals vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns])
PgAny -> matchVariables vars ty (dropGroup eqns)
PgN {} -> matchNPats vars ty (dropGroup eqns)
PgNpK {} -> matchNPlusKPats vars ty (dropGroup eqns)
......@@ -809,22 +811,34 @@ groupEquations dflags eqns
same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
(pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
subGroup :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
subGroup :: (m -> [[EquationInfo]]) -- Map.elems
-> m -- Map.empty
-> (a -> m -> Maybe [EquationInfo]) -- Map.lookup
-> (a -> [EquationInfo] -> m -> m) -- Map.insert
-> [(a, EquationInfo)] -> [[EquationInfo]]
-- Input is a particular group. The result sub-groups the
-- equations by with particular constructor, literal etc they match.
-- Each sub-list in the result has the same PatGroup
-- See Note [Take care with pattern order]
subGroup group
= map reverse $ Map.elems $ foldl accumulate Map.empty group
-- Parameterized by map operations to allow different implementations
-- and constraints, eg. types without Ord instance.
subGroup elems empty lookup insert group
= map reverse $ elems $ foldl accumulate empty group
where
accumulate pg_map (pg, eqn)
= case Map.lookup pg pg_map of
Just eqns -> Map.insert pg (eqn:eqns) pg_map
Nothing -> Map.insert pg [eqn] pg_map
= case lookup pg pg_map of
Just eqns -> insert pg (eqn:eqns) pg_map
Nothing -> insert pg [eqn] pg_map
-- pg_map :: Map a [EquationInfo]
-- Equations seen so far in reverse order of appearance
subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert
subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]]
subGroupUniq =
subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v)
{- Note [Pattern synonym groups]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we see
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment